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.
7 This file is part of XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* Synched up with: Not in FSF. */
26 /* Written by Chuck Thompson and Ben Wing,
27 based loosely on old face code by Jamie Zawinski. */
40 #include "specifier.h"
44 Lisp_Object Qforeground, Qbackground, Qdisplay_table;
45 Lisp_Object Qbackground_pixmap, Qunderline, Qdim;
46 Lisp_Object Qblinking, Qstrikethru;
48 Lisp_Object Qinit_face_from_resources;
49 Lisp_Object Qinit_frame_faces;
50 Lisp_Object Qinit_device_faces;
51 Lisp_Object Qinit_global_faces;
53 /* These faces are used directly internally. We use these variables
54 to be able to reference them directly and save the overhead of
55 calling Ffind_face. */
56 Lisp_Object Vdefault_face, Vmodeline_face, Vgui_element_face;
57 Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face;
58 Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face, Vwidget_face;
60 /* Qdefault, Qhighlight defined in general.c */
61 Lisp_Object Qmodeline, Qgui_element, Qleft_margin, Qright_margin, Qtext_cursor;
62 Lisp_Object Qvertical_divider;
64 /* In the old implementation Vface_list was a list of the face names,
65 not the faces themselves. We now distinguish between permanent and
66 temporary faces. Permanent faces are kept in a regular hash table,
67 temporary faces in a weak hash table. */
68 Lisp_Object Vpermanent_faces_cache;
69 Lisp_Object Vtemporary_faces_cache;
71 Lisp_Object Vbuilt_in_face_specifiers;
76 mark_face (Lisp_Object obj, void (*markobj) (Lisp_Object))
78 struct Lisp_Face *face = XFACE (obj);
81 markobj (face->doc_string);
83 markobj (face->foreground);
84 markobj (face->background);
86 markobj (face->display_table);
87 markobj (face->background_pixmap);
88 markobj (face->underline);
89 markobj (face->strikethru);
90 markobj (face->highlight);
92 markobj (face->blinking);
93 markobj (face->reverse);
95 markobj (face->charsets_warned_about);
101 print_face (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
103 struct Lisp_Face *face = XFACE (obj);
107 write_c_string ("#s(face name ", printcharfun);
108 print_internal (face->name, printcharfun, 1);
109 write_c_string (")", printcharfun);
113 write_c_string ("#<face ", printcharfun);
114 print_internal (face->name, printcharfun, 1);
115 if (!NILP (face->doc_string))
117 write_c_string (" ", printcharfun);
118 print_internal (face->doc_string, printcharfun, 1);
120 write_c_string (">", printcharfun);
124 /* Faces are equal if all of their display attributes are equal. We
125 don't compare names or doc-strings, because that would make equal
128 This isn't concerned with "unspecified" attributes, that's what
129 #'face-differs-from-default-p is for. */
131 face_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
133 struct Lisp_Face *f1 = XFACE (obj1);
134 struct Lisp_Face *f2 = XFACE (obj2);
139 (internal_equal (f1->foreground, f2->foreground, depth) &&
140 internal_equal (f1->background, f2->background, depth) &&
141 internal_equal (f1->font, f2->font, depth) &&
142 internal_equal (f1->display_table, f2->display_table, depth) &&
143 internal_equal (f1->background_pixmap, f2->background_pixmap, depth) &&
144 internal_equal (f1->underline, f2->underline, depth) &&
145 internal_equal (f1->strikethru, f2->strikethru, depth) &&
146 internal_equal (f1->highlight, f2->highlight, depth) &&
147 internal_equal (f1->dim, f2->dim, depth) &&
148 internal_equal (f1->blinking, f2->blinking, depth) &&
149 internal_equal (f1->reverse, f2->reverse, depth) &&
151 ! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1));
155 face_hash (Lisp_Object obj, int depth)
157 struct Lisp_Face *f = XFACE (obj);
161 /* No need to hash all of the elements; that would take too long.
162 Just hash the most common ones. */
163 return HASH3 (internal_hash (f->foreground, depth),
164 internal_hash (f->background, depth),
165 internal_hash (f->font, depth));
169 face_getprop (Lisp_Object obj, Lisp_Object prop)
171 struct Lisp_Face *f = XFACE (obj);
174 ((EQ (prop, Qforeground)) ? f->foreground :
175 (EQ (prop, Qbackground)) ? f->background :
176 (EQ (prop, Qfont)) ? f->font :
177 (EQ (prop, Qdisplay_table)) ? f->display_table :
178 (EQ (prop, Qbackground_pixmap)) ? f->background_pixmap :
179 (EQ (prop, Qunderline)) ? f->underline :
180 (EQ (prop, Qstrikethru)) ? f->strikethru :
181 (EQ (prop, Qhighlight)) ? f->highlight :
182 (EQ (prop, Qdim)) ? f->dim :
183 (EQ (prop, Qblinking)) ? f->blinking :
184 (EQ (prop, Qreverse)) ? f->reverse :
185 (EQ (prop, Qdoc_string)) ? f->doc_string :
186 external_plist_get (&f->plist, prop, 0, ERROR_ME));
190 face_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
192 struct Lisp_Face *f = XFACE (obj);
194 if (EQ (prop, Qforeground) ||
195 EQ (prop, Qbackground) ||
197 EQ (prop, Qdisplay_table) ||
198 EQ (prop, Qbackground_pixmap) ||
199 EQ (prop, Qunderline) ||
200 EQ (prop, Qstrikethru) ||
201 EQ (prop, Qhighlight) ||
203 EQ (prop, Qblinking) ||
207 if (EQ (prop, Qdoc_string))
210 CHECK_STRING (value);
211 f->doc_string = value;
215 external_plist_put (&f->plist, prop, value, 0, ERROR_ME);
220 face_remprop (Lisp_Object obj, Lisp_Object prop)
222 struct Lisp_Face *f = XFACE (obj);
224 if (EQ (prop, Qforeground) ||
225 EQ (prop, Qbackground) ||
227 EQ (prop, Qdisplay_table) ||
228 EQ (prop, Qbackground_pixmap) ||
229 EQ (prop, Qunderline) ||
230 EQ (prop, Qstrikethru) ||
231 EQ (prop, Qhighlight) ||
233 EQ (prop, Qblinking) ||
237 if (EQ (prop, Qdoc_string))
239 f->doc_string = Qnil;
243 return external_remprop (&f->plist, prop, 0, ERROR_ME);
247 face_plist (Lisp_Object obj)
249 struct Lisp_Face *face = XFACE (obj);
250 Lisp_Object result = face->plist;
252 result = cons3 (Qreverse, face->reverse, result);
253 result = cons3 (Qblinking, face->blinking, result);
254 result = cons3 (Qdim, face->dim, result);
255 result = cons3 (Qhighlight, face->highlight, result);
256 result = cons3 (Qstrikethru, face->strikethru, result);
257 result = cons3 (Qunderline, face->underline, result);
258 result = cons3 (Qbackground_pixmap, face->background_pixmap, result);
259 result = cons3 (Qdisplay_table, face->display_table, result);
260 result = cons3 (Qfont, face->font, result);
261 result = cons3 (Qbackground, face->background, result);
262 result = cons3 (Qforeground, face->foreground, result);
267 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face,
268 mark_face, print_face, 0, face_equal,
269 face_hash, 0, face_getprop,
270 face_putprop, face_remprop,
271 face_plist, struct Lisp_Face);
273 /************************************************************************/
274 /* face read syntax */
275 /************************************************************************/
278 face_name_validate (Lisp_Object keyword, Lisp_Object value,
281 if (ERRB_EQ (errb, ERROR_ME))
283 CHECK_SYMBOL (value);
287 return SYMBOLP (value);
291 face_validate (Lisp_Object data, Error_behavior errb)
294 Lisp_Object valw = Qnil;
296 data = Fcdr (data); /* skip over Qface */
299 Lisp_Object keyw = Fcar (data);
304 if (EQ (keyw, Qname))
312 maybe_error (Qface, errb, "No face name given");
316 if (NILP (Ffind_face (valw)))
318 maybe_signal_simple_error ("No such face", valw, Qface, errb);
326 face_instantiate (Lisp_Object data)
328 return Fget_face (Fcar (Fcdr (data)));
332 /****************************************************************************
333 * utility functions *
334 ****************************************************************************/
337 reset_face (struct Lisp_Face *f)
340 f->doc_string = Qnil;
342 f->foreground = Qnil;
343 f->background = Qnil;
345 f->display_table = Qnil;
346 f->background_pixmap = Qnil;
348 f->strikethru = Qnil;
354 f->charsets_warned_about = Qnil;
357 static struct Lisp_Face *
360 struct Lisp_Face *result =
361 alloc_lcrecord_type (struct Lisp_Face, &lrecord_face);
368 /* We store the faces in hash tables with the names as the key and the
369 actual face object as the value. Occasionally we need to use them
370 in a list format. These routines provide us with that. */
371 struct face_list_closure
373 Lisp_Object *face_list;
377 add_face_to_list_mapper (Lisp_Object key, Lisp_Object value,
378 void *face_list_closure)
380 /* This function can GC */
381 struct face_list_closure *fcl =
382 (struct face_list_closure *) face_list_closure;
384 *(fcl->face_list) = Fcons (XFACE (value)->name, (*fcl->face_list));
389 faces_list_internal (Lisp_Object list)
391 Lisp_Object face_list = Qnil;
393 struct face_list_closure face_list_closure;
396 face_list_closure.face_list = &face_list;
397 elisp_maphash (add_face_to_list_mapper, list, &face_list_closure);
404 permanent_faces_list (void)
406 return faces_list_internal (Vpermanent_faces_cache);
410 temporary_faces_list (void)
412 return faces_list_internal (Vtemporary_faces_cache);
417 mark_face_as_clean_mapper (Lisp_Object key, Lisp_Object value,
420 /* This function can GC */
421 int *flag = (int *) flag_closure;
422 XFACE (value)->dirty = *flag;
427 mark_all_faces_internal (int flag)
429 elisp_maphash (mark_face_as_clean_mapper, Vpermanent_faces_cache, &flag);
430 elisp_maphash (mark_face_as_clean_mapper, Vtemporary_faces_cache, &flag);
434 mark_all_faces_as_clean (void)
436 mark_all_faces_internal (0);
439 /* Currently unused (see the comment in face_property_was_changed()). */
441 /* #### OBSOLETE ME, PLEASE. Maybe. Maybe this is just as good as
442 any other solution. */
443 struct face_inheritance_closure
446 Lisp_Object property;
450 update_inheritance_mapper_internal (Lisp_Object cur_face,
451 Lisp_Object inh_face,
452 Lisp_Object property)
454 /* #### fix this function */
455 Lisp_Object elt = Qnil;
460 for (elt = FACE_PROPERTY_SPEC_LIST (cur_face, property, Qall);
464 Lisp_Object values = XCDR (XCAR (elt));
466 for (; !NILP (values); values = XCDR (values))
468 Lisp_Object value = XCDR (XCAR (values));
469 if (VECTORP (value) && XVECTOR_LENGTH (value))
471 if (EQ (Ffind_face (XVECTOR_DATA (value)[0]), inh_face))
472 Fset_specifier_dirty_flag
473 (FACE_PROPERTY_SPECIFIER (inh_face, property));
482 update_face_inheritance_mapper (CONST void *hash_key, void *hash_contents,
483 void *face_inheritance_closure)
485 Lisp_Object key, contents;
486 struct face_inheritance_closure *fcl =
487 (struct face_inheritance_closure *) face_inheritance_closure;
489 CVOID_TO_LISP (key, hash_key);
490 VOID_TO_LISP (contents, hash_contents);
492 if (EQ (fcl->property, Qfont))
494 update_inheritance_mapper_internal (contents, fcl->face, Qfont);
496 else if (EQ (fcl->property, Qforeground) ||
497 EQ (fcl->property, Qbackground))
499 update_inheritance_mapper_internal (contents, fcl->face, Qforeground);
500 update_inheritance_mapper_internal (contents, fcl->face, Qbackground);
502 else if (EQ (fcl->property, Qunderline) ||
503 EQ (fcl->property, Qstrikethru) ||
504 EQ (fcl->property, Qhighlight) ||
505 EQ (fcl->property, Qdim) ||
506 EQ (fcl->property, Qblinking) ||
507 EQ (fcl->property, Qreverse))
509 update_inheritance_mapper_internal (contents, fcl->face, Qunderline);
510 update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru);
511 update_inheritance_mapper_internal (contents, fcl->face, Qhighlight);
512 update_inheritance_mapper_internal (contents, fcl->face, Qdim);
513 update_inheritance_mapper_internal (contents, fcl->face, Qblinking);
514 update_inheritance_mapper_internal (contents, fcl->face, Qreverse);
520 update_faces_inheritance (Lisp_Object face, Lisp_Object property)
522 struct face_inheritance_closure face_inheritance_closure;
523 struct gcpro gcpro1, gcpro2;
525 GCPRO2 (face, property);
526 face_inheritance_closure.face = face;
527 face_inheritance_closure.property = property;
529 elisp_maphash (update_face_inheritance_mapper, Vpermanent_faces_cache,
530 &face_inheritance_closure);
531 elisp_maphash (update_face_inheritance_mapper, Vtemporary_faces_cache,
532 &face_inheritance_closure);
539 face_property_matching_instance (Lisp_Object face, Lisp_Object property,
540 Lisp_Object charset, Lisp_Object domain,
541 Error_behavior errb, int no_fallback,
545 specifier_instance_no_quit (Fget (face, property, Qnil), charset,
546 domain, errb, no_fallback, depth);
548 if (UNBOUNDP (retval) && !no_fallback)
550 if (EQ (property, Qfont))
552 if (NILP (memq_no_quit (charset,
553 XFACE (face)->charsets_warned_about)))
556 if (! UNBOUNDP (charset))
559 "Unable to instantiate font for face %s, charset %s",
560 string_data (symbol_name
561 (XSYMBOL (XFACE (face)->name))),
562 string_data (symbol_name
563 (XSYMBOL (XCHARSET_NAME (charset)))));
566 warn_when_safe (Qfont, Qwarning,
567 "Unable to instantiate font for face %s",
568 string_data (symbol_name
569 (XSYMBOL (XFACE (face)->name))));
570 XFACE (face)->charsets_warned_about =
571 Fcons (charset, XFACE (face)->charsets_warned_about);
573 retval = Vthe_null_font_instance;
581 DEFUN ("facep", Ffacep, 1, 1, 0, /*
582 Return non-nil if OBJECT is a face.
586 return FACEP (object) ? Qt : Qnil;
589 DEFUN ("find-face", Ffind_face, 1, 1, 0, /*
590 Retrieve the face of the given name.
591 If FACE-OR-NAME is a face object, it is simply returned.
592 Otherwise, FACE-OR-NAME should be a symbol. If there is no such face,
593 nil is returned. Otherwise the associated face object is returned.
599 if (FACEP (face_or_name))
601 CHECK_SYMBOL (face_or_name);
603 /* Check if the name represents a permanent face. */
604 retval = Fgethash (face_or_name, Vpermanent_faces_cache, Qnil);
608 /* Check if the name represents a temporary face. */
609 return Fgethash (face_or_name, Vtemporary_faces_cache, Qnil);
612 DEFUN ("get-face", Fget_face, 1, 1, 0, /*
613 Retrieve the face of the given name.
614 Same as `find-face' except an error is signalled if there is no such
615 face instead of returning nil.
619 Lisp_Object face = Ffind_face (name);
622 signal_simple_error ("No such face", name);
626 DEFUN ("face-name", Fface_name, 1, 1, 0, /*
627 Return the name of the given face.
631 return XFACE (Fget_face (face))->name;
634 DEFUN ("built-in-face-specifiers", Fbuilt_in_face_specifiers, 0, 0, 0, /*
635 Return a list of all built-in face specifier properties.
636 Don't modify this list!
640 return Vbuilt_in_face_specifiers;
643 /* These values are retrieved so often that we make a special
648 default_face_font_info (Lisp_Object domain, int *ascent, int *descent,
649 int *height, int *width, int *proportional_p)
651 Lisp_Object font_instance;
668 /* We use ASCII here. This is probably reasonable because the
669 people calling this function are using the resulting values to
670 come up with overall sizes for windows and frames. */
671 if (WINDOWP (domain))
673 struct face_cachel *cachel;
674 struct window *w = XWINDOW (domain);
676 /* #### It's possible for this function to get called when the
677 face cachels have not been initialized. I don't know why. */
678 if (!Dynarr_length (w->face_cachels))
679 reset_face_cachels (w);
680 cachel = WINDOW_FACE_CACHEL (w, DEFAULT_INDEX);
681 font_instance = FACE_CACHEL_FONT (cachel, Vcharset_ascii);
685 font_instance = FACE_FONT (Vdefault_face, domain, Vcharset_ascii);
689 *height = XFONT_INSTANCE (font_instance)->height;
691 *width = XFONT_INSTANCE (font_instance)->width;
693 *ascent = XFONT_INSTANCE (font_instance)->ascent;
695 *descent = XFONT_INSTANCE (font_instance)->descent;
697 *proportional_p = XFONT_INSTANCE (font_instance)->proportional_p;
701 default_face_height_and_width (Lisp_Object domain,
702 int *height, int *width)
704 default_face_font_info (domain, 0, 0, height, width, 0);
708 default_face_height_and_width_1 (Lisp_Object domain,
709 int *height, int *width)
711 if (window_system_pixelated_geometry (domain))
719 default_face_height_and_width (domain, height, width);
722 DEFUN ("face-list", Fface_list, 0, 1, 0, /*
723 Return a list of the names of all defined faces.
724 If TEMPORARY is nil, only the permanent faces are included.
725 If it is t, only the temporary faces are included. If it is any
726 other non-nil value both permanent and temporary are included.
730 Lisp_Object face_list = Qnil;
732 /* Added the permanent faces, if requested. */
733 if (NILP (temporary) || !EQ (Qt, temporary))
734 face_list = permanent_faces_list ();
736 if (!NILP (temporary))
740 face_list = nconc2 (face_list, temporary_faces_list ());
747 DEFUN ("make-face", Fmake_face, 1, 3, 0, /*
748 Define and return a new FACE described by DOC-STRING.
749 You can modify the font, color, etc of a face with the set-face-* functions.
750 If the face already exists, it is unmodified.
751 If TEMPORARY is non-nil, this face will cease to exist if not in use.
753 (name, doc_string, temporary))
755 /* This function can GC if initialized is non-zero */
760 if (!NILP (doc_string))
761 CHECK_STRING (doc_string);
763 face = Ffind_face (name);
767 f = allocate_face ();
771 f->doc_string = doc_string;
772 f->foreground = Fmake_specifier (Qcolor);
773 set_color_attached_to (f->foreground, face, Qforeground);
774 f->background = Fmake_specifier (Qcolor);
775 set_color_attached_to (f->background, face, Qbackground);
776 f->font = Fmake_specifier (Qfont);
777 set_font_attached_to (f->font, face, Qfont);
778 f->background_pixmap = Fmake_specifier (Qimage);
779 set_image_attached_to (f->background_pixmap, face, Qbackground_pixmap);
780 f->display_table = Fmake_specifier (Qdisplay_table);
781 f->underline = Fmake_specifier (Qface_boolean);
782 set_face_boolean_attached_to (f->underline, face, Qunderline);
783 f->strikethru = Fmake_specifier (Qface_boolean);
784 set_face_boolean_attached_to (f->strikethru, face, Qstrikethru);
785 f->highlight = Fmake_specifier (Qface_boolean);
786 set_face_boolean_attached_to (f->highlight, face, Qhighlight);
787 f->dim = Fmake_specifier (Qface_boolean);
788 set_face_boolean_attached_to (f->dim, face, Qdim);
789 f->blinking = Fmake_specifier (Qface_boolean);
790 set_face_boolean_attached_to (f->blinking, face, Qblinking);
791 f->reverse = Fmake_specifier (Qface_boolean);
792 set_face_boolean_attached_to (f->reverse, face, Qreverse);
793 if (!NILP (Vdefault_face))
795 /* If the default face has already been created, set it as
796 the default fallback specifier for all the specifiers we
797 just created. This implements the standard "all faces
798 inherit from default" behavior. */
799 set_specifier_fallback (f->foreground,
800 Fget (Vdefault_face, Qforeground, Qunbound));
801 set_specifier_fallback (f->background,
802 Fget (Vdefault_face, Qbackground, Qunbound));
803 set_specifier_fallback (f->font,
804 Fget (Vdefault_face, Qfont, Qunbound));
805 set_specifier_fallback (f->background_pixmap,
806 Fget (Vdefault_face, Qbackground_pixmap,
808 set_specifier_fallback (f->display_table,
809 Fget (Vdefault_face, Qdisplay_table, Qunbound));
810 set_specifier_fallback (f->underline,
811 Fget (Vdefault_face, Qunderline, Qunbound));
812 set_specifier_fallback (f->strikethru,
813 Fget (Vdefault_face, Qstrikethru, Qunbound));
814 set_specifier_fallback (f->highlight,
815 Fget (Vdefault_face, Qhighlight, Qunbound));
816 set_specifier_fallback (f->dim,
817 Fget (Vdefault_face, Qdim, Qunbound));
818 set_specifier_fallback (f->blinking,
819 Fget (Vdefault_face, Qblinking, Qunbound));
820 set_specifier_fallback (f->reverse,
821 Fget (Vdefault_face, Qreverse, Qunbound));
824 /* Add the face to the appropriate list. */
825 if (NILP (temporary))
826 Fputhash (name, face, Vpermanent_faces_cache);
828 Fputhash (name, face, Vtemporary_faces_cache);
830 /* Note that it's OK if we dump faces.
831 When we start up again when we're not noninteractive,
832 `init-global-faces' is called and it resources all
834 if (initialized && !noninteractive)
836 struct gcpro gcpro1, gcpro2;
839 call1 (Qinit_face_from_resources, name);
847 /*****************************************************************************
849 ****************************************************************************/
852 init_global_faces (struct device *d)
854 /* When making the initial terminal device, there is no Lisp code
855 loaded, so we can't do this. */
856 if (initialized && !noninteractive)
858 call_critical_lisp_code (d, Qinit_global_faces, Qnil);
863 init_device_faces (struct device *d)
865 /* This function can call lisp */
867 /* When making the initial terminal device, there is no Lisp code
868 loaded, so we can't do this. */
872 XSETDEVICE (tdevice, d);
873 call_critical_lisp_code (d, Qinit_device_faces, tdevice);
878 init_frame_faces (struct frame *frm)
880 /* When making the initial terminal device, there is no Lisp code
881 loaded, so we can't do this. */
885 XSETFRAME (tframe, frm);
887 /* DO NOT change the selected frame here. If the debugger goes off
888 it will try and display on the frame being created, but it is not
889 ready for that yet and a horrible death will occur. Any random
890 code depending on the selected-frame as an implicit arg should be
891 tracked down and shot. For the benefit of the one known,
892 xpm-color-symbols, make-frame sets the variable
893 Vframe_being_created to the frame it is making and sets it to nil
894 when done. Internal functions that this could trigger which are
895 currently depending on selected-frame should use this instead. It
896 is not currently visible at the lisp level. */
897 call_critical_lisp_code (XDEVICE (FRAME_DEVICE (frm)),
898 Qinit_frame_faces, tframe);
903 /****************************************************************************
904 * face cache element functions *
905 ****************************************************************************/
909 #### Here is a description of how the face cache elements ought
910 to be redone. It is *NOT* how they work currently:
912 However, when I started to go about implementing this, I realized
913 that there are all sorts of subtle problems with cache coherency
914 that are coming up. As it turns out, these problems don't
915 manifest themselves now due to the brute-force "kill 'em all"
916 approach to cache invalidation when faces change; but if this
917 is ever made smarter, these problems are going to come up, and
918 some of them are very non-obvious.
920 I'm thinking of redoing the cache code a bit to avoid these
921 coherency problems. The bulk of the problems will arise because
922 the current display structures have simple indices into the
923 face cache, but the cache can be changed at various times,
924 which could make the current display structures incorrect.
925 I guess the dirty and updated flags are an attempt to fix
926 this, but this approach doesn't really work.
928 Here's an approach that should keep things clean and unconfused:
930 1) Imagine a "virtual face cache" that can grow arbitrarily
931 big and for which the only thing allowed is to add new
932 elements. Existing elements cannot be removed or changed.
933 This way, any pointers in the existing redisplay structure
934 into the cache never get screwed up. (This is important
935 because even if a cache element is out of date, if there's
936 a pointer to it then its contents still accurately describe
937 the way the text currently looks on the screen.)
938 2) Each element in the virtual cache either describes exactly
939 one face, or describes the merger of a number of faces
940 by some process. In order to simplify things, for mergers
941 we do not record which faces or ordering was used, but
942 simply that this cache element is the result of merging.
943 Unlike the current implementation, it's important that a
944 single cache element not be used to both describe a
945 single face and describe a merger, even if all the property
947 3) Each cache element can be clean or dirty. "Dirty" means
948 that the face that the element points to has been changed;
949 this gets set at the time the face is changed. This
950 way, when looking up a value in the cache, you can determine
951 whether it's out of date or not. For merged faces it
952 does not matter -- we don't record the faces or priority
953 used to create the merger, so it's impossible to look up
954 one of these faces. We have to recompute it each time.
955 Luckily, this is fine -- doing the merge is much
956 less expensive than recomputing the properties of a
958 4) For each cache element, we keep a hash value. (In order
959 to hash the boolean properties, we convert each of them
960 into a different large prime number so that the hashing works
961 well.) This allows us, when comparing runes, to properly
962 determine whether the face for that rune has changed.
963 This will be especially important for TTY's, where there
964 aren't that many faces and minimizing redraw is very
966 5) We can't actually keep an infinite cache, but that doesn't
967 really matter that much. The only elements we care about
968 are those that are used by either the current or desired
969 display structs. Therefore, we keep a per-window
970 redisplay iteration number, and mark each element with
971 that number as we use it. Just after outputting the
972 window and synching the redisplay structs, we go through
973 the cache and invalidate all elements that are not clean
974 elements referring to a particular face and that do not
975 have an iteration number equal to the current one. We
976 keep them in a chain, and use them to allocate new
977 elements when possible instead of increasing the Dynarr.
981 /* mark for GC a dynarr of face cachels. */
984 mark_face_cachels (face_cachel_dynarr *elements,
985 void (*markobj) (Lisp_Object))
992 for (elt = 0; elt < Dynarr_length (elements); elt++)
994 struct face_cachel *cachel = Dynarr_atp (elements, elt);
999 for (i = 0; i < NUM_LEADING_BYTES; i++)
1000 if (!NILP (cachel->font[i]) && !UNBOUNDP (cachel->font[i]))
1001 markobj (cachel->font[i]);
1003 markobj (cachel->face);
1004 markobj (cachel->foreground);
1005 markobj (cachel->background);
1006 markobj (cachel->display_table);
1007 markobj (cachel->background_pixmap);
1011 /* ensure that the given cachel contains an updated font value for
1012 the given charset. Return the updated font value. */
1015 ensure_face_cachel_contains_charset (struct face_cachel *cachel,
1016 Lisp_Object domain, Lisp_Object charset)
1018 Lisp_Object new_val;
1019 Lisp_Object face = cachel->face;
1021 int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1023 if (!UNBOUNDP (cachel->font[offs])
1024 && cachel->font_updated[offs])
1025 return cachel->font[offs];
1027 if (UNBOUNDP (face))
1029 /* a merged face. */
1031 struct window *w = XWINDOW (domain);
1034 cachel->font_specified[offs] = 0;
1035 for (i = 0; i < cachel->nfaces; i++)
1037 struct face_cachel *oth;
1039 oth = Dynarr_atp (w->face_cachels,
1040 FACE_CACHEL_FINDEX_UNSAFE (cachel, i));
1041 /* Tout le monde aime la recursion */
1042 ensure_face_cachel_contains_charset (oth, domain, charset);
1044 if (oth->font_specified[offs])
1046 new_val = oth->font[offs];
1047 cachel->font_specified[offs] = 1;
1052 if (!cachel->font_specified[offs])
1053 /* need to do the default face. */
1055 struct face_cachel *oth =
1056 Dynarr_atp (w->face_cachels, DEFAULT_INDEX);
1057 ensure_face_cachel_contains_charset (oth, domain, charset);
1059 new_val = oth->font[offs];
1062 if (!UNBOUNDP (cachel->font[offs]) && !EQ (cachel->font[offs], new_val))
1064 cachel->font_updated[offs] = 1;
1065 cachel->font[offs] = new_val;
1069 new_val = face_property_matching_instance (face, Qfont, charset, domain,
1070 /* #### look into ERROR_ME_NOT */
1071 ERROR_ME_NOT, 1, Qzero);
1072 if (UNBOUNDP (new_val))
1075 new_val = face_property_matching_instance (face, Qfont,
1079 ERROR_ME_NOT, 0, Qzero);
1081 if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs]))
1083 cachel->font_updated[offs] = 1;
1084 cachel->font[offs] = new_val;
1085 cachel->font_specified[offs] = (bound || EQ (face, Vdefault_face));
1089 /* Ensure that the given cachel contains updated fonts for all
1090 the charsets specified. */
1093 ensure_face_cachel_complete (struct face_cachel *cachel,
1094 Lisp_Object domain, unsigned char *charsets)
1098 for (i = 0; i < NUM_LEADING_BYTES; i++)
1101 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE);
1102 assert (CHARSETP (charset));
1103 ensure_face_cachel_contains_charset (cachel, domain, charset);
1108 face_cachel_charset_font_metric_info (struct face_cachel *cachel,
1109 unsigned char *charsets,
1110 struct font_metric_info *fm)
1115 fm->height = fm->ascent = 1;
1117 fm->proportional_p = 0;
1119 for (i = 0; i < NUM_LEADING_BYTES; i++)
1123 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE);
1124 Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset);
1125 struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance);
1127 assert (CHARSETP (charset));
1128 assert (FONT_INSTANCEP (font_instance));
1130 if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent;
1131 if (fm->descent < (int) fi->descent) fm->descent = (int) fi->descent;
1132 fm->height = fm->ascent + fm->descent;
1133 if (fi->proportional_p)
1134 fm->proportional_p = 1;
1135 if (EQ (charset, Vcharset_ascii))
1136 fm->width = fi->width;
1141 /* Called when the updated flag has been cleared on a cachel. */
1144 update_face_cachel_data (struct face_cachel *cachel,
1148 if (XFACE (face)->dirty || UNBOUNDP (cachel->face))
1150 int default_face = EQ (face, Vdefault_face);
1151 cachel->face = face;
1153 /* We normally only set the _specified flags if the value was
1154 actually bound. The exception is for the default face where
1155 we always set it since it is the ultimate fallback. */
1157 #define FROB(field) \
1159 Lisp_Object new_val = \
1160 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
1162 if (UNBOUNDP (new_val)) \
1165 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1167 if (!EQ (new_val, cachel->field)) \
1169 cachel->field = new_val; \
1170 cachel->dirty = 1; \
1172 cachel->field##_specified = (bound || default_face); \
1177 FROB (display_table);
1178 FROB (background_pixmap);
1181 * A face's background pixmap will override the face's
1182 * background color. But the background pixmap of the
1183 * default face should not override the background color of
1184 * a face if the background color has been specified or
1187 * To accomplish this we remove the background pixmap of the
1188 * cachel and mark it as having been specified so that cachel
1189 * merging won't override it later.
1192 && cachel->background_specified
1193 && ! cachel->background_pixmap_specified)
1195 cachel->background_pixmap = Qunbound;
1196 cachel->background_pixmap_specified = 1;
1201 ensure_face_cachel_contains_charset (cachel, domain, Vcharset_ascii);
1203 #define FROB(field) \
1205 Lisp_Object new_val = \
1206 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
1208 unsigned int new_val_int; \
1209 if (UNBOUNDP (new_val)) \
1212 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1214 new_val_int = EQ (new_val, Qt); \
1215 if (cachel->field != new_val_int) \
1217 cachel->field = new_val_int; \
1218 cachel->dirty = 1; \
1220 cachel->field##_specified = bound; \
1232 cachel->updated = 1;
1235 /* Merge the cachel identified by FINDEX in window W into the given
1239 merge_face_cachel_data (struct window *w, face_index findex,
1240 struct face_cachel *cachel)
1242 #define FINDEX_FIELD(field) \
1243 Dynarr_atp (w->face_cachels, findex)->field
1245 #define FROB(field) \
1247 if (!cachel->field##_specified && FINDEX_FIELD (field##_specified)) \
1249 cachel->field = FINDEX_FIELD (field); \
1250 cachel->field##_specified = 1; \
1251 cachel->dirty = 1; \
1257 FROB (display_table);
1258 FROB (background_pixmap);
1265 /* And do ASCII, of course. */
1267 int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE;
1269 if (!cachel->font_specified[offs] && FINDEX_FIELD (font_specified[offs]))
1271 cachel->font[offs] = FINDEX_FIELD (font[offs]);
1272 cachel->font_specified[offs] = 1;
1280 cachel->updated = 1;
1283 /* Initialize a cachel. */
1286 reset_face_cachel (struct face_cachel *cachel)
1289 cachel->face = Qunbound;
1291 cachel->merged_faces = 0;
1292 cachel->foreground = Qunbound;
1293 cachel->background = Qunbound;
1297 for (i = 0; i < NUM_LEADING_BYTES; i++)
1298 cachel->font[i] = Qunbound;
1300 cachel->display_table = Qunbound;
1301 cachel->background_pixmap = Qunbound;
1304 /* Add a cachel for the given face to the given window's cache. */
1307 add_face_cachel (struct window *w, Lisp_Object face)
1309 struct face_cachel new_cachel;
1312 reset_face_cachel (&new_cachel);
1313 XSETWINDOW (window, w);
1314 update_face_cachel_data (&new_cachel, window, face);
1315 Dynarr_add (w->face_cachels, new_cachel);
1318 /* Retrieve the index to a cachel for window W that corresponds to
1319 the specified face. If necessary, add a new element to the
1323 get_builtin_face_cache_index (struct window *w, Lisp_Object face)
1330 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1332 struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt);
1334 if (EQ (cachel->face, face))
1337 XSETWINDOW (window, w);
1338 if (!cachel->updated)
1339 update_face_cachel_data (cachel, window, face);
1344 /* If we didn't find the face, add it and then return its index. */
1345 add_face_cachel (w, face);
1350 reset_face_cachels (struct window *w)
1352 /* #### Not initialized in batch mode for the stream device. */
1353 if (w->face_cachels)
1357 for (i = 0; i < Dynarr_length (w->face_cachels); i++)
1359 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, i);
1360 if (cachel->merged_faces)
1361 Dynarr_free (cachel->merged_faces);
1363 Dynarr_reset (w->face_cachels);
1364 get_builtin_face_cache_index (w, Vdefault_face);
1365 get_builtin_face_cache_index (w, Vmodeline_face);
1366 XFRAME (w->frame)->window_face_cache_reset = 1;
1371 mark_face_cachels_as_clean (struct window *w)
1375 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1376 Dynarr_atp (w->face_cachels, elt)->dirty = 0;
1380 mark_face_cachels_as_not_updated (struct window *w)
1384 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1386 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt);
1389 cachel->updated = 0;
1390 for (i = 0; i < NUM_LEADING_BYTES; i++)
1391 cachel->font_updated[i] = 0;
1395 #ifdef MEMORY_USAGE_STATS
1398 compute_face_cachel_usage (face_cachel_dynarr *face_cachels,
1399 struct overhead_stats *ovstats)
1407 total += Dynarr_memory_usage (face_cachels, ovstats);
1408 for (i = 0; i < Dynarr_length (face_cachels); i++)
1410 int_dynarr *merged = Dynarr_at (face_cachels, i).merged_faces;
1412 total += Dynarr_memory_usage (merged, ovstats);
1419 #endif /* MEMORY_USAGE_STATS */
1422 /*****************************************************************************
1423 * merged face functions *
1424 *****************************************************************************/
1426 /* Compare two merged face cachels to determine whether we have to add
1427 a new entry to the face cache.
1429 Note that we do not compare the attributes, but just the faces the
1430 cachels are based on. If they are the same, then the cachels certainly
1431 ought to have the same attributes, except in the case where fonts
1432 for different charsets have been determined in the two -- and in that
1433 case this difference is fine. */
1436 compare_merged_face_cachels (struct face_cachel *cachel1,
1437 struct face_cachel *cachel2)
1441 if (!EQ (cachel1->face, cachel2->face)
1442 || cachel1->nfaces != cachel2->nfaces)
1445 for (i = 0; i < cachel1->nfaces; i++)
1446 if (FACE_CACHEL_FINDEX_UNSAFE (cachel1, i)
1447 != FACE_CACHEL_FINDEX_UNSAFE (cachel2, i))
1453 /* Retrieve the index to a cachel for window W that corresponds to
1454 the specified cachel. If necessary, add a new element to the
1455 cache. This is similar to get_builtin_face_cache_index() but
1456 is intended for merged cachels rather than for cachels representing
1459 Note that a merged cachel for just one face is not the same as
1460 the simple cachel for that face, because it is also merged with
1461 the default face. */
1464 get_merged_face_cache_index (struct window *w,
1465 struct face_cachel *merged_cachel)
1468 int cache_size = Dynarr_length (w->face_cachels);
1470 for (elt = 0; elt < cache_size; elt++)
1472 struct face_cachel *cachel =
1473 Dynarr_atp (w->face_cachels, elt);
1475 if (compare_merged_face_cachels (cachel, merged_cachel))
1479 /* We didn't find it so add this instance to the cache. */
1480 merged_cachel->updated = 1;
1481 merged_cachel->dirty = 1;
1482 Dynarr_add (w->face_cachels, *merged_cachel);
1487 get_extent_fragment_face_cache_index (struct window *w,
1488 struct extent_fragment *ef)
1490 struct face_cachel cachel;
1491 int len = Dynarr_length (ef->extents);
1492 face_index findex = 0;
1494 XSETWINDOW (window, w);
1496 /* Optimize the default case. */
1498 return DEFAULT_INDEX;
1503 /* Merge the faces of the extents together in order. */
1505 reset_face_cachel (&cachel);
1507 for (i = len - 1; i >= 0; i--)
1509 EXTENT current = Dynarr_at (ef->extents, i);
1511 Lisp_Object face = extent_face (current);
1515 findex = get_builtin_face_cache_index (w, face);
1517 merge_face_cachel_data (w, findex, &cachel);
1519 /* remember, we're called from within redisplay
1520 so we can't error. */
1521 else while (CONSP (face))
1523 Lisp_Object one_face = XCAR (face);
1524 if (FACEP (one_face))
1526 findex = get_builtin_face_cache_index (w, one_face);
1527 merge_face_cachel_data (w, findex, &cachel);
1529 /* code duplication here but there's no clean
1531 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES)
1533 if (!cachel.merged_faces)
1534 cachel.merged_faces = Dynarr_new (int);
1535 Dynarr_add (cachel.merged_faces, findex);
1538 cachel.merged_faces_static[cachel.nfaces] = findex;
1546 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES)
1548 if (!cachel.merged_faces)
1549 cachel.merged_faces = Dynarr_new (int);
1550 Dynarr_add (cachel.merged_faces, findex);
1553 cachel.merged_faces_static[cachel.nfaces] = findex;
1558 /* Now finally merge in the default face. */
1559 findex = get_builtin_face_cache_index (w, Vdefault_face);
1560 merge_face_cachel_data (w, findex, &cachel);
1562 return get_merged_face_cache_index (w, &cachel);
1567 /*****************************************************************************
1569 ****************************************************************************/
1572 update_EmacsFrame (Lisp_Object frame, Lisp_Object name)
1574 struct frame *frm = XFRAME (frame);
1576 if (EQ (name, Qfont))
1577 MARK_FRAME_SIZE_SLIPPED (frm);
1579 MAYBE_FRAMEMETH (frm, update_frame_external_traits, (frm, name));
1583 update_EmacsFrames (Lisp_Object locale, Lisp_Object name)
1585 if (FRAMEP (locale))
1587 update_EmacsFrame (locale, name);
1589 else if (DEVICEP (locale))
1591 Lisp_Object frmcons;
1593 DEVICE_FRAME_LOOP (frmcons, XDEVICE (locale))
1594 update_EmacsFrame (XCAR (frmcons), name);
1596 else if (EQ (locale, Qglobal) || EQ (locale, Qfallback))
1598 Lisp_Object frmcons, devcons, concons;
1600 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
1601 update_EmacsFrame (XCAR (frmcons), name);
1606 update_frame_face_values (struct frame *f)
1611 update_EmacsFrame (frm, Qforeground);
1612 update_EmacsFrame (frm, Qbackground);
1613 update_EmacsFrame (frm, Qfont);
1617 face_property_was_changed (Lisp_Object face, Lisp_Object property,
1620 int default_face = EQ (face, Vdefault_face);
1622 /* If the locale could affect the frame value, then call
1623 update_EmacsFrames just in case. */
1625 (EQ (property, Qforeground) ||
1626 EQ (property, Qbackground) ||
1627 EQ (property, Qfont)))
1628 update_EmacsFrames (locale, property);
1630 if (WINDOWP (locale))
1632 MARK_FRAME_FACES_CHANGED (XFRAME (XWINDOW (locale)->frame));
1634 else if (FRAMEP (locale))
1636 MARK_FRAME_FACES_CHANGED (XFRAME (locale));
1638 else if (DEVICEP (locale))
1640 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (locale));
1644 Lisp_Object devcons, concons;
1645 DEVICE_LOOP_NO_BREAK (devcons, concons)
1646 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (XCAR (devcons)));
1650 * This call to update_faces_inheritance isn't needed and makes
1651 * creating and modifying faces _very_ slow. The point of
1652 * update_face_inheritances is to find all faces that inherit
1653 * directly from this face property and set the specifier "dirty"
1654 * flag on the corresponding specifier. This forces recaching of
1655 * cached specifier values in frame and window struct slots. But
1656 * currently no face properties are cached in frame and window
1657 * struct slots, so calling this function does nothing useful!
1659 * Further, since update_faces_inheritance maps over the whole
1660 * face table every time it is called, it gets terribly slow when
1661 * there are many faces. Creating 500 faces on a 50Mhz 486 took
1662 * 433 seconds when update_faces_inheritance was called. With the
1663 * call commented out, creating those same 500 faces took 0.72
1666 /* update_faces_inheritance (face, property);*/
1667 XFACE (face)->dirty = 1;
1670 DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /*
1671 Define and return a new face which is a copy of an existing one,
1672 or makes an already-existing face be exactly like another.
1673 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'.
1675 (old_face, new_name, locale, tag_set, exact_p, how_to_add))
1677 struct Lisp_Face *fold, *fnew;
1678 Lisp_Object new_face = Qnil;
1679 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1681 old_face = Fget_face (old_face);
1683 /* We GCPRO old_face because it might be temporary, and GCing could
1684 occur in various places below. */
1685 GCPRO4 (tag_set, locale, old_face, new_face);
1686 /* check validity of how_to_add now. */
1687 decode_how_to_add_specification (how_to_add);
1688 /* and of tag_set. */
1689 tag_set = decode_specifier_tag_set (tag_set);
1690 /* and of locale. */
1691 locale = decode_locale_list (locale);
1693 new_face = Ffind_face (new_name);
1694 if (NILP (new_face))
1698 CHECK_SYMBOL (new_name);
1700 /* Create the new face with the same status as the old face. */
1701 temp = (NILP (Fgethash (old_face, Vtemporary_faces_cache, Qnil))
1705 new_face = Fmake_face (new_name, Qnil, temp);
1708 fold = XFACE (old_face);
1709 fnew = XFACE (new_face);
1711 #define COPY_PROPERTY(property) \
1712 Fcopy_specifier (fold->property, fnew->property, \
1713 locale, tag_set, exact_p, how_to_add);
1715 COPY_PROPERTY (foreground);
1716 COPY_PROPERTY (background);
1717 COPY_PROPERTY (font);
1718 COPY_PROPERTY (display_table);
1719 COPY_PROPERTY (background_pixmap);
1720 COPY_PROPERTY (underline);
1721 COPY_PROPERTY (strikethru);
1722 COPY_PROPERTY (highlight);
1723 COPY_PROPERTY (dim);
1724 COPY_PROPERTY (blinking);
1725 COPY_PROPERTY (reverse);
1726 #undef COPY_PROPERTY
1727 /* #### should it copy the individual specifiers, if they exist? */
1728 fnew->plist = Fcopy_sequence (fold->plist);
1737 syms_of_faces (void)
1739 /* Qdefault & Qwidget defined in general.c */
1740 defsymbol (&Qmodeline, "modeline");
1741 defsymbol (&Qgui_element, "gui-element");
1742 defsymbol (&Qleft_margin, "left-margin");
1743 defsymbol (&Qright_margin, "right-margin");
1744 defsymbol (&Qtext_cursor, "text-cursor");
1745 defsymbol (&Qvertical_divider, "vertical-divider");
1748 DEFSUBR (Ffind_face);
1749 DEFSUBR (Fget_face);
1750 DEFSUBR (Fface_name);
1751 DEFSUBR (Fbuilt_in_face_specifiers);
1752 DEFSUBR (Fface_list);
1753 DEFSUBR (Fmake_face);
1754 DEFSUBR (Fcopy_face);
1756 defsymbol (&Qfacep, "facep");
1757 defsymbol (&Qforeground, "foreground");
1758 defsymbol (&Qbackground, "background");
1759 /* Qfont defined in general.c */
1760 defsymbol (&Qdisplay_table, "display-table");
1761 defsymbol (&Qbackground_pixmap, "background-pixmap");
1762 defsymbol (&Qunderline, "underline");
1763 defsymbol (&Qstrikethru, "strikethru");
1764 /* Qhighlight, Qreverse defined in general.c */
1765 defsymbol (&Qdim, "dim");
1766 defsymbol (&Qblinking, "blinking");
1768 defsymbol (&Qinit_face_from_resources, "init-face-from-resources");
1769 defsymbol (&Qinit_global_faces, "init-global-faces");
1770 defsymbol (&Qinit_device_faces, "init-device-faces");
1771 defsymbol (&Qinit_frame_faces, "init-frame-faces");
1775 structure_type_create_faces (void)
1777 struct structure_type *st;
1779 st = define_structure_type (Qface, face_validate, face_instantiate);
1781 define_structure_type_keyword (st, Qname, face_name_validate);
1785 vars_of_faces (void)
1787 staticpro (&Vpermanent_faces_cache);
1788 Vpermanent_faces_cache = Qnil;
1789 staticpro (&Vtemporary_faces_cache);
1790 Vtemporary_faces_cache = Qnil;
1792 staticpro (&Vdefault_face);
1793 Vdefault_face = Qnil;
1794 staticpro (&Vgui_element_face);
1795 Vgui_element_face = Qnil;
1796 staticpro (&Vwidget_face);
1797 Vwidget_face = Qnil;
1798 staticpro (&Vmodeline_face);
1799 Vmodeline_face = Qnil;
1800 staticpro (&Vtoolbar_face);
1801 Vtoolbar_face = Qnil;
1803 staticpro (&Vvertical_divider_face);
1804 Vvertical_divider_face = Qnil;
1805 staticpro (&Vleft_margin_face);
1806 Vleft_margin_face = Qnil;
1807 staticpro (&Vright_margin_face);
1808 Vright_margin_face = Qnil;
1809 staticpro (&Vtext_cursor_face);
1810 Vtext_cursor_face = Qnil;
1811 staticpro (&Vpointer_face);
1812 Vpointer_face = Qnil;
1815 Lisp_Object syms[20];
1818 syms[n++] = Qforeground;
1819 syms[n++] = Qbackground;
1821 syms[n++] = Qdisplay_table;
1822 syms[n++] = Qbackground_pixmap;
1823 syms[n++] = Qunderline;
1824 syms[n++] = Qstrikethru;
1825 syms[n++] = Qhighlight;
1827 syms[n++] = Qblinking;
1828 syms[n++] = Qreverse;
1830 Vbuilt_in_face_specifiers = Flist (n, syms);
1831 staticpro (&Vbuilt_in_face_specifiers);
1836 complex_vars_of_faces (void)
1838 Vpermanent_faces_cache =
1839 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
1840 Vtemporary_faces_cache =
1841 make_lisp_hash_table (0, HASH_TABLE_WEAK, HASH_TABLE_EQ);
1843 /* Create the default face now so we know what it is immediately. */
1845 Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus
1847 Vdefault_face = Fmake_face (Qdefault, build_string ("default face"),
1850 /* Provide some last-resort fallbacks to avoid utter fuckage if
1851 someone provides invalid values for the global specifications. */
1854 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1856 #ifdef HAVE_X_WINDOWS
1857 fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
1858 bg_fb = acons (list1 (Qx), build_string ("white"), bg_fb);
1861 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1862 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1864 #ifdef HAVE_MS_WINDOWS
1865 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1866 bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb);
1868 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb);
1869 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb);
1872 /* #### We may want to have different fallback values if NeXTstep
1873 support is compiled in. */
1875 Lisp_Object inst_list = Qnil;
1876 #ifdef HAVE_X_WINDOWS
1877 /* The same gory list from x-faces.el.
1878 (#### Perhaps we should remove the stuff from x-faces.el
1879 and only depend on this stuff here? That should work.)
1881 CONST char *fonts[] =
1883 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
1884 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
1885 "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*",
1886 "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*",
1887 "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*",
1888 "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*",
1889 "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*",
1890 "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*",
1891 "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*",
1892 "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*",
1893 "-*-*-*-r-*-*-*-120-*-*-m-*-*-*",
1894 "-*-*-*-r-*-*-*-120-*-*-c-*-*-*",
1895 "-*-*-*-r-*-*-*-120-*-*-*-*-*-*",
1896 "-*-*-*-*-*-*-*-120-*-*-*-*-*-*",
1899 CONST char **fontptr;
1901 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--)
1902 inst_list = Fcons (Fcons (list1 (Qx), build_string (*fontptr)),
1904 #endif /* HAVE_X_WINDOWS */
1907 inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")),
1909 #endif /* HAVE_TTY */
1910 #ifdef HAVE_MS_WINDOWS
1911 inst_list = Fcons (Fcons (list1 (Qmswindows),
1912 build_string ("Fixedsys:Regular:9::Western")), inst_list);
1913 inst_list = Fcons (Fcons (list1 (Qmswindows),
1914 build_string ("Courier:Regular:10::Western")), inst_list);
1915 inst_list = Fcons (Fcons (list1 (Qmswindows),
1916 build_string ("Courier New:Regular:10::Western")), inst_list);
1917 #endif /* HAVE_MS_WINDOWS */
1918 set_specifier_fallback (Fget (Vdefault_face, Qfont, Qnil), inst_list);
1921 set_specifier_fallback (Fget (Vdefault_face, Qunderline, Qnil),
1922 list1 (Fcons (Qnil, Qnil)));
1923 set_specifier_fallback (Fget (Vdefault_face, Qstrikethru, Qnil),
1924 list1 (Fcons (Qnil, Qnil)));
1925 set_specifier_fallback (Fget (Vdefault_face, Qhighlight, Qnil),
1926 list1 (Fcons (Qnil, Qnil)));
1927 set_specifier_fallback (Fget (Vdefault_face, Qdim, Qnil),
1928 list1 (Fcons (Qnil, Qnil)));
1929 set_specifier_fallback (Fget (Vdefault_face, Qblinking, Qnil),
1930 list1 (Fcons (Qnil, Qnil)));
1931 set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil),
1932 list1 (Fcons (Qnil, Qnil)));
1934 /* gui-element is the parent face of all gui elements such as
1935 modeline, vertical divider and toolbar. */
1936 Vgui_element_face = Fmake_face (Qgui_element,
1937 build_string ("gui element face"),
1940 /* Provide some last-resort fallbacks for gui-element face which
1941 mustn't default to default. */
1943 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1945 #ifdef HAVE_X_WINDOWS
1946 fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
1947 bg_fb = acons (list1 (Qx), build_string ("Gray80"), bg_fb);
1950 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1951 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1953 #ifdef HAVE_MS_WINDOWS
1954 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1955 bg_fb = acons (list1 (Qmswindows), build_string ("Gray75"), bg_fb);
1957 set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb);
1958 set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb);
1961 /* Now create the other faces that redisplay needs to refer to
1962 directly. We could create them in Lisp but it's simpler this
1963 way since we need to get them anyway. */
1965 /* modeline is gui element. */
1966 Vmodeline_face = Fmake_face (Qmodeline, build_string ("modeline face"),
1969 set_specifier_fallback (Fget (Vmodeline_face, Qforeground, Qunbound),
1970 Fget (Vgui_element_face, Qforeground, Qunbound));
1971 set_specifier_fallback (Fget (Vmodeline_face, Qbackground, Qunbound),
1972 Fget (Vgui_element_face, Qbackground, Qunbound));
1973 set_specifier_fallback (Fget (Vmodeline_face, Qbackground_pixmap, Qnil),
1974 Fget (Vgui_element_face, Qbackground_pixmap,
1977 /* toolbar is another gui element */
1978 Vtoolbar_face = Fmake_face (Qtoolbar,
1979 build_string ("toolbar face"),
1981 set_specifier_fallback (Fget (Vtoolbar_face, Qforeground, Qunbound),
1982 Fget (Vgui_element_face, Qforeground, Qunbound));
1983 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground, Qunbound),
1984 Fget (Vgui_element_face, Qbackground, Qunbound));
1985 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_pixmap, Qnil),
1986 Fget (Vgui_element_face, Qbackground_pixmap,
1989 /* vertical divider is another gui element */
1990 Vvertical_divider_face = Fmake_face (Qvertical_divider,
1991 build_string ("vertical divider face"),
1994 set_specifier_fallback (Fget (Vvertical_divider_face, Qforeground, Qunbound),
1995 Fget (Vgui_element_face, Qforeground, Qunbound));
1996 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground, Qunbound),
1997 Fget (Vgui_element_face, Qbackground, Qunbound));
1998 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground_pixmap,
2000 Fget (Vgui_element_face, Qbackground_pixmap,
2003 /* widget is another gui element */
2004 Vwidget_face = Fmake_face (Qwidget,
2005 build_string ("widget face"),
2007 set_specifier_fallback (Fget (Vwidget_face, Qforeground, Qunbound),
2008 Fget (Vgui_element_face, Qforeground, Qunbound));
2009 set_specifier_fallback (Fget (Vwidget_face, Qbackground, Qunbound),
2010 Fget (Vgui_element_face, Qbackground, Qunbound));
2011 set_specifier_fallback (Fget (Vwidget_face, Qbackground_pixmap, Qnil),
2012 Fget (Vgui_element_face, Qbackground_pixmap,
2015 Vleft_margin_face = Fmake_face (Qleft_margin,
2016 build_string ("left margin face"),
2018 Vright_margin_face = Fmake_face (Qright_margin,
2019 build_string ("right margin face"),
2021 Vtext_cursor_face = Fmake_face (Qtext_cursor,
2022 build_string ("face for text cursor"),
2025 Fmake_face (Qpointer,
2027 ("face for foreground/background colors of mouse pointer"),