cgit.sxemacs.org Git - sxemacs/blob - src/ui/faces.c

   1 /* "Face" primitives
   2    Copyright (C) 1994 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Board of Trustees, University of Illinois.
   4    Copyright (C) 1995, 1996 Ben Wing.
   5    Copyright (C) 1995 Sun Microsystems, Inc.
   6
   7 This file is part of SXEmacs
   8
   9 SXEmacs is free software: you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation, either version 3 of the License, or
  12 (at your option) any later version.
  13
  14 SXEmacs is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  21
  22
  23 /* Synched up with: Not in FSF. */
  24
  25 /* Written by Chuck Thompson and Ben Wing,
  26    based loosely on old face code by Jamie Zawinski. */
  27
  28 #include <config.h>
  29 #include "lisp.h"
  30
  31 #include "buffer.h"
  32 #include "device.h"
  33 #include "elhash.h"
  34 #include "extents.h"
  35 #include "faces.h"
  36 #include "frame.h"
  37 #include "glyphs.h"
  38 #include "objects.h"
  39 #include "specifier.h"
  40 #include "window.h"
  41
  42 Lisp_Object Qfacep;
  43 Lisp_Object Qforeground, Qbackground, Qdisplay_table;
  44 Lisp_Object Qbackground_pixmap, Qunderline, Qdim;
  45 Lisp_Object Qblinking, Qstrikethru;
  46
  47 Lisp_Object Qinit_face_from_resources;
  48 Lisp_Object Qinit_frame_faces;
  49 Lisp_Object Qinit_device_faces;
  50 Lisp_Object Qinit_global_faces;
  51
  52 /* These faces are used directly internally.  We use these variables
  53    to be able to reference them directly and save the overhead of
  54    calling Ffind_face. */
  55 Lisp_Object Vdefault_face, Vmodeline_face, Vgui_element_face;
  56 Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face;
  57 Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face, Vwidget_face;
  58
  59 /* Qdefault, Qhighlight, Qleft_margin, Qright_margin defined in general.c */
  60 Lisp_Object Qmodeline, Qgui_element, Qtext_cursor, Qvertical_divider;
  61
  62 /* In the old implementation Vface_list was a list of the face names,
  63    not the faces themselves.  We now distinguish between permanent and
  64    temporary faces.  Permanent faces are kept in a regular hash table,
  65    temporary faces in a weak hash table. */
  66 Lisp_Object Vpermanent_faces_cache;
  67 Lisp_Object Vtemporary_faces_cache;
  68
  69 Lisp_Object Vbuilt_in_face_specifiers;
  70 \f
  71 static Lisp_Object mark_face(Lisp_Object obj)
  72 {
  73         Lisp_Face *face = XFACE(obj);
  74
  75         mark_object(face->name);
  76         mark_object(face->doc_string);
  77
  78         mark_object(face->foreground);
  79         mark_object(face->background);
  80         mark_object(face->font);
  81         mark_object(face->display_table);
  82         mark_object(face->background_pixmap);
  83         mark_object(face->underline);
  84         mark_object(face->strikethru);
  85         mark_object(face->highlight);
  86         mark_object(face->dim);
  87         mark_object(face->blinking);
  88         mark_object(face->reverse);
  89
  90         mark_object(face->charsets_warned_about);
  91
  92         return face->plist;
  93 }
  94
  95 static void
  96 print_face(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
  97 {
  98         Lisp_Face *face = XFACE(obj);
  99
 100         if (print_readably) {
 101                 write_c_string("#s(face name ", printcharfun);
 102                 print_internal(face->name, printcharfun, 1);
 103                 write_c_string(")", printcharfun);
 104         } else {
 105                 write_c_string("#<face ", printcharfun);
 106                 print_internal(face->name, printcharfun, 1);
 107                 if (!NILP(face->doc_string)) {
 108                         write_c_string(" ", printcharfun);
 109                         print_internal(face->doc_string, printcharfun, 1);
 110                 }
 111                 write_c_string(">", printcharfun);
 112         }
 113 }
 114
 115 /* Faces are equal if all of their display attributes are equal.  We
 116    don't compare names or doc-strings, because that would make equal
 117    be eq.
 118
 119    This isn't concerned with "unspecified" attributes, that's what
 120    #'face-differs-from-default-p is for. */
 121 static int face_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
 122 {
 123         Lisp_Face *f1 = XFACE(obj1);
 124         Lisp_Face *f2 = XFACE(obj2);
 125
 126         depth++;
 127
 128         return
 129             (internal_equal(f1->foreground, f2->foreground, depth) &&
 130              internal_equal(f1->background, f2->background, depth) &&
 131              internal_equal(f1->font, f2->font, depth) &&
 132              internal_equal(f1->display_table, f2->display_table, depth) &&
 133              internal_equal(f1->background_pixmap, f2->background_pixmap, depth)
 134              && internal_equal(f1->underline, f2->underline, depth)
 135              && internal_equal(f1->strikethru, f2->strikethru, depth)
 136              && internal_equal(f1->highlight, f2->highlight, depth)
 137              && internal_equal(f1->dim, f2->dim, depth)
 138              && internal_equal(f1->blinking, f2->blinking, depth)
 139              && internal_equal(f1->reverse, f2->reverse, depth)
 140              && !plists_differ(f1->plist, f2->plist, 0, 0, depth + 1));
 141 }
 142
 143 static unsigned long face_hash(Lisp_Object obj, int depth)
 144 {
 145         Lisp_Face *f = XFACE(obj);
 146
 147         depth++;
 148
 149         /* No need to hash all of the elements; that would take too long.
 150            Just hash the most common ones. */
 151         return HASH3(internal_hash(f->foreground, depth),
 152                      internal_hash(f->background, depth),
 153                      internal_hash(f->font, depth));
 154 }
 155
 156 static Lisp_Object face_getprop(Lisp_Object obj, Lisp_Object prop)
 157 {
 158         Lisp_Face *f = XFACE(obj);
 159
 160         return
 161             (EQ(prop, Qforeground) ? f->foreground :
 162              EQ(prop, Qbackground) ? f->background :
 163              EQ(prop, Qfont) ? f->font :
 164              EQ(prop, Qdisplay_table) ? f->display_table :
 165              EQ(prop, Qbackground_pixmap) ? f->background_pixmap :
 166              EQ(prop, Qunderline) ? f->underline :
 167              EQ(prop, Qstrikethru) ? f->strikethru :
 168              EQ(prop, Qhighlight) ? f->highlight :
 169              EQ(prop, Qdim) ? f->dim :
 170              EQ(prop, Qblinking) ? f->blinking :
 171              EQ(prop, Qreverse) ? f->reverse :
 172              EQ(prop, Qdoc_string) ? f->doc_string :
 173              external_plist_get(&f->plist, prop, 0, ERROR_ME));
 174 }
 175
 176 static int face_putprop(Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
 177 {
 178         Lisp_Face *f = XFACE(obj);
 179
 180         if (EQ(prop, Qforeground) ||
 181             EQ(prop, Qbackground) ||
 182             EQ(prop, Qfont) ||
 183             EQ(prop, Qdisplay_table) ||
 184             EQ(prop, Qbackground_pixmap) ||
 185             EQ(prop, Qunderline) ||
 186             EQ(prop, Qstrikethru) ||
 187             EQ(prop, Qhighlight) ||
 188             EQ(prop, Qdim) || EQ(prop, Qblinking) || EQ(prop, Qreverse))
 189                 return 0;
 190
 191         if (EQ(prop, Qdoc_string)) {
 192                 if (!NILP(value))
 193                         CHECK_STRING(value);
 194                 f->doc_string = value;
 195                 return 1;
 196         }
 197
 198         external_plist_put(&f->plist, prop, value, 0, ERROR_ME);
 199         return 1;
 200 }
 201
 202 static int face_remprop(Lisp_Object obj, Lisp_Object prop)
 203 {
 204         Lisp_Face *f = XFACE(obj);
 205
 206         if (EQ(prop, Qforeground) ||
 207             EQ(prop, Qbackground) ||
 208             EQ(prop, Qfont) ||
 209             EQ(prop, Qdisplay_table) ||
 210             EQ(prop, Qbackground_pixmap) ||
 211             EQ(prop, Qunderline) ||
 212             EQ(prop, Qstrikethru) ||
 213             EQ(prop, Qhighlight) ||
 214             EQ(prop, Qdim) || EQ(prop, Qblinking) || EQ(prop, Qreverse))
 215                 return -1;
 216
 217         if (EQ(prop, Qdoc_string)) {
 218                 f->doc_string = Qnil;
 219                 return 1;
 220         }
 221
 222         return external_remprop(&f->plist, prop, 0, ERROR_ME);
 223 }
 224
 225 static Lisp_Object face_plist(Lisp_Object obj)
 226 {
 227         Lisp_Face *face = XFACE(obj);
 228         Lisp_Object result = face->plist;
 229
 230         result = cons3(Qreverse, face->reverse, result);
 231         result = cons3(Qblinking, face->blinking, result);
 232         result = cons3(Qdim, face->dim, result);
 233         result = cons3(Qhighlight, face->highlight, result);
 234         result = cons3(Qstrikethru, face->strikethru, result);
 235         result = cons3(Qunderline, face->underline, result);
 236         result = cons3(Qbackground_pixmap, face->background_pixmap, result);
 237         result = cons3(Qdisplay_table, face->display_table, result);
 238         result = cons3(Qfont, face->font, result);
 239         result = cons3(Qbackground, face->background, result);
 240         result = cons3(Qforeground, face->foreground, result);
 241
 242         return result;
 243 }
 244
 245 static const struct lrecord_description face_description[] = {
 246         {XD_LISP_OBJECT, offsetof(Lisp_Face, name)},
 247         {XD_LISP_OBJECT, offsetof(Lisp_Face, doc_string)},
 248         {XD_LISP_OBJECT, offsetof(Lisp_Face, foreground)},
 249         {XD_LISP_OBJECT, offsetof(Lisp_Face, background)},
 250         {XD_LISP_OBJECT, offsetof(Lisp_Face, font)},
 251         {XD_LISP_OBJECT, offsetof(Lisp_Face, display_table)},
 252         {XD_LISP_OBJECT, offsetof(Lisp_Face, background_pixmap)},
 253         {XD_LISP_OBJECT, offsetof(Lisp_Face, underline)},
 254         {XD_LISP_OBJECT, offsetof(Lisp_Face, strikethru)},
 255         {XD_LISP_OBJECT, offsetof(Lisp_Face, highlight)},
 256         {XD_LISP_OBJECT, offsetof(Lisp_Face, dim)},
 257         {XD_LISP_OBJECT, offsetof(Lisp_Face, blinking)},
 258         {XD_LISP_OBJECT, offsetof(Lisp_Face, reverse)},
 259         {XD_LISP_OBJECT, offsetof(Lisp_Face, plist)},
 260         {XD_LISP_OBJECT, offsetof(Lisp_Face, charsets_warned_about)},
 261         {XD_END}
 262 };
 263
 264 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS("face", face,
 265                                          mark_face, print_face, 0, face_equal,
 266                                          face_hash, face_description,
 267                                          face_getprop, face_putprop,
 268                                          face_remprop, face_plist, Lisp_Face);
 269 \f
 270 /************************************************************************/
 271 /*                             face read syntax                         */
 272 /************************************************************************/
 273
 274 static int
 275 face_name_validate(Lisp_Object keyword, Lisp_Object value, Error_behavior errb)
 276 {
 277         if (ERRB_EQ(errb, ERROR_ME)) {
 278                 CHECK_SYMBOL(value);
 279                 return 1;
 280         }
 281
 282         return SYMBOLP(value);
 283 }
 284
 285 static int face_validate(Lisp_Object data, Error_behavior errb)
 286 {
 287         int name_seen = 0;
 288         Lisp_Object valw = Qnil;
 289
 290         data = Fcdr(data);      /* skip over Qface */
 291         while (!NILP(data)) {
 292                 Lisp_Object keyw = Fcar(data);
 293
 294                 data = Fcdr(data);
 295                 valw = Fcar(data);
 296                 data = Fcdr(data);
 297                 if (EQ(keyw, Qname))
 298                         name_seen = 1;
 299                 else
 300                         abort();
 301         }
 302
 303         if (!name_seen) {
 304                 maybe_error(Qface, errb, "No face name given");
 305                 return 0;
 306         }
 307
 308         if (NILP(Ffind_face(valw))) {
 309                 maybe_signal_simple_error("No such face", valw, Qface, errb);
 310                 return 0;
 311         }
 312
 313         return 1;
 314 }
 315
 316 static Lisp_Object face_instantiate(Lisp_Object data)
 317 {
 318         return Fget_face(Fcar(Fcdr(data)));
 319 }
 320 \f
 321 /****************************************************************************
 322  *                             utility functions                            *
 323  ****************************************************************************/
 324
 325 static void reset_face(Lisp_Face * f)
 326 {
 327         f->name = Qnil;
 328         f->doc_string = Qnil;
 329         f->dirty = 0;
 330         f->foreground = Qnil;
 331         f->background = Qnil;
 332         f->font = Qnil;
 333         f->display_table = Qnil;
 334         f->background_pixmap = Qnil;
 335         f->underline = Qnil;
 336         f->strikethru = Qnil;
 337         f->highlight = Qnil;
 338         f->dim = Qnil;
 339         f->blinking = Qnil;
 340         f->reverse = Qnil;
 341         f->plist = Qnil;
 342         f->charsets_warned_about = Qnil;
 343 }
 344
 345 static Lisp_Face *allocate_face(void)
 346 {
 347         Lisp_Face *result = alloc_lcrecord_type(Lisp_Face, &lrecord_face);
 348
 349         reset_face(result);
 350         return result;
 351 }
 352 \f
 353 /* We store the faces in hash tables with the names as the key and the
 354    actual face object as the value.  Occasionally we need to use them
 355    in a list format.  These routines provide us with that. */
 356 struct face_list_closure {
 357         Lisp_Object *face_list;
 358 };
 359
 360 static int
 361 add_face_to_list_mapper(Lisp_Object key, Lisp_Object value,
 362                         void *face_list_closure)
 363 {
 364         /* This function can GC */
 365         struct face_list_closure *fcl =
 366             (struct face_list_closure *)face_list_closure;
 367
 368         *(fcl->face_list) = Fcons(XFACE(value)->name, (*fcl->face_list));
 369         return 0;
 370 }
 371
 372 static Lisp_Object faces_list_internal(Lisp_Object list)
 373 {
 374         Lisp_Object face_list = Qnil;
 375         struct gcpro gcpro1;
 376         struct face_list_closure face_list_closure;
 377
 378         GCPRO1(face_list);
 379         face_list_closure.face_list = &face_list;
 380         elisp_maphash(add_face_to_list_mapper, list, &face_list_closure);
 381         UNGCPRO;
 382
 383         return face_list;
 384 }
 385
 386 static Lisp_Object permanent_faces_list(void)
 387 {
 388         return faces_list_internal(Vpermanent_faces_cache);
 389 }
 390
 391 static Lisp_Object temporary_faces_list(void)
 392 {
 393         return faces_list_internal(Vtemporary_faces_cache);
 394 }
 395 \f
 396 static int
 397 mark_face_as_clean_mapper(Lisp_Object key, Lisp_Object value,
 398                           void *flag_closure)
 399 {
 400         /* This function can GC */
 401         int *flag = (int *)flag_closure;
 402         XFACE(value)->dirty = *flag;
 403         return 0;
 404 }
 405
 406 static void mark_all_faces_internal(int flag)
 407 {
 408         elisp_maphash(mark_face_as_clean_mapper, Vpermanent_faces_cache, &flag);
 409         elisp_maphash(mark_face_as_clean_mapper, Vtemporary_faces_cache, &flag);
 410 }
 411
 412 void mark_all_faces_as_clean(void)
 413 {
 414         mark_all_faces_internal(0);
 415 }
 416
 417 /* Currently unused (see the comment in face_property_was_changed()).  */
 418 #if 0
 419 /* #### OBSOLETE ME, PLEASE.  Maybe.  Maybe this is just as good as
 420    any other solution. */
 421 struct face_inheritance_closure {
 422         Lisp_Object face;
 423         Lisp_Object property;
 424 };
 425
 426 static void
 427 update_inheritance_mapper_internal(Lisp_Object cur_face,
 428                                    Lisp_Object inh_face, Lisp_Object property)
 429 {
 430         /* #### fix this function */
 431         Lisp_Object elt = Qnil;
 432         struct gcpro gcpro1;
 433
 434         GCPRO1(elt);
 435
 436         for (elt = FACE_PROPERTY_SPEC_LIST(cur_face, property, Qall);
 437              !NILP(elt); elt = XCDR(elt)) {
 438                 Lisp_Object values = XCDR(XCAR(elt));
 439
 440                 for (; !NILP(values); values = XCDR(values)) {
 441                         Lisp_Object value = XCDR(XCAR(values));
 442                         if (VECTORP(value) && XVECTOR_LENGTH(value)) {
 443                                 if (EQ
 444                                     (Ffind_face(XVECTOR_DATA(value)[0]),
 445                                      inh_face))
 446                                         Fset_specifier_dirty_flag
 447                                             (FACE_PROPERTY_SPECIFIER
 448                                              (inh_face, property));
 449                         }
 450                 }
 451         }
 452
 453         UNGCPRO;
 454 }
 455
 456 static int
 457 update_face_inheritance_mapper(const void *hash_key, void *hash_contents,
 458                                void *face_inheritance_closure)
 459 {
 460         Lisp_Object key, contents;
 461         struct face_inheritance_closure *fcl =
 462             (struct face_inheritance_closure *)face_inheritance_closure;
 463
 464         CVOID_TO_LISP(key, hash_key);
 465         VOID_TO_LISP(contents, hash_contents);
 466
 467         if (EQ(fcl->property, Qfont)) {
 468                 update_inheritance_mapper_internal(contents, fcl->face, Qfont);
 469         } else if (EQ(fcl->property, Qforeground) ||
 470                    EQ(fcl->property, Qbackground)) {
 471                 update_inheritance_mapper_internal(contents, fcl->face,
 472                                                    Qforeground);
 473                 update_inheritance_mapper_internal(contents, fcl->face,
 474                                                    Qbackground);
 475         } else if (EQ(fcl->property, Qunderline)
 476                    || EQ(fcl->property, Qstrikethru)
 477                    || EQ(fcl->property, Qhighlight) || EQ(fcl->property, Qdim)
 478                    || EQ(fcl->property, Qblinking)
 479                    || EQ(fcl->property, Qreverse)) {
 480                 update_inheritance_mapper_internal(contents, fcl->face,
 481                                                    Qunderline);
 482                 update_inheritance_mapper_internal(contents, fcl->face,
 483                                                    Qstrikethru);
 484                 update_inheritance_mapper_internal(contents, fcl->face,
 485                                                    Qhighlight);
 486                 update_inheritance_mapper_internal(contents, fcl->face, Qdim);
 487                 update_inheritance_mapper_internal(contents, fcl->face,
 488                                                    Qblinking);
 489                 update_inheritance_mapper_internal(contents, fcl->face,
 490                                                    Qreverse);
 491         }
 492         return 0;
 493 }
 494
 495 static void update_faces_inheritance(Lisp_Object face, Lisp_Object property)
 496 {
 497         struct face_inheritance_closure face_inheritance_closure;
 498         struct gcpro gcpro1, gcpro2;
 499
 500         GCPRO2(face, property);
 501         face_inheritance_closure.face = face;
 502         face_inheritance_closure.property = property;
 503
 504         elisp_maphash(update_face_inheritance_mapper, Vpermanent_faces_cache,
 505                       &face_inheritance_closure);
 506         elisp_maphash(update_face_inheritance_mapper, Vtemporary_faces_cache,
 507                       &face_inheritance_closure);
 508
 509         UNGCPRO;
 510 }
 511 #endif                          /* 0 */
 512
 513 Lisp_Object
 514 face_property_matching_instance(Lisp_Object face, Lisp_Object property,
 515                                 Lisp_Object charset, Lisp_Object domain,
 516                                 Error_behavior errb, int no_fallback,
 517                                 Lisp_Object depth)
 518 {
 519         Lisp_Object retval =
 520             specifier_instance_no_quit(Fget(face, property, Qnil), charset,
 521                                        domain, errb, no_fallback, depth);
 522
 523         if (UNBOUNDP(retval) && !no_fallback) {
 524                 if (EQ(property, Qfont)) {
 525                         if (NILP(memq_no_quit(charset,
 526                                               XFACE(face)->
 527                                               charsets_warned_about))) {
 528 #ifdef MULE
 529                                 if (!UNBOUNDP(charset))
 530                                         warn_when_safe
 531                                             (Qfont, Qwarning,
 532                                              "Unable to instantiate font for face %s, charset %s",
 533                                              string_data(symbol_name
 534                                                          (XSYMBOL
 535                                                           (XFACE(face)->name))),
 536                                              string_data(symbol_name
 537                                                          (XSYMBOL
 538                                                           (XCHARSET_NAME
 539                                                            (charset)))));
 540                                 else
 541 #endif
 542                                         warn_when_safe(Qfont, Qwarning,
 543                                                        "Unable to instantiate font for face %s",
 544                                                        string_data(symbol_name
 545                                                                    (XSYMBOL
 546                                                                     (XFACE
 547                                                                      (face)->
 548                                                                      name))));
 549                                 XFACE(face)->charsets_warned_about =
 550                                     Fcons(charset,
 551                                           XFACE(face)->charsets_warned_about);
 552                         }
 553                         retval = Vthe_null_font_instance;
 554                 }
 555         }
 556
 557         return retval;
 558 }
 559 \f
 560 DEFUN("facep", Ffacep, 1, 1, 0, /*
 561 Return t if OBJECT is a face.
 562 */
 563       (object))
 564 {
 565         return FACEP(object) ? Qt : Qnil;
 566 }
 567
 568 DEFUN("find-face", Ffind_face, 1, 1, 0, /*
 569 Retrieve the face of the given name.
 570 If FACE-OR-NAME is a face object, it is simply returned.
 571 Otherwise, FACE-OR-NAME should be a symbol.  If there is no such face,
 572 nil is returned.  Otherwise the associated face object is returned.
 573 */
 574       (face_or_name))
 575 {
 576         Lisp_Object retval;
 577
 578         if (FACEP(face_or_name))
 579                 return face_or_name;
 580         CHECK_SYMBOL(face_or_name);
 581
 582         /* Check if the name represents a permanent face. */
 583         retval = Fgethash(face_or_name, Vpermanent_faces_cache, Qnil);
 584         if (!NILP(retval))
 585                 return retval;
 586
 587         /* Check if the name represents a temporary face. */
 588         return Fgethash(face_or_name, Vtemporary_faces_cache, Qnil);
 589 }
 590
 591 DEFUN("get-face", Fget_face, 1, 1, 0,   /*
 592 Retrieve the face of the given name.
 593 Same as `find-face' except an error is signalled if there is no such
 594 face instead of returning nil.
 595 */
 596       (name))
 597 {
 598         Lisp_Object face = Ffind_face(name);
 599
 600         if (NILP(face))
 601                 signal_simple_error("No such face", name);
 602         return face;
 603 }
 604
 605 DEFUN("face-name", Fface_name, 1, 1, 0, /*
 606 Return the name of the given face.
 607 */
 608       (face))
 609 {
 610         Lisp_Object tmp_face = Fget_face(face);
 611         return XFACE(tmp_face)->name;
 612 }
 613
 614 DEFUN("built-in-face-specifiers", Fbuilt_in_face_specifiers, 0, 0, 0,   /*
 615 Return a list of all built-in face specifier properties.
 616 Don't modify this list!
 617 */
 618       ())
 619 {
 620         return Vbuilt_in_face_specifiers;
 621 }
 622
 623 /* These values are retrieved so often that we make a special
 624    function.
 625 */
 626
 627 void
 628 default_face_font_info(Lisp_Object domain, int *ascent, int *descent,
 629                        int *height, int *width, int *proportional_p)
 630 {
 631         Lisp_Object font_instance;
 632
 633         if (noninteractive) {
 634                 if (ascent)
 635                         *ascent = 1;
 636                 if (descent)
 637                         *descent = 0;
 638                 if (height)
 639                         *height = 1;
 640                 if (width)
 641                         *width = 1;
 642                 if (proportional_p)
 643                         *proportional_p = 0;
 644                 return;
 645         }
 646
 647         /* We use ASCII here.  This is probably reasonable because the
 648            people calling this function are using the resulting values to
 649            come up with overall sizes for windows and frames. */
 650         if (WINDOWP(domain)) {
 651                 struct face_cachel *cachel;
 652                 struct window *w = XWINDOW(domain);
 653
 654                 /* #### It's possible for this function to get called when the
 655                    face cachels have not been initialized.  I don't know why. */
 656                 if (!Dynarr_length(w->face_cachels))
 657                         reset_face_cachels(w);
 658                 cachel = WINDOW_FACE_CACHEL(w, DEFAULT_INDEX);
 659                 font_instance = FACE_CACHEL_FONT(cachel, Vcharset_ascii);
 660         } else {
 661                 font_instance =
 662                     FACE_FONT(Vdefault_face, domain, Vcharset_ascii);
 663         }
 664
 665         if (height)
 666                 *height = XFONT_INSTANCE(font_instance)->height;
 667         if (width)
 668                 *width = XFONT_INSTANCE(font_instance)->width;
 669         if (ascent)
 670                 *ascent = XFONT_INSTANCE(font_instance)->ascent;
 671         if (descent)
 672                 *descent = XFONT_INSTANCE(font_instance)->descent;
 673         if (proportional_p)
 674                 *proportional_p = XFONT_INSTANCE(font_instance)->proportional_p;
 675 }
 676
 677 void default_face_height_and_width(Lisp_Object domain, int *height, int *width)
 678 {
 679         default_face_font_info(domain, 0, 0, height, width, 0);
 680 }
 681
 682 void
 683 default_face_height_and_width_1(Lisp_Object domain, int *height, int *width)
 684 {
 685         if (window_system_pixelated_geometry(domain)) {
 686                 if (height)
 687                         *height = 1;
 688                 if (width)
 689                         *width = 1;
 690         } else
 691                 default_face_height_and_width(domain, height, width);
 692 }
 693
 694 DEFUN("face-list", Fface_list, 0, 1, 0, /*
 695 Return a list of the names of all defined faces.
 696 If TEMPORARY is nil, only the permanent faces are included.
 697 If it is t, only the temporary faces are included.  If it is any
 698 other non-nil value both permanent and temporary are included.
 699 */
 700       (temporary))
 701 {
 702         Lisp_Object face_list = Qnil;
 703
 704         /* Added the permanent faces, if requested. */
 705         if (NILP(temporary) || !EQ(Qt, temporary))
 706                 face_list = permanent_faces_list();
 707
 708         if (!NILP(temporary)) {
 709                 struct gcpro gcpro1;
 710                 GCPRO1(face_list);
 711                 face_list = nconc2(face_list, temporary_faces_list());
 712                 UNGCPRO;
 713         }
 714
 715         return face_list;
 716 }
 717
 718 DEFUN("make-face", Fmake_face, 1, 3, 0, /*
 719 Define a new face with name NAME (a symbol), described by DOC-STRING.
 720 You can modify the font, color, etc. of a face with the set-face-* functions.
 721 If the face already exists, it is unmodified.
 722 If TEMPORARY is non-nil, this face will cease to exist if not in use.
 723 */
 724       (name, doc_string, temporary))
 725 {
 726         /* This function can GC if initialized is non-zero */
 727         Lisp_Face *f;
 728         Lisp_Object face;
 729
 730         CHECK_SYMBOL(name);
 731         if (!NILP(doc_string))
 732                 CHECK_STRING(doc_string);
 733
 734         face = Ffind_face(name);
 735         if (!NILP(face))
 736                 return face;
 737
 738         f = allocate_face();
 739         XSETFACE(face, f);
 740
 741         f->name = name;
 742         f->doc_string = doc_string;
 743         f->foreground = Fmake_specifier(Qcolor);
 744         set_color_attached_to(f->foreground, face, Qforeground);
 745         f->background = Fmake_specifier(Qcolor);
 746         set_color_attached_to(f->background, face, Qbackground);
 747         f->font = Fmake_specifier(Qfont);
 748         set_font_attached_to(f->font, face, Qfont);
 749         f->background_pixmap = Fmake_specifier(Qimage);
 750         set_image_attached_to(f->background_pixmap, face, Qbackground_pixmap);
 751         f->display_table = Fmake_specifier(Qdisplay_table);
 752         f->underline = Fmake_specifier(Qface_boolean);
 753         set_face_boolean_attached_to(f->underline, face, Qunderline);
 754         f->strikethru = Fmake_specifier(Qface_boolean);
 755         set_face_boolean_attached_to(f->strikethru, face, Qstrikethru);
 756         f->highlight = Fmake_specifier(Qface_boolean);
 757         set_face_boolean_attached_to(f->highlight, face, Qhighlight);
 758         f->dim = Fmake_specifier(Qface_boolean);
 759         set_face_boolean_attached_to(f->dim, face, Qdim);
 760         f->blinking = Fmake_specifier(Qface_boolean);
 761         set_face_boolean_attached_to(f->blinking, face, Qblinking);
 762         f->reverse = Fmake_specifier(Qface_boolean);
 763         set_face_boolean_attached_to(f->reverse, face, Qreverse);
 764         if (!NILP(Vdefault_face)) {
 765                 /* If the default face has already been created, set it as
 766                    the default fallback specifier for all the specifiers we
 767                    just created.  This implements the standard "all faces
 768                    inherit from default" behavior. */
 769                 set_specifier_fallback(f->foreground,
 770                                        Fget(Vdefault_face, Qforeground,
 771                                             Qunbound));
 772                 set_specifier_fallback(f->background,
 773                                        Fget(Vdefault_face, Qbackground,
 774                                             Qunbound));
 775                 set_specifier_fallback(f->font,
 776                                        Fget(Vdefault_face, Qfont, Qunbound));
 777                 set_specifier_fallback(f->background_pixmap,
 778                                        Fget(Vdefault_face, Qbackground_pixmap,
 779                                             Qunbound));
 780                 set_specifier_fallback(f->display_table,
 781                                        Fget(Vdefault_face, Qdisplay_table,
 782                                             Qunbound));
 783                 set_specifier_fallback(f->underline,
 784                                        Fget(Vdefault_face, Qunderline,
 785                                             Qunbound));
 786                 set_specifier_fallback(f->strikethru,
 787                                        Fget(Vdefault_face, Qstrikethru,
 788                                             Qunbound));
 789                 set_specifier_fallback(f->highlight,
 790                                        Fget(Vdefault_face, Qhighlight,
 791                                             Qunbound));
 792                 set_specifier_fallback(f->dim,
 793                                        Fget(Vdefault_face, Qdim, Qunbound));
 794                 set_specifier_fallback(f->blinking,
 795                                        Fget(Vdefault_face, Qblinking,
 796                                             Qunbound));
 797                 set_specifier_fallback(f->reverse,
 798                                        Fget(Vdefault_face, Qreverse, Qunbound));
 799         }
 800
 801         /* Add the face to the appropriate list. */
 802         if (NILP(temporary))
 803                 Fputhash(name, face, Vpermanent_faces_cache);
 804         else
 805                 Fputhash(name, face, Vtemporary_faces_cache);
 806
 807         /* Note that it's OK if we dump faces.
 808            When we start up again when we're not noninteractive,
 809            `init-global-faces' is called and it resources all
 810            existing faces. */
 811         if (initialized && !noninteractive) {
 812                 struct gcpro gcpro1, gcpro2;
 813
 814                 GCPRO2(name, face);
 815                 call1(Qinit_face_from_resources, name);
 816                 UNGCPRO;
 817         }
 818
 819         return face;
 820 }
 821 \f
 822 /*****************************************************************************
 823  initialization code
 824  ****************************************************************************/
 825
 826 void init_global_faces(struct device *d)
 827 {
 828         /* When making the initial terminal device, there is no Lisp code
 829            loaded, so we can't do this. */
 830         if (initialized && !noninteractive) {
 831                 call_critical_lisp_code(d, Qinit_global_faces, Qnil);
 832         }
 833 }
 834
 835 void init_device_faces(struct device *d)
 836 {
 837         /* This function can call lisp */
 838
 839         /* When making the initial terminal device, there is no Lisp code
 840            loaded, so we can't do this. */
 841         if (initialized) {
 842                 Lisp_Object tdevice;
 843                 XSETDEVICE(tdevice, d);
 844                 call_critical_lisp_code(d, Qinit_device_faces, tdevice);
 845         }
 846 }
 847
 848 void init_frame_faces(struct frame *frm)
 849 {
 850         /* When making the initial terminal device, there is no Lisp code
 851            loaded, so we can't do this. */
 852         if (initialized) {
 853                 Lisp_Object tframe;
 854                 XSETFRAME(tframe, frm);
 855
 856                 /* DO NOT change the selected frame here.  If the debugger goes off
 857                    it will try and display on the frame being created, but it is not
 858                    ready for that yet and a horrible death will occur.  Any random
 859                    code depending on the selected-frame as an implicit arg should be
 860                    tracked down and shot.  For the benefit of the one known,
 861                    xpm-color-symbols, make-frame sets the variable
 862                    Vframe_being_created to the frame it is making and sets it to nil
 863                    when done.  Internal functions that this could trigger which are
 864                    currently depending on selected-frame should use this instead.  It
 865                    is not currently visible at the lisp level. */
 866                 call_critical_lisp_code(XDEVICE(FRAME_DEVICE(frm)),
 867                                         Qinit_frame_faces, tframe);
 868         }
 869 }
 870 \f
 871 /****************************************************************************
 872  *                        face cache element functions                      *
 873  ****************************************************************************/
 874
 875 /*
 876
 877 #### Here is a description of how the face cache elements ought
 878 to be redone.  It is *NOT* how they work currently:
 879
 880 However, when I started to go about implementing this, I realized
 881 that there are all sorts of subtle problems with cache coherency
 882 that are coming up.  As it turns out, these problems don't
 883 manifest themselves now due to the brute-force "kill 'em all"
 884 approach to cache invalidation when faces change; but if this
 885 is ever made smarter, these problems are going to come up, and
 886 some of them are very non-obvious.
 887
 888 I'm thinking of redoing the cache code a bit to avoid these
 889 coherency problems.  The bulk of the problems will arise because
 890 the current display structures have simple indices into the
 891 face cache, but the cache can be changed at various times,
 892 which could make the current display structures incorrect.
 893 I guess the dirty and updated flags are an attempt to fix
 894 this, but this approach doesn't really work.
 895
 896 Here's an approach that should keep things clean and unconfused:
 897
 898 1) Imagine a "virtual face cache" that can grow arbitrarily
 899    big and for which the only thing allowed is to add new
 900    elements.  Existing elements cannot be removed or changed.
 901    This way, any pointers in the existing redisplay structure
 902    into the cache never get screwed up. (This is important
 903    because even if a cache element is out of date, if there's
 904    a pointer to it then its contents still accurately describe
 905    the way the text currently looks on the screen.)
 906 2) Each element in the virtual cache either describes exactly
 907    one face, or describes the merger of a number of faces
 908    by some process.  In order to simplify things, for mergers
 909    we do not record which faces or ordering was used, but
 910    simply that this cache element is the result of merging.
 911    Unlike the current implementation, it's important that a
 912    single cache element not be used to both describe a
 913    single face and describe a merger, even if all the property
 914    values are the same.
 915 3) Each cache element can be clean or dirty.  "Dirty" means
 916    that the face that the element points to has been changed;
 917    this gets set at the time the face is changed.  This
 918    way, when looking up a value in the cache, you can determine
 919    whether it's out of date or not.  For merged faces it
 920    does not matter -- we don't record the faces or priority
 921    used to create the merger, so it's impossible to look up
 922    one of these faces.  We have to recompute it each time.
 923    Luckily, this is fine -- doing the merge is much
 924    less expensive than recomputing the properties of a
 925    single face.
 926 4) For each cache element, we keep a hash value. (In order
 927    to hash the boolean properties, we convert each of them
 928    into a different large prime number so that the hashing works
 929    well.) This allows us, when comparing runes, to properly
 930    determine whether the face for that rune has changed.
 931    This will be especially important for TTY's, where there
 932    aren't that many faces and minimizing redraw is very
 933    important.
 934 5) We can't actually keep an infinite cache, but that doesn't
 935    really matter that much.  The only elements we care about
 936    are those that are used by either the current or desired
 937    display structs.  Therefore, we keep a per-window
 938    redisplay iteration number, and mark each element with
 939    that number as we use it.  Just after outputting the
 940    window and synching the redisplay structs, we go through
 941    the cache and invalidate all elements that are not clean
 942    elements referring to a particular face and that do not
 943    have an iteration number equal to the current one.  We
 944    keep them in a chain, and use them to allocate new
 945    elements when possible instead of increasing the Dynarr.
 946
 947    */
 948
 949 /* mark for GC a dynarr of face cachels. */
 950
 951 void mark_face_cachels(face_cachel_dynarr * elements)
 952 {
 953         int elt;
 954
 955         if (!elements)
 956                 return;
 957
 958         for (elt = 0; elt < Dynarr_length(elements); elt++) {
 959                 struct face_cachel *cachel = Dynarr_atp(elements, elt);
 960
 961                 {
 962                         int i;
 963
 964                         for (i = 0; i < NUM_LEADING_BYTES; i++)
 965                                 if (!NILP(cachel->font[i])
 966                                     && !UNBOUNDP(cachel->font[i]))
 967                                         mark_object(cachel->font[i]);
 968                 }
 969                 mark_object(cachel->face);
 970                 mark_object(cachel->foreground);
 971                 mark_object(cachel->background);
 972                 mark_object(cachel->display_table);
 973                 mark_object(cachel->background_pixmap);
 974         }
 975 }
 976
 977 /* ensure that the given cachel contains an updated font value for
 978    the given charset.  Return the updated font value. */
 979
 980 Lisp_Object
 981 ensure_face_cachel_contains_charset(struct face_cachel *cachel,
 982                                     Lisp_Object domain, Lisp_Object charset)
 983 {
 984         Lisp_Object new_val;
 985         Lisp_Object face = cachel->face;
 986         int bound = 1;
 987         int offs = XCHARSET_LEADING_BYTE(charset) - MIN_LEADING_BYTE;
 988
 989         if (!UNBOUNDP(cachel->font[offs])
 990             && cachel->font_updated[offs])
 991                 return cachel->font[offs];
 992
 993         if (UNBOUNDP(face)) {
 994                 /* a merged face. */
 995                 int i;
 996                 struct window *w = XWINDOW(domain);
 997
 998                 new_val = Qunbound;
 999                 cachel->font_specified[offs] = 0;
1000                 for (i = 0; i < cachel->nfaces; i++) {
1001                         struct face_cachel *oth;
1002
1003                         oth = Dynarr_atp(w->face_cachels,
1004                                          FACE_CACHEL_FINDEX_UNSAFE(cachel, i));
1005                         /* Tout le monde aime la recursion */
1006                         ensure_face_cachel_contains_charset(oth, domain,
1007                                                             charset);
1008
1009                         if (oth->font_specified[offs]) {
1010                                 new_val = oth->font[offs];
1011                                 cachel->font_specified[offs] = 1;
1012                                 break;
1013                         }
1014                 }
1015
1016                 if (!cachel->font_specified[offs])
1017                         /* need to do the default face. */
1018                 {
1019                         struct face_cachel *oth =
1020                             Dynarr_atp(w->face_cachels, DEFAULT_INDEX);
1021                         ensure_face_cachel_contains_charset(oth, domain,
1022                                                             charset);
1023
1024                         new_val = oth->font[offs];
1025                 }
1026
1027                 if (!UNBOUNDP(cachel->font[offs])
1028                     && !EQ(cachel->font[offs], new_val))
1029                         cachel->dirty = 1;
1030                 cachel->font_updated[offs] = 1;
1031                 cachel->font[offs] = new_val;
1032                 return new_val;
1033         }
1034
1035         new_val = face_property_matching_instance(face, Qfont, charset, domain,
1036                                                   /* #### look into ERROR_ME_NOT */
1037                                                   ERROR_ME_NOT, 1, Qzero);
1038         if (UNBOUNDP(new_val)) {
1039                 bound = 0;
1040                 new_val = face_property_matching_instance(face, Qfont,
1041                                                           charset, domain,
1042                                                           /* #### look into
1043                                                              ERROR_ME_NOT */
1044                                                           ERROR_ME_NOT, 0,
1045                                                           Qzero);
1046         }
1047         if (!UNBOUNDP(cachel->font[offs]) && !EQ(new_val, cachel->font[offs]))
1048                 cachel->dirty = 1;
1049         cachel->font_updated[offs] = 1;
1050         cachel->font[offs] = new_val;
1051         cachel->font_specified[offs] = (bound || EQ(face, Vdefault_face));
1052         return new_val;
1053 }
1054
1055 /* Ensure that the given cachel contains updated fonts for all
1056    the charsets specified. */
1057
1058 void
1059 ensure_face_cachel_complete(struct face_cachel *cachel,
1060                             Lisp_Object domain, unsigned char *charsets)
1061 {
1062         int i;
1063
1064         for (i = 0; i < NUM_LEADING_BYTES; i++)
1065                 if (charsets[i]) {
1066                         Lisp_Object charset =
1067                             CHARSET_BY_LEADING_BYTE(i + MIN_LEADING_BYTE);
1068                         assert(CHARSETP(charset));
1069                         ensure_face_cachel_contains_charset(cachel, domain,
1070                                                             charset);
1071                 }
1072 }
1073
1074 void
1075 face_cachel_charset_font_metric_info(struct face_cachel *cachel,
1076                                      unsigned char *charsets,
1077                                      struct font_metric_info *fm)
1078 {
1079         int i;
1080
1081         fm->width = 1;
1082         fm->height = fm->ascent = 1;
1083         fm->descent = 0;
1084         fm->proportional_p = 0;
1085
1086         for (i = 0; i < NUM_LEADING_BYTES; i++) {
1087                 if (charsets[i]) {
1088                         Lisp_Object charset =
1089                             CHARSET_BY_LEADING_BYTE(i + MIN_LEADING_BYTE);
1090                         Lisp_Object font_instance =
1091                             FACE_CACHEL_FONT(cachel, charset);
1092                         Lisp_Font_Instance *fi = XFONT_INSTANCE(font_instance);
1093
1094                         assert(CHARSETP(charset));
1095                         assert(FONT_INSTANCEP(font_instance));
1096
1097                         if (fm->ascent < (int)fi->ascent)
1098                                 fm->ascent = (int)fi->ascent;
1099                         if (fm->descent < (int)fi->descent)
1100                                 fm->descent = (int)fi->descent;
1101                         fm->height = fm->ascent + fm->descent;
1102                         if (fi->proportional_p)
1103                                 fm->proportional_p = 1;
1104                         if (EQ(charset, Vcharset_ascii))
1105                                 fm->width = fi->width;
1106                 }
1107         }
1108 }
1109
1110 #define FROB(field)                                                          \
1111   do {                                                                       \
1112     Lisp_Object new_val =                                                    \
1113       FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero);             \
1114     int bound = 1;                                                           \
1115     if (UNBOUNDP (new_val))                                                  \
1116       {                                                                      \
1117         bound = 0;                                                           \
1118         new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1119       }                                                                      \
1120     if (!EQ (new_val, cachel->field))                                        \
1121       {                                                                      \
1122         cachel->field = new_val;                                             \
1123         cachel->dirty = 1;                                                   \
1124       }                                                                      \
1125     cachel->field##_specified = (bound || default_face);                     \
1126   } while (0)
1127
1128 /*
1129  * A face's background pixmap will override the face's
1130  * background color.  But the background pixmap of the
1131  * default face should not override the background color of
1132  * a face if the background color has been specified or
1133  * inherited.
1134  *
1135  * To accomplish this we remove the background pixmap of the
1136  * cachel and mark it as having been specified so that cachel
1137  * merging won't override it later.
1138  */
1139 #define MAYBE_UNFROB_BACKGROUND_PIXMAP          \
1140 do                                              \
1141 {                                               \
1142   if (! default_face                            \
1143       && cachel->background_specified           \
1144       && ! cachel->background_pixmap_specified) \
1145     {                                           \
1146       cachel->background_pixmap = Qunbound;     \
1147       cachel->background_pixmap_specified = 1;  \
1148     }                                           \
1149 } while (0)
1150
1151 /* Add a cachel for the given face to the given window's cache. */
1152
1153 static void add_face_cachel(struct window *w, Lisp_Object face)
1154 {
1155         int must_finish_frobbing = !WINDOW_FACE_CACHEL(w, DEFAULT_INDEX);
1156         struct face_cachel new_cachel;
1157         Lisp_Object domain;
1158
1159         reset_face_cachel(&new_cachel);
1160         XSETWINDOW(domain, w);
1161         update_face_cachel_data(&new_cachel, domain, face);
1162         Dynarr_add(w->face_cachels, new_cachel);
1163
1164         /* The face's background pixmap have not yet been frobbed (see comment
1165            int update_face_cachel_data), so we have to do it now */
1166         if (must_finish_frobbing) {
1167                 int default_face = EQ(face, Vdefault_face);
1168                 struct face_cachel *cachel
1169                     =
1170                     Dynarr_atp(w->face_cachels,
1171                                Dynarr_length(w->face_cachels) - 1);
1172
1173                 FROB(background_pixmap);
1174                 MAYBE_UNFROB_BACKGROUND_PIXMAP;
1175         }
1176 }
1177
1178 /* Called when the updated flag has been cleared on a cachel.
1179    This function returns 1 if the caller must finish the update (see comment
1180    below), 0 otherwise.
1181 */
1182
1183 void
1184 update_face_cachel_data(struct face_cachel *cachel,
1185                         Lisp_Object domain, Lisp_Object face)
1186 {
1187         if (XFACE(face)->dirty || UNBOUNDP(cachel->face)) {
1188                 int default_face = EQ(face, Vdefault_face);
1189                 cachel->face = face;
1190
1191                 /* We normally only set the _specified flags if the value was
1192                    actually bound.  The exception is for the default face where
1193                    we always set it since it is the ultimate fallback. */
1194
1195                 FROB(foreground);
1196                 FROB(background);
1197                 FROB(display_table);
1198
1199                 /* #### WARNING: the background pixmap property of faces is currently
1200                    the only one dealing with images. The problem we have here is that
1201                    frobbing the background pixmap might lead to image instantiation
1202                    which in turn might require that the cache we're building be up to
1203                    date, hence a crash. Here's a typical scenario of this:
1204
1205                    - a new window is created and it's face cache elements are
1206                    initialized through a call to reset_face_cachels[1]. At that point,
1207                    the cache for the default and modeline faces (normaly taken care of
1208                    by redisplay itself) are null.
1209                    - the default face has a background pixmap which needs to be
1210                    instantiated right here, as a consequence of cache initialization.
1211                    - the background pixmap image happens to be instantiated as a string
1212                    (this happens on tty's for instance).
1213                    - In order to do this, we need to compute the string geometry.
1214                    - In order to do this, we might have to access the window's default
1215                    face cache. But this is the cache we're building right now, it is
1216                    null.
1217                    - BARF !!!!!
1218
1219                    To sum up, this means that it is in general unsafe to instantiate
1220                    images before face cache updating is complete (appart from image
1221                    related face attributes). The solution we use below is to actually
1222                    detect whether we're building the window's face_cachels for the first
1223                    time, and simply NOT frob the background pixmap in that case. If
1224                    other image-related face attributes are ever implemented, they should
1225                    be protected the same way right here.
1226
1227                    One note:
1228                    * See comment in `default_face_font_info' in face.c. Who wrote it ?
1229                    Maybe we have the begining of an answer here ?
1230
1231                    Footnotes:
1232                    [1] See comment at the top of `allocate_window' in window.c.
1233
1234                    -- didier
1235                  */
1236                 if (!WINDOWP(domain)
1237                     || WINDOW_FACE_CACHEL(DOMAIN_XWINDOW(domain),
1238                                           DEFAULT_INDEX)) {
1239                         FROB(background_pixmap);
1240                         MAYBE_UNFROB_BACKGROUND_PIXMAP;
1241                 }
1242 #undef FROB
1243 #undef MAYBE_UNFROB_BACKGROUND_PIXMAP
1244
1245                 ensure_face_cachel_contains_charset(cachel, domain,
1246                                                     Vcharset_ascii);
1247
1248 #define FROB(field)                                                          \
1249   do {                                                                       \
1250     Lisp_Object new_val =                                                    \
1251       FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero);             \
1252     int bound = 1;                                                           \
1253     unsigned int new_val_int;                                                \
1254     if (UNBOUNDP (new_val))                                                  \
1255       {                                                                      \
1256         bound = 0;                                                           \
1257         new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1258       }                                                                      \
1259     new_val_int = EQ (new_val, Qt);                                          \
1260     if (cachel->field != new_val_int)                                        \
1261       {                                                                      \
1262         cachel->field = new_val_int;                                         \
1263         cachel->dirty = 1;                                                   \
1264       }                                                                      \
1265     cachel->field##_specified = bound;                                       \
1266   } while (0)
1267
1268                 FROB(underline);
1269                 FROB(strikethru);
1270                 FROB(highlight);
1271                 FROB(dim);
1272                 FROB(reverse);
1273                 FROB(blinking);
1274 #undef FROB
1275         }
1276
1277         cachel->updated = 1;
1278 }
1279
1280 /* Merge the cachel identified by FINDEX in window W into the given
1281    cachel. */
1282
1283 static void
1284 merge_face_cachel_data(struct window *w, face_index findex,
1285                        struct face_cachel *cachel)
1286 {
1287 #define FINDEX_FIELD(field)                                             \
1288   Dynarr_atp (w->face_cachels, findex)->field
1289
1290 #define FROB(field)                                                     \
1291   do {                                                                  \
1292     if (!cachel->field##_specified && FINDEX_FIELD (field##_specified)) \
1293       {                                                                 \
1294         cachel->field = FINDEX_FIELD (field);                           \
1295         cachel->field##_specified = 1;                                  \
1296         cachel->dirty = 1;                                              \
1297       }                                                                 \
1298   } while (0)
1299
1300         FROB(foreground);
1301         FROB(background);
1302         FROB(display_table);
1303         FROB(background_pixmap);
1304         FROB(underline);
1305         FROB(strikethru);
1306         FROB(highlight);
1307         FROB(dim);
1308         FROB(reverse);
1309         FROB(blinking);
1310         /* And do ASCII, of course. */
1311         {
1312                 int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE;
1313
1314                 if (!cachel->font_specified[offs]
1315                     && FINDEX_FIELD(font_specified[offs])) {
1316                         cachel->font[offs] = FINDEX_FIELD(font[offs]);
1317                         cachel->font_specified[offs] = 1;
1318                         cachel->dirty = 1;
1319                 }
1320         }
1321
1322 #undef FROB
1323 #undef FINDEX_FIELD
1324
1325         cachel->updated = 1;
1326 }
1327
1328 /* Initialize a cachel. */
1329
1330 void reset_face_cachel(struct face_cachel *cachel)
1331 {
1332         xzero(*cachel);
1333         cachel->face = Qunbound;
1334         cachel->nfaces = 0;
1335         cachel->merged_faces = 0;
1336         cachel->foreground = Qunbound;
1337         cachel->background = Qunbound;
1338         {
1339                 int i;
1340
1341                 for (i = 0; i < NUM_LEADING_BYTES; i++)
1342                         cachel->font[i] = Qunbound;
1343         }
1344         cachel->display_table = Qunbound;
1345         cachel->background_pixmap = Qunbound;
1346 }
1347
1348 /* Retrieve the index to a cachel for window W that corresponds to
1349    the specified face.  If necessary, add a new element to the
1350    cache. */
1351
1352 face_index get_builtin_face_cache_index(struct window *w, Lisp_Object face)
1353 {
1354         int elt;
1355
1356         if (noninteractive)
1357                 return 0;
1358
1359         for (elt = 0; elt < Dynarr_length(w->face_cachels); elt++) {
1360                 struct face_cachel *cachel = WINDOW_FACE_CACHEL(w, elt);
1361
1362                 if (EQ(cachel->face, face)) {
1363                         Lisp_Object window;
1364                         XSETWINDOW(window, w);
1365                         if (!cachel->updated)
1366                                 update_face_cachel_data(cachel, window, face);
1367                         return elt;
1368                 }
1369         }
1370
1371         /* If we didn't find the face, add it and then return its index. */
1372         add_face_cachel(w, face);
1373         return elt;
1374 }
1375
1376 void reset_face_cachels(struct window *w)
1377 {
1378         /* #### Not initialized in batch mode for the stream device. */
1379         if (w->face_cachels) {
1380                 int i;
1381
1382                 for (i = 0; i < Dynarr_length(w->face_cachels); i++) {
1383                         struct face_cachel *cachel =
1384                             Dynarr_atp(w->face_cachels, i);
1385                         if (cachel->merged_faces)
1386                                 Dynarr_free(cachel->merged_faces);
1387                 }
1388                 Dynarr_reset(w->face_cachels);
1389                 get_builtin_face_cache_index(w, Vdefault_face);
1390                 get_builtin_face_cache_index(w, Vmodeline_face);
1391                 XFRAME(w->frame)->window_face_cache_reset = 1;
1392         }
1393 }
1394
1395 void mark_face_cachels_as_clean(struct window *w)
1396 {
1397         int elt;
1398
1399         for (elt = 0; elt < Dynarr_length(w->face_cachels); elt++)
1400                 Dynarr_atp(w->face_cachels, elt)->dirty = 0;
1401 }
1402
1403 void mark_face_cachels_as_not_updated(struct window *w)
1404 {
1405         int elt;
1406
1407         for (elt = 0; elt < Dynarr_length(w->face_cachels); elt++) {
1408                 struct face_cachel *cachel = Dynarr_atp(w->face_cachels, elt);
1409                 int i;
1410
1411                 cachel->updated = 0;
1412                 for (i = 0; i < NUM_LEADING_BYTES; i++)
1413                         cachel->font_updated[i] = 0;
1414         }
1415 }
1416
1417 #if defined MEMORY_USAGE_STATS && !(defined HAVE_BDWGC && defined EF_USE_BDWGC)
1418
1419 int
1420 compute_face_cachel_usage(face_cachel_dynarr * face_cachels,
1421                           struct overhead_stats *ovstats)
1422 {
1423         int total = 0;
1424
1425         if (face_cachels) {
1426                 int i;
1427
1428                 total += Dynarr_memory_usage(face_cachels, ovstats);
1429                 for (i = 0; i < Dynarr_length(face_cachels); i++) {
1430                         int_dynarr *merged =
1431                             Dynarr_at(face_cachels, i).merged_faces;
1432                         if (merged)
1433                                 total += Dynarr_memory_usage(merged, ovstats);
1434                 }
1435         }
1436
1437         return total;
1438 }
1439
1440 #endif                          /* MEMORY_USAGE_STATS */
1441 \f
1442 /*****************************************************************************
1443  *                             merged face functions                         *
1444  *****************************************************************************/
1445
1446 /* Compare two merged face cachels to determine whether we have to add
1447    a new entry to the face cache.
1448
1449    Note that we do not compare the attributes, but just the faces the
1450    cachels are based on.  If they are the same, then the cachels certainly
1451    ought to have the same attributes, except in the case where fonts
1452    for different charsets have been determined in the two -- and in that
1453    case this difference is fine. */
1454
1455 static int
1456 compare_merged_face_cachels(struct face_cachel *cachel1,
1457                             struct face_cachel *cachel2)
1458 {
1459         int i;
1460
1461         if (!EQ(cachel1->face, cachel2->face)
1462             || cachel1->nfaces != cachel2->nfaces)
1463                 return 0;
1464
1465         for (i = 0; i < cachel1->nfaces; i++)
1466                 if (FACE_CACHEL_FINDEX_UNSAFE(cachel1, i)
1467                     != FACE_CACHEL_FINDEX_UNSAFE(cachel2, i))
1468                         return 0;
1469
1470         return 1;
1471 }
1472
1473 /* Retrieve the index to a cachel for window W that corresponds to
1474    the specified cachel.  If necessary, add a new element to the
1475    cache.  This is similar to get_builtin_face_cache_index() but
1476    is intended for merged cachels rather than for cachels representing
1477    just a face.
1478
1479    Note that a merged cachel for just one face is not the same as
1480    the simple cachel for that face, because it is also merged with
1481    the default face. */
1482
1483 static face_index
1484 get_merged_face_cache_index(struct window *w, struct face_cachel *merged_cachel)
1485 {
1486         int elt;
1487         int cache_size = Dynarr_length(w->face_cachels);
1488
1489         for (elt = 0; elt < cache_size; elt++) {
1490                 struct face_cachel *cachel = Dynarr_atp(w->face_cachels, elt);
1491
1492                 if (compare_merged_face_cachels(cachel, merged_cachel))
1493                         return elt;
1494         }
1495
1496         /* We didn't find it so add this instance to the cache. */
1497         merged_cachel->updated = 1;
1498         merged_cachel->dirty = 1;
1499         Dynarr_add(w->face_cachels, *merged_cachel);
1500         return cache_size;
1501 }
1502
1503 face_index
1504 get_extent_fragment_face_cache_index(struct window * w,
1505                                      struct extent_fragment * ef)
1506 {
1507         struct face_cachel cachel;
1508         int len = Dynarr_length(ef->extents);
1509         face_index findex = 0;
1510         Lisp_Object window;
1511         XSETWINDOW(window, w);
1512
1513         /* Optimize the default case. */
1514         if (len == 0)
1515                 return DEFAULT_INDEX;
1516         else {
1517                 int i;
1518
1519                 /* Merge the faces of the extents together in order. */
1520
1521                 reset_face_cachel(&cachel);
1522
1523                 for (i = len - 1; i >= 0; i--) {
1524                         EXTENT current = Dynarr_at(ef->extents, i);
1525                         int has_findex = 0;
1526                         Lisp_Object face = extent_face(current);
1527
1528                         if (FACEP(face)) {
1529                                 findex = get_builtin_face_cache_index(w, face);
1530                                 has_findex = 1;
1531                                 merge_face_cachel_data(w, findex, &cachel);
1532                         }
1533                         /* remember, we're called from within redisplay
1534                            so we can't error. */
1535                         else
1536                                 while (CONSP(face)) {
1537                                         Lisp_Object one_face = XCAR(face);
1538                                         if (FACEP(one_face)) {
1539                                                 findex =
1540                                                     get_builtin_face_cache_index
1541                                                     (w, one_face);
1542                                                 merge_face_cachel_data(w,
1543                                                                        findex,
1544                                                                        &cachel);
1545
1546                                                 /* code duplication here but there's no clean
1547                                                    way to avoid it. */
1548                                                 if (cachel.nfaces >=
1549                                                     NUM_STATIC_CACHEL_FACES) {
1550                                                         if (!cachel.
1551                                                             merged_faces)
1552                                                                 cachel.
1553                                                                     merged_faces
1554                                                                     =
1555                                                                     Dynarr_new
1556                                                                     (int);
1557                                                         Dynarr_add(cachel.
1558                                                                    merged_faces,
1559                                                                    findex);
1560                                                 } else
1561                                                         cachel.
1562                                                             merged_faces_static
1563                                                             [cachel.nfaces] =
1564                                                             findex;
1565                                                 cachel.nfaces++;
1566                                         }
1567                                         face = XCDR(face);
1568                                 }
1569
1570                         if (has_findex) {
1571                                 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES) {
1572                                         if (!cachel.merged_faces)
1573                                                 cachel.merged_faces =
1574                                                     Dynarr_new(int);
1575                                         Dynarr_add(cachel.merged_faces, findex);
1576                                 } else
1577                                         cachel.merged_faces_static[cachel.
1578                                                                    nfaces] =
1579                                             findex;
1580                                 cachel.nfaces++;
1581                         }
1582                 }
1583
1584                 /* Now finally merge in the default face. */
1585                 findex = get_builtin_face_cache_index(w, Vdefault_face);
1586                 merge_face_cachel_data(w, findex, &cachel);
1587
1588                 findex = get_merged_face_cache_index(w, &cachel);
1589                 if (cachel.merged_faces &&
1590                     /* merged_faces did not get stored and available via return value */
1591                     Dynarr_at(w->face_cachels, findex).merged_faces !=
1592                     cachel.merged_faces) {
1593                         Dynarr_free(cachel.merged_faces);
1594                         cachel.merged_faces = 0;
1595                 }
1596                 return findex;
1597         }
1598 }
1599 \f
1600 /*****************************************************************************
1601  interface functions
1602  ****************************************************************************/
1603
1604 static void update_EmacsFrame(Lisp_Object frame, Lisp_Object name)
1605 {
1606         struct frame *frm = XFRAME(frame);
1607
1608         if (EQ(name, Qfont))
1609                 MARK_FRAME_SIZE_SLIPPED(frm);
1610
1611         MAYBE_FRAMEMETH(frm, update_frame_external_traits, (frm, name));
1612 }
1613
1614 static void update_EmacsFrames(Lisp_Object locale, Lisp_Object name)
1615 {
1616         if (FRAMEP(locale)) {
1617                 update_EmacsFrame(locale, name);
1618         } else if (DEVICEP(locale)) {
1619                 Lisp_Object frmcons;
1620
1621                 DEVICE_FRAME_LOOP(frmcons, XDEVICE(locale))
1622                     update_EmacsFrame(XCAR(frmcons), name);
1623         } else if (EQ(locale, Qglobal) || EQ(locale, Qfallback)) {
1624                 Lisp_Object frmcons, devcons, concons;
1625
1626                 FRAME_LOOP_NO_BREAK(frmcons, devcons, concons)
1627                     update_EmacsFrame(XCAR(frmcons), name);
1628         }
1629 }
1630
1631 void update_frame_face_values(struct frame *f)
1632 {
1633         Lisp_Object frm;
1634
1635         XSETFRAME(frm, f);
1636         update_EmacsFrame(frm, Qforeground);
1637         update_EmacsFrame(frm, Qbackground);
1638         update_EmacsFrame(frm, Qfont);
1639 }
1640
1641 void
1642 face_property_was_changed(Lisp_Object face, Lisp_Object property,
1643                           Lisp_Object locale)
1644 {
1645         int default_face = EQ(face, Vdefault_face);
1646
1647         /* If the locale could affect the frame value, then call
1648            update_EmacsFrames just in case. */
1649         if (default_face &&
1650             (EQ(property, Qforeground) ||
1651              EQ(property, Qbackground) || EQ(property, Qfont)))
1652                 update_EmacsFrames(locale, property);
1653
1654         if (WINDOWP(locale)) {
1655                 MARK_FRAME_FACES_CHANGED(XFRAME(XWINDOW(locale)->frame));
1656         } else if (FRAMEP(locale)) {
1657                 MARK_FRAME_FACES_CHANGED(XFRAME(locale));
1658         } else if (DEVICEP(locale)) {
1659                 MARK_DEVICE_FRAMES_FACES_CHANGED(XDEVICE(locale));
1660         } else {
1661                 Lisp_Object devcons, concons;
1662                 DEVICE_LOOP_NO_BREAK(devcons, concons)
1663                     MARK_DEVICE_FRAMES_FACES_CHANGED(XDEVICE(XCAR(devcons)));
1664         }
1665
1666         /*
1667          * This call to update_faces_inheritance isn't needed and makes
1668          * creating and modifying faces _very_ slow.  The point of
1669          * update_face_inheritances is to find all faces that inherit
1670          * directly from this face property and set the specifier "dirty"
1671          * flag on the corresponding specifier.  This forces recaching of
1672          * cached specifier values in frame and window struct slots.  But
1673          * currently no face properties are cached in frame and window
1674          * struct slots, so calling this function does nothing useful!
1675          *
1676          * Further, since update_faces_inheritance maps over the whole
1677          * face table every time it is called, it gets terribly slow when
1678          * there are many faces.  Creating 500 faces on a 50Mhz 486 took
1679          * 433 seconds when update_faces_inheritance was called.  With the
1680          * call commented out, creating those same 500 faces took 0.72
1681          * seconds.
1682          */
1683         /* update_faces_inheritance (face, property); */
1684         XFACE(face)->dirty = 1;
1685 }
1686
1687 DEFUN("copy-face", Fcopy_face, 2, 6, 0, /*
1688 Define and return a new face which is a copy of an existing one,
1689 or makes an already-existing face be exactly like another.
1690 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'.
1691 */
1692       (old_face, new_name, locale, tag_set, exact_p, how_to_add))
1693 {
1694         Lisp_Face *fold, *fnew;
1695         Lisp_Object new_face = Qnil;
1696         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1697
1698         old_face = Fget_face(old_face);
1699
1700         /* We GCPRO old_face because it might be temporary, and GCing could
1701            occur in various places below. */
1702         GCPRO4(tag_set, locale, old_face, new_face);
1703         /* check validity of how_to_add now. */
1704         decode_how_to_add_specification(how_to_add);
1705         /* and of tag_set. */
1706         tag_set = decode_specifier_tag_set(tag_set);
1707         /* and of locale. */
1708         locale = decode_locale_list(locale);
1709
1710         new_face = Ffind_face(new_name);
1711         if (NILP(new_face)) {
1712                 Lisp_Object temp;
1713
1714                 CHECK_SYMBOL(new_name);
1715
1716                 /* Create the new face with the same status as the old face. */
1717                 temp = (NILP(Fgethash(old_face, Vtemporary_faces_cache, Qnil))
1718                         ? Qnil : Qt);
1719
1720                 new_face = Fmake_face(new_name, Qnil, temp);
1721         }
1722
1723         fold = XFACE(old_face);
1724         fnew = XFACE(new_face);
1725
1726 #define COPY_PROPERTY(property) \
1727   Fcopy_specifier (fold->property, fnew->property, \
1728                    locale, tag_set, exact_p, how_to_add);
1729
1730         COPY_PROPERTY(foreground);
1731         COPY_PROPERTY(background);
1732         COPY_PROPERTY(font);
1733         COPY_PROPERTY(display_table);
1734         COPY_PROPERTY(background_pixmap);
1735         COPY_PROPERTY(underline);
1736         COPY_PROPERTY(strikethru);
1737         COPY_PROPERTY(highlight);
1738         COPY_PROPERTY(dim);
1739         COPY_PROPERTY(blinking);
1740         COPY_PROPERTY(reverse);
1741 #undef COPY_PROPERTY
1742         /* #### should it copy the individual specifiers, if they exist? */
1743         fnew->plist = Fcopy_sequence(fold->plist);
1744
1745         UNGCPRO;
1746
1747         return new_name;
1748 }
1749 \f
1750 void syms_of_faces(void)
1751 {
1752         INIT_LRECORD_IMPLEMENTATION(face);
1753
1754         /* Qdefault, Qwidget, Qleft_margin, Qright_margin defined in general.c */
1755         defsymbol(&Qmodeline, "modeline");
1756         defsymbol(&Qgui_element, "gui-element");
1757         defsymbol(&Qtext_cursor, "text-cursor");
1758         defsymbol(&Qvertical_divider, "vertical-divider");
1759
1760         DEFSUBR(Ffacep);
1761         DEFSUBR(Ffind_face);
1762         DEFSUBR(Fget_face);
1763         DEFSUBR(Fface_name);
1764         DEFSUBR(Fbuilt_in_face_specifiers);
1765         DEFSUBR(Fface_list);
1766         DEFSUBR(Fmake_face);
1767         DEFSUBR(Fcopy_face);
1768
1769         defsymbol(&Qfacep, "facep");
1770         defsymbol(&Qforeground, "foreground");
1771         defsymbol(&Qbackground, "background");
1772         /* Qfont defined in general.c */
1773         defsymbol(&Qdisplay_table, "display-table");
1774         defsymbol(&Qbackground_pixmap, "background-pixmap");
1775         defsymbol(&Qunderline, "underline");
1776         defsymbol(&Qstrikethru, "strikethru");
1777         /* Qhighlight, Qreverse defined in general.c */
1778         defsymbol(&Qdim, "dim");
1779         defsymbol(&Qblinking, "blinking");
1780
1781         defsymbol(&Qinit_face_from_resources, "init-face-from-resources");
1782         defsymbol(&Qinit_global_faces, "init-global-faces");
1783         defsymbol(&Qinit_device_faces, "init-device-faces");
1784         defsymbol(&Qinit_frame_faces, "init-frame-faces");
1785 }
1786
1787 void structure_type_create_faces(void)
1788 {
1789         struct structure_type *st;
1790
1791         st = define_structure_type(Qface, face_validate, face_instantiate);
1792
1793         define_structure_type_keyword(st, Qname, face_name_validate);
1794 }
1795
1796 void vars_of_faces(void)
1797 {
1798         staticpro(&Vpermanent_faces_cache);
1799         Vpermanent_faces_cache = Qnil;
1800         staticpro(&Vtemporary_faces_cache);
1801         Vtemporary_faces_cache = Qnil;
1802
1803         staticpro(&Vdefault_face);
1804         Vdefault_face = Qnil;
1805         staticpro(&Vgui_element_face);
1806         Vgui_element_face = Qnil;
1807         staticpro(&Vwidget_face);
1808         Vwidget_face = Qnil;
1809         staticpro(&Vmodeline_face);
1810         Vmodeline_face = Qnil;
1811         staticpro(&Vtoolbar_face);
1812         Vtoolbar_face = Qnil;
1813
1814         staticpro(&Vvertical_divider_face);
1815         Vvertical_divider_face = Qnil;
1816         staticpro(&Vleft_margin_face);
1817         Vleft_margin_face = Qnil;
1818         staticpro(&Vright_margin_face);
1819         Vright_margin_face = Qnil;
1820         staticpro(&Vtext_cursor_face);
1821         Vtext_cursor_face = Qnil;
1822         staticpro(&Vpointer_face);
1823         Vpointer_face = Qnil;
1824
1825         {
1826                 Lisp_Object syms[20];
1827                 int n = 0;
1828
1829                 syms[n++] = Qforeground;
1830                 syms[n++] = Qbackground;
1831                 syms[n++] = Qfont;
1832                 syms[n++] = Qdisplay_table;
1833                 syms[n++] = Qbackground_pixmap;
1834                 syms[n++] = Qunderline;
1835                 syms[n++] = Qstrikethru;
1836                 syms[n++] = Qhighlight;
1837                 syms[n++] = Qdim;
1838                 syms[n++] = Qblinking;
1839                 syms[n++] = Qreverse;
1840
1841                 Vbuilt_in_face_specifiers = Flist(n, syms);
1842                 staticpro(&Vbuilt_in_face_specifiers);
1843         }
1844 }
1845
1846 void complex_vars_of_faces(void)
1847 {
1848         Vpermanent_faces_cache =
1849             make_lisp_hash_table(10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
1850         Vtemporary_faces_cache =
1851             make_lisp_hash_table(0, HASH_TABLE_WEAK, HASH_TABLE_EQ);
1852
1853         /* Create the default face now so we know what it is immediately. */
1854
1855         Vdefault_face = Qnil;   /* so that Fmake_face() doesn't set up a bogus
1856                                    default value */
1857         Vdefault_face = Fmake_face(Qdefault, build_string("default face"),
1858                                    Qnil);
1859
1860         /* Provide some last-resort fallbacks to avoid utter fuckage if
1861            someone provides invalid values for the global specifications. */
1862
1863         {
1864                 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1865
1866 #ifdef HAVE_GTK
1867                 fg_fb = acons(list1(Qgtk), build_string("black"), fg_fb);
1868                 bg_fb = acons(list1(Qgtk), build_string("white"), bg_fb);
1869 #endif
1870 #ifdef HAVE_X_WINDOWS
1871                 fg_fb = acons(list1(Qx), build_string("black"), fg_fb);
1872                 bg_fb = acons(list1(Qx), build_string("white"), bg_fb);
1873 #endif
1874 #ifdef HAVE_TTY
1875                 fg_fb = acons(list1(Qtty), Fvector(0, 0), fg_fb);
1876                 bg_fb = acons(list1(Qtty), Fvector(0, 0), bg_fb);
1877 #endif
1878                 set_specifier_fallback(Fget(Vdefault_face, Qforeground, Qnil),
1879                                        fg_fb);
1880                 set_specifier_fallback(Fget(Vdefault_face, Qbackground, Qnil),
1881                                        bg_fb);
1882         }
1883
1884         /* #### We may want to have different fallback values if NeXTstep
1885            support is compiled in. */
1886         {
1887                 Lisp_Object inst_list = Qnil;
1888
1889 #if defined(HAVE_X_WINDOWS) || defined(HAVE_GTK)
1890                 /* This is kind of ugly because stephen wanted this to be CPP
1891                  ** identical to the old version, at least for the initial
1892                  ** checkin
1893                  **
1894                  ** WMP March 9, 2001
1895                  */
1896
1897                 /* The same gory list from x-faces.el.
1898                    (#### Perhaps we should remove the stuff from x-faces.el
1899                    and only depend on this stuff here?  That should work.)
1900                  */
1901                 const char *fonts[] = {
1902                         "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
1903                         "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
1904                         "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*",
1905                         "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*",
1906                         "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*",
1907                         "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*",
1908                         "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*",
1909                         "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*",
1910                         "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*",
1911                         "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*",
1912                         "-*-*-*-r-*-*-*-120-*-*-m-*-*-*",
1913                         "-*-*-*-r-*-*-*-120-*-*-c-*-*-*",
1914                         "-*-*-*-r-*-*-*-120-*-*-*-*-*-*",
1915                         "-*-*-*-*-*-*-*-120-*-*-*-*-*-*",
1916                         "*"
1917                 };
1918                 const char **fontptr;
1919
1920 #ifdef HAVE_X_WINDOWS
1921                 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts;
1922                      fontptr--)
1923                         inst_list =
1924                             Fcons(Fcons(list1(Qx), build_string(*fontptr)),
1925                                   inst_list);
1926 #endif                          /* HAVE_X_WINDOWS */
1927
1928 #ifdef HAVE_GTK
1929                 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts;
1930                      fontptr--)
1931                         inst_list =
1932                             Fcons(Fcons(list1(Qgtk), build_string(*fontptr)),
1933                                   inst_list);
1934 #endif                          /* HAVE_GTK */
1935 #endif                          /* HAVE_X_WINDOWS || HAVE_GTK */
1936
1937 #ifdef HAVE_TTY
1938                 inst_list = Fcons(Fcons(list1(Qtty), build_string("normal")),
1939                                   inst_list);
1940 #endif                          /* HAVE_TTY */
1941                 set_specifier_fallback(Fget(Vdefault_face, Qfont, Qnil),
1942                                        inst_list);
1943         }
1944
1945         set_specifier_fallback(Fget(Vdefault_face, Qunderline, Qnil),
1946                                list1(Fcons(Qnil, Qnil)));
1947         set_specifier_fallback(Fget(Vdefault_face, Qstrikethru, Qnil),
1948                                list1(Fcons(Qnil, Qnil)));
1949         set_specifier_fallback(Fget(Vdefault_face, Qhighlight, Qnil),
1950                                list1(Fcons(Qnil, Qnil)));
1951         set_specifier_fallback(Fget(Vdefault_face, Qdim, Qnil),
1952                                list1(Fcons(Qnil, Qnil)));
1953         set_specifier_fallback(Fget(Vdefault_face, Qblinking, Qnil),
1954                                list1(Fcons(Qnil, Qnil)));
1955         set_specifier_fallback(Fget(Vdefault_face, Qreverse, Qnil),
1956                                list1(Fcons(Qnil, Qnil)));
1957
1958         /* gui-element is the parent face of all gui elements such as
1959            modeline, vertical divider and toolbar. */
1960         Vgui_element_face = Fmake_face(Qgui_element,
1961                                        build_string("gui element face"), Qnil);
1962
1963         /* Provide some last-resort fallbacks for gui-element face which
1964            mustn't default to default. */
1965         {
1966                 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1967
1968 #ifdef HAVE_GTK
1969                 /* We need to put something in there, or error checking gets
1970                    #%!@#ed up before the styles are set, which override the
1971                    fallbacks. */
1972                 fg_fb = acons(list1(Qgtk), build_string("black"), fg_fb);
1973                 bg_fb = acons(list1(Qgtk), build_string("Gray80"), bg_fb);
1974 #endif
1975 #ifdef HAVE_X_WINDOWS
1976                 fg_fb = acons(list1(Qx), build_string("black"), fg_fb);
1977                 bg_fb = acons(list1(Qx), build_string("Gray80"), bg_fb);
1978 #endif
1979 #ifdef HAVE_TTY
1980                 fg_fb = acons(list1(Qtty), Fvector(0, 0), fg_fb);
1981                 bg_fb = acons(list1(Qtty), Fvector(0, 0), bg_fb);
1982 #endif
1983                 set_specifier_fallback(Fget
1984                                        (Vgui_element_face, Qforeground, Qnil),
1985                                        fg_fb);
1986                 set_specifier_fallback(Fget
1987                                        (Vgui_element_face, Qbackground, Qnil),
1988                                        bg_fb);
1989         }
1990
1991         /* Now create the other faces that redisplay needs to refer to
1992            directly.  We could create them in Lisp but it's simpler this
1993            way since we need to get them anyway. */
1994
1995         /* modeline is gui element. */
1996         Vmodeline_face = Fmake_face(Qmodeline, build_string("modeline face"),
1997                                     Qnil);
1998
1999         set_specifier_fallback(Fget(Vmodeline_face, Qforeground, Qunbound),
2000                                Fget(Vgui_element_face, Qforeground, Qunbound));
2001         set_specifier_fallback(Fget(Vmodeline_face, Qbackground, Qunbound),
2002                                Fget(Vgui_element_face, Qbackground, Qunbound));
2003         set_specifier_fallback(Fget(Vmodeline_face, Qbackground_pixmap, Qnil),
2004                                Fget(Vgui_element_face, Qbackground_pixmap,
2005                                     Qunbound));
2006
2007         /* toolbar is another gui element */
2008         Vtoolbar_face = Fmake_face(Qtoolbar,
2009                                    build_string("toolbar face"), Qnil);
2010         set_specifier_fallback(Fget(Vtoolbar_face, Qforeground, Qunbound),
2011                                Fget(Vgui_element_face, Qforeground, Qunbound));
2012         set_specifier_fallback(Fget(Vtoolbar_face, Qbackground, Qunbound),
2013                                Fget(Vgui_element_face, Qbackground, Qunbound));
2014         set_specifier_fallback(Fget(Vtoolbar_face, Qbackground_pixmap, Qnil),
2015                                Fget(Vgui_element_face, Qbackground_pixmap,
2016                                     Qunbound));
2017
2018         /* vertical divider is another gui element */
2019         Vvertical_divider_face = Fmake_face(Qvertical_divider,
2020                                             build_string
2021                                             ("vertical divider face"), Qnil);
2022
2023         set_specifier_fallback(Fget
2024                                (Vvertical_divider_face, Qforeground, Qunbound),
2025                                Fget(Vgui_element_face, Qforeground, Qunbound));
2026         set_specifier_fallback(Fget
2027                                (Vvertical_divider_face, Qbackground, Qunbound),
2028                                Fget(Vgui_element_face, Qbackground, Qunbound));
2029         set_specifier_fallback(Fget
2030                                (Vvertical_divider_face, Qbackground_pixmap,
2031                                 Qunbound), Fget(Vgui_element_face,
2032                                                 Qbackground_pixmap, Qunbound));
2033
2034         /* widget is another gui element */
2035         Vwidget_face = Fmake_face(Qwidget, build_string("widget face"), Qnil);
2036         set_specifier_fallback(Fget(Vwidget_face, Qfont, Qunbound),
2037                                Fget(Vgui_element_face, Qfont, Qunbound));
2038         set_specifier_fallback(Fget(Vwidget_face, Qforeground, Qunbound),
2039                                Fget(Vgui_element_face, Qforeground, Qunbound));
2040         set_specifier_fallback(Fget(Vwidget_face, Qbackground, Qunbound),
2041                                Fget(Vgui_element_face, Qbackground, Qunbound));
2042         /* We don't want widgets to have a default background pixmap. */
2043
2044         Vleft_margin_face = Fmake_face(Qleft_margin,
2045                                        build_string("left margin face"), Qnil);
2046         Vright_margin_face = Fmake_face(Qright_margin,
2047                                         build_string("right margin face"),
2048                                         Qnil);
2049         Vtext_cursor_face = Fmake_face(Qtext_cursor,
2050                                        build_string("face for text cursor"),
2051                                        Qnil);
2052         Vpointer_face =
2053             Fmake_face(Qpointer,
2054                        build_string
2055                        ("face for foreground/background colors of mouse pointer"),
2056                        Qnil);
2057 }