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)
78 struct Lisp_Face *face = XFACE (obj);
80 mark_object (face->name);
81 mark_object (face->doc_string);
83 mark_object (face->foreground);
84 mark_object (face->background);
85 mark_object (face->font);
86 mark_object (face->display_table);
87 mark_object (face->background_pixmap);
88 mark_object (face->underline);
89 mark_object (face->strikethru);
90 mark_object (face->highlight);
91 mark_object (face->dim);
92 mark_object (face->blinking);
93 mark_object (face->reverse);
95 mark_object (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 static const struct lrecord_description face_description[] = {
268 { XD_LISP_OBJECT, offsetof(struct Lisp_Face, name), 2 },
269 { XD_LISP_OBJECT, offsetof(struct Lisp_Face, foreground), 13 },
273 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face,
274 mark_face, print_face, 0, face_equal,
275 face_hash, face_description, face_getprop,
276 face_putprop, face_remprop,
277 face_plist, struct Lisp_Face);
279 /************************************************************************/
280 /* face read syntax */
281 /************************************************************************/
284 face_name_validate (Lisp_Object keyword, Lisp_Object value,
287 if (ERRB_EQ (errb, ERROR_ME))
289 CHECK_SYMBOL (value);
293 return SYMBOLP (value);
297 face_validate (Lisp_Object data, Error_behavior errb)
300 Lisp_Object valw = Qnil;
302 data = Fcdr (data); /* skip over Qface */
305 Lisp_Object keyw = Fcar (data);
310 if (EQ (keyw, Qname))
318 maybe_error (Qface, errb, "No face name given");
322 if (NILP (Ffind_face (valw)))
324 maybe_signal_simple_error ("No such face", valw, Qface, errb);
332 face_instantiate (Lisp_Object data)
334 return Fget_face (Fcar (Fcdr (data)));
338 /****************************************************************************
339 * utility functions *
340 ****************************************************************************/
343 reset_face (struct Lisp_Face *f)
346 f->doc_string = Qnil;
348 f->foreground = Qnil;
349 f->background = Qnil;
351 f->display_table = Qnil;
352 f->background_pixmap = Qnil;
354 f->strikethru = Qnil;
360 f->charsets_warned_about = Qnil;
363 static struct Lisp_Face *
366 struct Lisp_Face *result =
367 alloc_lcrecord_type (struct Lisp_Face, &lrecord_face);
374 /* We store the faces in hash tables with the names as the key and the
375 actual face object as the value. Occasionally we need to use them
376 in a list format. These routines provide us with that. */
377 struct face_list_closure
379 Lisp_Object *face_list;
383 add_face_to_list_mapper (Lisp_Object key, Lisp_Object value,
384 void *face_list_closure)
386 /* This function can GC */
387 struct face_list_closure *fcl =
388 (struct face_list_closure *) face_list_closure;
390 *(fcl->face_list) = Fcons (XFACE (value)->name, (*fcl->face_list));
395 faces_list_internal (Lisp_Object list)
397 Lisp_Object face_list = Qnil;
399 struct face_list_closure face_list_closure;
402 face_list_closure.face_list = &face_list;
403 elisp_maphash (add_face_to_list_mapper, list, &face_list_closure);
410 permanent_faces_list (void)
412 return faces_list_internal (Vpermanent_faces_cache);
416 temporary_faces_list (void)
418 return faces_list_internal (Vtemporary_faces_cache);
423 mark_face_as_clean_mapper (Lisp_Object key, Lisp_Object value,
426 /* This function can GC */
427 int *flag = (int *) flag_closure;
428 XFACE (value)->dirty = *flag;
433 mark_all_faces_internal (int flag)
435 elisp_maphash (mark_face_as_clean_mapper, Vpermanent_faces_cache, &flag);
436 elisp_maphash (mark_face_as_clean_mapper, Vtemporary_faces_cache, &flag);
440 mark_all_faces_as_clean (void)
442 mark_all_faces_internal (0);
445 /* Currently unused (see the comment in face_property_was_changed()). */
447 /* #### OBSOLETE ME, PLEASE. Maybe. Maybe this is just as good as
448 any other solution. */
449 struct face_inheritance_closure
452 Lisp_Object property;
456 update_inheritance_mapper_internal (Lisp_Object cur_face,
457 Lisp_Object inh_face,
458 Lisp_Object property)
460 /* #### fix this function */
461 Lisp_Object elt = Qnil;
466 for (elt = FACE_PROPERTY_SPEC_LIST (cur_face, property, Qall);
470 Lisp_Object values = XCDR (XCAR (elt));
472 for (; !NILP (values); values = XCDR (values))
474 Lisp_Object value = XCDR (XCAR (values));
475 if (VECTORP (value) && XVECTOR_LENGTH (value))
477 if (EQ (Ffind_face (XVECTOR_DATA (value)[0]), inh_face))
478 Fset_specifier_dirty_flag
479 (FACE_PROPERTY_SPECIFIER (inh_face, property));
488 update_face_inheritance_mapper (CONST void *hash_key, void *hash_contents,
489 void *face_inheritance_closure)
491 Lisp_Object key, contents;
492 struct face_inheritance_closure *fcl =
493 (struct face_inheritance_closure *) face_inheritance_closure;
495 CVOID_TO_LISP (key, hash_key);
496 VOID_TO_LISP (contents, hash_contents);
498 if (EQ (fcl->property, Qfont))
500 update_inheritance_mapper_internal (contents, fcl->face, Qfont);
502 else if (EQ (fcl->property, Qforeground) ||
503 EQ (fcl->property, Qbackground))
505 update_inheritance_mapper_internal (contents, fcl->face, Qforeground);
506 update_inheritance_mapper_internal (contents, fcl->face, Qbackground);
508 else if (EQ (fcl->property, Qunderline) ||
509 EQ (fcl->property, Qstrikethru) ||
510 EQ (fcl->property, Qhighlight) ||
511 EQ (fcl->property, Qdim) ||
512 EQ (fcl->property, Qblinking) ||
513 EQ (fcl->property, Qreverse))
515 update_inheritance_mapper_internal (contents, fcl->face, Qunderline);
516 update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru);
517 update_inheritance_mapper_internal (contents, fcl->face, Qhighlight);
518 update_inheritance_mapper_internal (contents, fcl->face, Qdim);
519 update_inheritance_mapper_internal (contents, fcl->face, Qblinking);
520 update_inheritance_mapper_internal (contents, fcl->face, Qreverse);
526 update_faces_inheritance (Lisp_Object face, Lisp_Object property)
528 struct face_inheritance_closure face_inheritance_closure;
529 struct gcpro gcpro1, gcpro2;
531 GCPRO2 (face, property);
532 face_inheritance_closure.face = face;
533 face_inheritance_closure.property = property;
535 elisp_maphash (update_face_inheritance_mapper, Vpermanent_faces_cache,
536 &face_inheritance_closure);
537 elisp_maphash (update_face_inheritance_mapper, Vtemporary_faces_cache,
538 &face_inheritance_closure);
545 face_property_matching_instance (Lisp_Object face, Lisp_Object property,
546 Lisp_Object charset, Lisp_Object domain,
547 Error_behavior errb, int no_fallback,
551 specifier_instance_no_quit (Fget (face, property, Qnil), charset,
552 domain, errb, no_fallback, depth);
554 if (UNBOUNDP (retval) && !no_fallback)
556 if (EQ (property, Qfont))
558 if (NILP (memq_no_quit (charset,
559 XFACE (face)->charsets_warned_about)))
562 if (! UNBOUNDP (charset))
565 "Unable to instantiate font for face %s, charset %s",
566 string_data (symbol_name
567 (XSYMBOL (XFACE (face)->name))),
568 string_data (symbol_name
569 (XSYMBOL (XCHARSET_NAME (charset)))));
572 warn_when_safe (Qfont, Qwarning,
573 "Unable to instantiate font for face %s",
574 string_data (symbol_name
575 (XSYMBOL (XFACE (face)->name))));
576 XFACE (face)->charsets_warned_about =
577 Fcons (charset, XFACE (face)->charsets_warned_about);
579 retval = Vthe_null_font_instance;
587 DEFUN ("facep", Ffacep, 1, 1, 0, /*
588 Return non-nil if OBJECT is a face.
592 return FACEP (object) ? Qt : Qnil;
595 DEFUN ("find-face", Ffind_face, 1, 1, 0, /*
596 Retrieve the face of the given name.
597 If FACE-OR-NAME is a face object, it is simply returned.
598 Otherwise, FACE-OR-NAME should be a symbol. If there is no such face,
599 nil is returned. Otherwise the associated face object is returned.
605 if (FACEP (face_or_name))
607 CHECK_SYMBOL (face_or_name);
609 /* Check if the name represents a permanent face. */
610 retval = Fgethash (face_or_name, Vpermanent_faces_cache, Qnil);
614 /* Check if the name represents a temporary face. */
615 return Fgethash (face_or_name, Vtemporary_faces_cache, Qnil);
618 DEFUN ("get-face", Fget_face, 1, 1, 0, /*
619 Retrieve the face of the given name.
620 Same as `find-face' except an error is signalled if there is no such
621 face instead of returning nil.
625 Lisp_Object face = Ffind_face (name);
628 signal_simple_error ("No such face", name);
632 DEFUN ("face-name", Fface_name, 1, 1, 0, /*
633 Return the name of the given face.
637 return XFACE (Fget_face (face))->name;
640 DEFUN ("built-in-face-specifiers", Fbuilt_in_face_specifiers, 0, 0, 0, /*
641 Return a list of all built-in face specifier properties.
642 Don't modify this list!
646 return Vbuilt_in_face_specifiers;
649 /* These values are retrieved so often that we make a special
654 default_face_font_info (Lisp_Object domain, int *ascent, int *descent,
655 int *height, int *width, int *proportional_p)
657 Lisp_Object font_instance;
674 /* We use ASCII here. This is probably reasonable because the
675 people calling this function are using the resulting values to
676 come up with overall sizes for windows and frames. */
677 if (WINDOWP (domain))
679 struct face_cachel *cachel;
680 struct window *w = XWINDOW (domain);
682 /* #### It's possible for this function to get called when the
683 face cachels have not been initialized. I don't know why. */
684 if (!Dynarr_length (w->face_cachels))
685 reset_face_cachels (w);
686 cachel = WINDOW_FACE_CACHEL (w, DEFAULT_INDEX);
687 font_instance = FACE_CACHEL_FONT (cachel, Vcharset_ascii);
691 font_instance = FACE_FONT (Vdefault_face, domain, Vcharset_ascii);
695 *height = XFONT_INSTANCE (font_instance)->height;
697 *width = XFONT_INSTANCE (font_instance)->width;
699 *ascent = XFONT_INSTANCE (font_instance)->ascent;
701 *descent = XFONT_INSTANCE (font_instance)->descent;
703 *proportional_p = XFONT_INSTANCE (font_instance)->proportional_p;
707 default_face_height_and_width (Lisp_Object domain,
708 int *height, int *width)
710 default_face_font_info (domain, 0, 0, height, width, 0);
714 default_face_height_and_width_1 (Lisp_Object domain,
715 int *height, int *width)
717 if (window_system_pixelated_geometry (domain))
725 default_face_height_and_width (domain, height, width);
728 DEFUN ("face-list", Fface_list, 0, 1, 0, /*
729 Return a list of the names of all defined faces.
730 If TEMPORARY is nil, only the permanent faces are included.
731 If it is t, only the temporary faces are included. If it is any
732 other non-nil value both permanent and temporary are included.
736 Lisp_Object face_list = Qnil;
738 /* Added the permanent faces, if requested. */
739 if (NILP (temporary) || !EQ (Qt, temporary))
740 face_list = permanent_faces_list ();
742 if (!NILP (temporary))
746 face_list = nconc2 (face_list, temporary_faces_list ());
753 DEFUN ("make-face", Fmake_face, 1, 3, 0, /*
754 Define and return a new FACE described by DOC-STRING.
755 You can modify the font, color, etc of a face with the set-face-* functions.
756 If the face already exists, it is unmodified.
757 If TEMPORARY is non-nil, this face will cease to exist if not in use.
759 (name, doc_string, temporary))
761 /* This function can GC if initialized is non-zero */
766 if (!NILP (doc_string))
767 CHECK_STRING (doc_string);
769 face = Ffind_face (name);
773 f = allocate_face ();
777 f->doc_string = doc_string;
778 f->foreground = Fmake_specifier (Qcolor);
779 set_color_attached_to (f->foreground, face, Qforeground);
780 f->background = Fmake_specifier (Qcolor);
781 set_color_attached_to (f->background, face, Qbackground);
782 f->font = Fmake_specifier (Qfont);
783 set_font_attached_to (f->font, face, Qfont);
784 f->background_pixmap = Fmake_specifier (Qimage);
785 set_image_attached_to (f->background_pixmap, face, Qbackground_pixmap);
786 f->display_table = Fmake_specifier (Qdisplay_table);
787 f->underline = Fmake_specifier (Qface_boolean);
788 set_face_boolean_attached_to (f->underline, face, Qunderline);
789 f->strikethru = Fmake_specifier (Qface_boolean);
790 set_face_boolean_attached_to (f->strikethru, face, Qstrikethru);
791 f->highlight = Fmake_specifier (Qface_boolean);
792 set_face_boolean_attached_to (f->highlight, face, Qhighlight);
793 f->dim = Fmake_specifier (Qface_boolean);
794 set_face_boolean_attached_to (f->dim, face, Qdim);
795 f->blinking = Fmake_specifier (Qface_boolean);
796 set_face_boolean_attached_to (f->blinking, face, Qblinking);
797 f->reverse = Fmake_specifier (Qface_boolean);
798 set_face_boolean_attached_to (f->reverse, face, Qreverse);
799 if (!NILP (Vdefault_face))
801 /* If the default face has already been created, set it as
802 the default fallback specifier for all the specifiers we
803 just created. This implements the standard "all faces
804 inherit from default" behavior. */
805 set_specifier_fallback (f->foreground,
806 Fget (Vdefault_face, Qforeground, Qunbound));
807 set_specifier_fallback (f->background,
808 Fget (Vdefault_face, Qbackground, Qunbound));
809 set_specifier_fallback (f->font,
810 Fget (Vdefault_face, Qfont, Qunbound));
811 set_specifier_fallback (f->background_pixmap,
812 Fget (Vdefault_face, Qbackground_pixmap,
814 set_specifier_fallback (f->display_table,
815 Fget (Vdefault_face, Qdisplay_table, Qunbound));
816 set_specifier_fallback (f->underline,
817 Fget (Vdefault_face, Qunderline, Qunbound));
818 set_specifier_fallback (f->strikethru,
819 Fget (Vdefault_face, Qstrikethru, Qunbound));
820 set_specifier_fallback (f->highlight,
821 Fget (Vdefault_face, Qhighlight, Qunbound));
822 set_specifier_fallback (f->dim,
823 Fget (Vdefault_face, Qdim, Qunbound));
824 set_specifier_fallback (f->blinking,
825 Fget (Vdefault_face, Qblinking, Qunbound));
826 set_specifier_fallback (f->reverse,
827 Fget (Vdefault_face, Qreverse, Qunbound));
830 /* Add the face to the appropriate list. */
831 if (NILP (temporary))
832 Fputhash (name, face, Vpermanent_faces_cache);
834 Fputhash (name, face, Vtemporary_faces_cache);
836 /* Note that it's OK if we dump faces.
837 When we start up again when we're not noninteractive,
838 `init-global-faces' is called and it resources all
840 if (initialized && !noninteractive)
842 struct gcpro gcpro1, gcpro2;
845 call1 (Qinit_face_from_resources, name);
853 /*****************************************************************************
855 ****************************************************************************/
858 init_global_faces (struct device *d)
860 /* When making the initial terminal device, there is no Lisp code
861 loaded, so we can't do this. */
862 if (initialized && !noninteractive)
864 call_critical_lisp_code (d, Qinit_global_faces, Qnil);
869 init_device_faces (struct device *d)
871 /* This function can call lisp */
873 /* When making the initial terminal device, there is no Lisp code
874 loaded, so we can't do this. */
878 XSETDEVICE (tdevice, d);
879 call_critical_lisp_code (d, Qinit_device_faces, tdevice);
884 init_frame_faces (struct frame *frm)
886 /* When making the initial terminal device, there is no Lisp code
887 loaded, so we can't do this. */
891 XSETFRAME (tframe, frm);
893 /* DO NOT change the selected frame here. If the debugger goes off
894 it will try and display on the frame being created, but it is not
895 ready for that yet and a horrible death will occur. Any random
896 code depending on the selected-frame as an implicit arg should be
897 tracked down and shot. For the benefit of the one known,
898 xpm-color-symbols, make-frame sets the variable
899 Vframe_being_created to the frame it is making and sets it to nil
900 when done. Internal functions that this could trigger which are
901 currently depending on selected-frame should use this instead. It
902 is not currently visible at the lisp level. */
903 call_critical_lisp_code (XDEVICE (FRAME_DEVICE (frm)),
904 Qinit_frame_faces, tframe);
909 /****************************************************************************
910 * face cache element functions *
911 ****************************************************************************/
915 #### Here is a description of how the face cache elements ought
916 to be redone. It is *NOT* how they work currently:
918 However, when I started to go about implementing this, I realized
919 that there are all sorts of subtle problems with cache coherency
920 that are coming up. As it turns out, these problems don't
921 manifest themselves now due to the brute-force "kill 'em all"
922 approach to cache invalidation when faces change; but if this
923 is ever made smarter, these problems are going to come up, and
924 some of them are very non-obvious.
926 I'm thinking of redoing the cache code a bit to avoid these
927 coherency problems. The bulk of the problems will arise because
928 the current display structures have simple indices into the
929 face cache, but the cache can be changed at various times,
930 which could make the current display structures incorrect.
931 I guess the dirty and updated flags are an attempt to fix
932 this, but this approach doesn't really work.
934 Here's an approach that should keep things clean and unconfused:
936 1) Imagine a "virtual face cache" that can grow arbitrarily
937 big and for which the only thing allowed is to add new
938 elements. Existing elements cannot be removed or changed.
939 This way, any pointers in the existing redisplay structure
940 into the cache never get screwed up. (This is important
941 because even if a cache element is out of date, if there's
942 a pointer to it then its contents still accurately describe
943 the way the text currently looks on the screen.)
944 2) Each element in the virtual cache either describes exactly
945 one face, or describes the merger of a number of faces
946 by some process. In order to simplify things, for mergers
947 we do not record which faces or ordering was used, but
948 simply that this cache element is the result of merging.
949 Unlike the current implementation, it's important that a
950 single cache element not be used to both describe a
951 single face and describe a merger, even if all the property
953 3) Each cache element can be clean or dirty. "Dirty" means
954 that the face that the element points to has been changed;
955 this gets set at the time the face is changed. This
956 way, when looking up a value in the cache, you can determine
957 whether it's out of date or not. For merged faces it
958 does not matter -- we don't record the faces or priority
959 used to create the merger, so it's impossible to look up
960 one of these faces. We have to recompute it each time.
961 Luckily, this is fine -- doing the merge is much
962 less expensive than recomputing the properties of a
964 4) For each cache element, we keep a hash value. (In order
965 to hash the boolean properties, we convert each of them
966 into a different large prime number so that the hashing works
967 well.) This allows us, when comparing runes, to properly
968 determine whether the face for that rune has changed.
969 This will be especially important for TTY's, where there
970 aren't that many faces and minimizing redraw is very
972 5) We can't actually keep an infinite cache, but that doesn't
973 really matter that much. The only elements we care about
974 are those that are used by either the current or desired
975 display structs. Therefore, we keep a per-window
976 redisplay iteration number, and mark each element with
977 that number as we use it. Just after outputting the
978 window and synching the redisplay structs, we go through
979 the cache and invalidate all elements that are not clean
980 elements referring to a particular face and that do not
981 have an iteration number equal to the current one. We
982 keep them in a chain, and use them to allocate new
983 elements when possible instead of increasing the Dynarr.
987 /* mark for GC a dynarr of face cachels. */
990 mark_face_cachels (face_cachel_dynarr *elements)
997 for (elt = 0; elt < Dynarr_length (elements); elt++)
999 struct face_cachel *cachel = Dynarr_atp (elements, elt);
1004 for (i = 0; i < NUM_LEADING_BYTES; i++)
1005 if (!NILP (cachel->font[i]) && !UNBOUNDP (cachel->font[i]))
1006 mark_object (cachel->font[i]);
1008 mark_object (cachel->face);
1009 mark_object (cachel->foreground);
1010 mark_object (cachel->background);
1011 mark_object (cachel->display_table);
1012 mark_object (cachel->background_pixmap);
1016 /* ensure that the given cachel contains an updated font value for
1017 the given charset. Return the updated font value. */
1020 ensure_face_cachel_contains_charset (struct face_cachel *cachel,
1021 Lisp_Object domain, Lisp_Object charset)
1023 Lisp_Object new_val;
1024 Lisp_Object face = cachel->face;
1026 int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1028 if (!UNBOUNDP (cachel->font[offs])
1029 && cachel->font_updated[offs])
1030 return cachel->font[offs];
1032 if (UNBOUNDP (face))
1034 /* a merged face. */
1036 struct window *w = XWINDOW (domain);
1039 cachel->font_specified[offs] = 0;
1040 for (i = 0; i < cachel->nfaces; i++)
1042 struct face_cachel *oth;
1044 oth = Dynarr_atp (w->face_cachels,
1045 FACE_CACHEL_FINDEX_UNSAFE (cachel, i));
1046 /* Tout le monde aime la recursion */
1047 ensure_face_cachel_contains_charset (oth, domain, charset);
1049 if (oth->font_specified[offs])
1051 new_val = oth->font[offs];
1052 cachel->font_specified[offs] = 1;
1057 if (!cachel->font_specified[offs])
1058 /* need to do the default face. */
1060 struct face_cachel *oth =
1061 Dynarr_atp (w->face_cachels, DEFAULT_INDEX);
1062 ensure_face_cachel_contains_charset (oth, domain, charset);
1064 new_val = oth->font[offs];
1067 if (!UNBOUNDP (cachel->font[offs]) && !EQ (cachel->font[offs], new_val))
1069 cachel->font_updated[offs] = 1;
1070 cachel->font[offs] = new_val;
1074 new_val = face_property_matching_instance (face, Qfont, charset, domain,
1075 /* #### look into ERROR_ME_NOT */
1076 ERROR_ME_NOT, 1, Qzero);
1077 if (UNBOUNDP (new_val))
1080 new_val = face_property_matching_instance (face, Qfont,
1084 ERROR_ME_NOT, 0, Qzero);
1086 if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs]))
1088 cachel->font_updated[offs] = 1;
1089 cachel->font[offs] = new_val;
1090 cachel->font_specified[offs] = (bound || EQ (face, Vdefault_face));
1094 /* Ensure that the given cachel contains updated fonts for all
1095 the charsets specified. */
1098 ensure_face_cachel_complete (struct face_cachel *cachel,
1099 Lisp_Object domain, Charset_ID *charsets)
1103 for (i = 0; i < NUM_LEADING_BYTES; i++)
1106 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE);
1107 assert (CHARSETP (charset));
1108 ensure_face_cachel_contains_charset (cachel, domain, charset);
1113 face_cachel_charset_font_metric_info (struct face_cachel *cachel,
1114 Charset_ID *charsets,
1115 struct font_metric_info *fm)
1120 fm->height = fm->ascent = 1;
1122 fm->proportional_p = 0;
1124 for (i = 0; i < NUM_LEADING_BYTES; i++)
1128 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE);
1129 Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset);
1130 struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance);
1132 assert (CHARSETP (charset));
1133 assert (FONT_INSTANCEP (font_instance));
1135 if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent;
1136 if (fm->descent < (int) fi->descent) fm->descent = (int) fi->descent;
1137 fm->height = fm->ascent + fm->descent;
1138 if (fi->proportional_p)
1139 fm->proportional_p = 1;
1140 if (EQ (charset, Vcharset_ascii))
1141 fm->width = fi->width;
1146 /* Called when the updated flag has been cleared on a cachel. */
1149 update_face_cachel_data (struct face_cachel *cachel,
1153 if (XFACE (face)->dirty || UNBOUNDP (cachel->face))
1155 int default_face = EQ (face, Vdefault_face);
1156 cachel->face = face;
1158 /* We normally only set the _specified flags if the value was
1159 actually bound. The exception is for the default face where
1160 we always set it since it is the ultimate fallback. */
1162 #define FROB(field) \
1164 Lisp_Object new_val = \
1165 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
1167 if (UNBOUNDP (new_val)) \
1170 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1172 if (!EQ (new_val, cachel->field)) \
1174 cachel->field = new_val; \
1175 cachel->dirty = 1; \
1177 cachel->field##_specified = (bound || default_face); \
1182 FROB (display_table);
1183 FROB (background_pixmap);
1186 * A face's background pixmap will override the face's
1187 * background color. But the background pixmap of the
1188 * default face should not override the background color of
1189 * a face if the background color has been specified or
1192 * To accomplish this we remove the background pixmap of the
1193 * cachel and mark it as having been specified so that cachel
1194 * merging won't override it later.
1197 && cachel->background_specified
1198 && ! cachel->background_pixmap_specified)
1200 cachel->background_pixmap = Qunbound;
1201 cachel->background_pixmap_specified = 1;
1206 ensure_face_cachel_contains_charset (cachel, domain, Vcharset_ascii);
1208 #define FROB(field) \
1210 Lisp_Object new_val = \
1211 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
1213 unsigned int new_val_int; \
1214 if (UNBOUNDP (new_val)) \
1217 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1219 new_val_int = EQ (new_val, Qt); \
1220 if (cachel->field != new_val_int) \
1222 cachel->field = new_val_int; \
1223 cachel->dirty = 1; \
1225 cachel->field##_specified = bound; \
1237 cachel->updated = 1;
1240 /* Merge the cachel identified by FINDEX in window W into the given
1244 merge_face_cachel_data (struct window *w, face_index findex,
1245 struct face_cachel *cachel)
1247 #define FINDEX_FIELD(field) \
1248 Dynarr_atp (w->face_cachels, findex)->field
1250 #define FROB(field) \
1252 if (!cachel->field##_specified && FINDEX_FIELD (field##_specified)) \
1254 cachel->field = FINDEX_FIELD (field); \
1255 cachel->field##_specified = 1; \
1256 cachel->dirty = 1; \
1262 FROB (display_table);
1263 FROB (background_pixmap);
1270 /* And do ASCII, of course. */
1272 int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE;
1274 if (!cachel->font_specified[offs] && FINDEX_FIELD (font_specified[offs]))
1276 cachel->font[offs] = FINDEX_FIELD (font[offs]);
1277 cachel->font_specified[offs] = 1;
1285 cachel->updated = 1;
1288 /* Initialize a cachel. */
1291 reset_face_cachel (struct face_cachel *cachel)
1294 cachel->face = Qunbound;
1296 cachel->merged_faces = 0;
1297 cachel->foreground = Qunbound;
1298 cachel->background = Qunbound;
1302 for (i = 0; i < NUM_LEADING_BYTES; i++)
1303 cachel->font[i] = Qunbound;
1305 cachel->display_table = Qunbound;
1306 cachel->background_pixmap = Qunbound;
1309 /* Add a cachel for the given face to the given window's cache. */
1312 add_face_cachel (struct window *w, Lisp_Object face)
1314 struct face_cachel new_cachel;
1317 reset_face_cachel (&new_cachel);
1318 XSETWINDOW (window, w);
1319 update_face_cachel_data (&new_cachel, window, face);
1320 Dynarr_add (w->face_cachels, new_cachel);
1323 /* Retrieve the index to a cachel for window W that corresponds to
1324 the specified face. If necessary, add a new element to the
1328 get_builtin_face_cache_index (struct window *w, Lisp_Object face)
1335 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1337 struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt);
1339 if (EQ (cachel->face, face))
1342 XSETWINDOW (window, w);
1343 if (!cachel->updated)
1344 update_face_cachel_data (cachel, window, face);
1349 /* If we didn't find the face, add it and then return its index. */
1350 add_face_cachel (w, face);
1355 reset_face_cachels (struct window *w)
1357 /* #### Not initialized in batch mode for the stream device. */
1358 if (w->face_cachels)
1362 for (i = 0; i < Dynarr_length (w->face_cachels); i++)
1364 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, i);
1365 if (cachel->merged_faces)
1366 Dynarr_free (cachel->merged_faces);
1368 Dynarr_reset (w->face_cachels);
1369 get_builtin_face_cache_index (w, Vdefault_face);
1370 get_builtin_face_cache_index (w, Vmodeline_face);
1371 XFRAME (w->frame)->window_face_cache_reset = 1;
1376 mark_face_cachels_as_clean (struct window *w)
1380 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1381 Dynarr_atp (w->face_cachels, elt)->dirty = 0;
1385 mark_face_cachels_as_not_updated (struct window *w)
1389 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1391 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt);
1394 cachel->updated = 0;
1395 for (i = 0; i < NUM_LEADING_BYTES; i++)
1396 cachel->font_updated[i] = 0;
1400 #ifdef MEMORY_USAGE_STATS
1403 compute_face_cachel_usage (face_cachel_dynarr *face_cachels,
1404 struct overhead_stats *ovstats)
1412 total += Dynarr_memory_usage (face_cachels, ovstats);
1413 for (i = 0; i < Dynarr_length (face_cachels); i++)
1415 int_dynarr *merged = Dynarr_at (face_cachels, i).merged_faces;
1417 total += Dynarr_memory_usage (merged, ovstats);
1424 #endif /* MEMORY_USAGE_STATS */
1427 /*****************************************************************************
1428 * merged face functions *
1429 *****************************************************************************/
1431 /* Compare two merged face cachels to determine whether we have to add
1432 a new entry to the face cache.
1434 Note that we do not compare the attributes, but just the faces the
1435 cachels are based on. If they are the same, then the cachels certainly
1436 ought to have the same attributes, except in the case where fonts
1437 for different charsets have been determined in the two -- and in that
1438 case this difference is fine. */
1441 compare_merged_face_cachels (struct face_cachel *cachel1,
1442 struct face_cachel *cachel2)
1446 if (!EQ (cachel1->face, cachel2->face)
1447 || cachel1->nfaces != cachel2->nfaces)
1450 for (i = 0; i < cachel1->nfaces; i++)
1451 if (FACE_CACHEL_FINDEX_UNSAFE (cachel1, i)
1452 != FACE_CACHEL_FINDEX_UNSAFE (cachel2, i))
1458 /* Retrieve the index to a cachel for window W that corresponds to
1459 the specified cachel. If necessary, add a new element to the
1460 cache. This is similar to get_builtin_face_cache_index() but
1461 is intended for merged cachels rather than for cachels representing
1464 Note that a merged cachel for just one face is not the same as
1465 the simple cachel for that face, because it is also merged with
1466 the default face. */
1469 get_merged_face_cache_index (struct window *w,
1470 struct face_cachel *merged_cachel)
1473 int cache_size = Dynarr_length (w->face_cachels);
1475 for (elt = 0; elt < cache_size; elt++)
1477 struct face_cachel *cachel =
1478 Dynarr_atp (w->face_cachels, elt);
1480 if (compare_merged_face_cachels (cachel, merged_cachel))
1484 /* We didn't find it so add this instance to the cache. */
1485 merged_cachel->updated = 1;
1486 merged_cachel->dirty = 1;
1487 Dynarr_add (w->face_cachels, *merged_cachel);
1492 get_extent_fragment_face_cache_index (struct window *w,
1493 struct extent_fragment *ef)
1495 struct face_cachel cachel;
1496 int len = Dynarr_length (ef->extents);
1497 face_index findex = 0;
1499 XSETWINDOW (window, w);
1501 /* Optimize the default case. */
1503 return DEFAULT_INDEX;
1508 /* Merge the faces of the extents together in order. */
1510 reset_face_cachel (&cachel);
1512 for (i = len - 1; i >= 0; i--)
1514 EXTENT current = Dynarr_at (ef->extents, i);
1516 Lisp_Object face = extent_face (current);
1520 findex = get_builtin_face_cache_index (w, face);
1522 merge_face_cachel_data (w, findex, &cachel);
1524 /* remember, we're called from within redisplay
1525 so we can't error. */
1526 else while (CONSP (face))
1528 Lisp_Object one_face = XCAR (face);
1529 if (FACEP (one_face))
1531 findex = get_builtin_face_cache_index (w, one_face);
1532 merge_face_cachel_data (w, findex, &cachel);
1534 /* code duplication here but there's no clean
1536 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES)
1538 if (!cachel.merged_faces)
1539 cachel.merged_faces = Dynarr_new (int);
1540 Dynarr_add (cachel.merged_faces, findex);
1543 cachel.merged_faces_static[cachel.nfaces] = findex;
1551 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES)
1553 if (!cachel.merged_faces)
1554 cachel.merged_faces = Dynarr_new (int);
1555 Dynarr_add (cachel.merged_faces, findex);
1558 cachel.merged_faces_static[cachel.nfaces] = findex;
1563 /* Now finally merge in the default face. */
1564 findex = get_builtin_face_cache_index (w, Vdefault_face);
1565 merge_face_cachel_data (w, findex, &cachel);
1567 return get_merged_face_cache_index (w, &cachel);
1572 /*****************************************************************************
1574 ****************************************************************************/
1577 update_EmacsFrame (Lisp_Object frame, Lisp_Object name)
1579 struct frame *frm = XFRAME (frame);
1581 if (EQ (name, Qfont))
1582 MARK_FRAME_SIZE_SLIPPED (frm);
1584 MAYBE_FRAMEMETH (frm, update_frame_external_traits, (frm, name));
1588 update_EmacsFrames (Lisp_Object locale, Lisp_Object name)
1590 if (FRAMEP (locale))
1592 update_EmacsFrame (locale, name);
1594 else if (DEVICEP (locale))
1596 Lisp_Object frmcons;
1598 DEVICE_FRAME_LOOP (frmcons, XDEVICE (locale))
1599 update_EmacsFrame (XCAR (frmcons), name);
1601 else if (EQ (locale, Qglobal) || EQ (locale, Qfallback))
1603 Lisp_Object frmcons, devcons, concons;
1605 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
1606 update_EmacsFrame (XCAR (frmcons), name);
1611 update_frame_face_values (struct frame *f)
1616 update_EmacsFrame (frm, Qforeground);
1617 update_EmacsFrame (frm, Qbackground);
1618 update_EmacsFrame (frm, Qfont);
1622 face_property_was_changed (Lisp_Object face, Lisp_Object property,
1625 int default_face = EQ (face, Vdefault_face);
1627 /* If the locale could affect the frame value, then call
1628 update_EmacsFrames just in case. */
1630 (EQ (property, Qforeground) ||
1631 EQ (property, Qbackground) ||
1632 EQ (property, Qfont)))
1633 update_EmacsFrames (locale, property);
1635 if (WINDOWP (locale))
1637 MARK_FRAME_FACES_CHANGED (XFRAME (XWINDOW (locale)->frame));
1639 else if (FRAMEP (locale))
1641 MARK_FRAME_FACES_CHANGED (XFRAME (locale));
1643 else if (DEVICEP (locale))
1645 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (locale));
1649 Lisp_Object devcons, concons;
1650 DEVICE_LOOP_NO_BREAK (devcons, concons)
1651 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (XCAR (devcons)));
1655 * This call to update_faces_inheritance isn't needed and makes
1656 * creating and modifying faces _very_ slow. The point of
1657 * update_face_inheritances is to find all faces that inherit
1658 * directly from this face property and set the specifier "dirty"
1659 * flag on the corresponding specifier. This forces recaching of
1660 * cached specifier values in frame and window struct slots. But
1661 * currently no face properties are cached in frame and window
1662 * struct slots, so calling this function does nothing useful!
1664 * Further, since update_faces_inheritance maps over the whole
1665 * face table every time it is called, it gets terribly slow when
1666 * there are many faces. Creating 500 faces on a 50Mhz 486 took
1667 * 433 seconds when update_faces_inheritance was called. With the
1668 * call commented out, creating those same 500 faces took 0.72
1671 /* update_faces_inheritance (face, property);*/
1672 XFACE (face)->dirty = 1;
1675 DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /*
1676 Define and return a new face which is a copy of an existing one,
1677 or makes an already-existing face be exactly like another.
1678 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'.
1680 (old_face, new_name, locale, tag_set, exact_p, how_to_add))
1682 struct Lisp_Face *fold, *fnew;
1683 Lisp_Object new_face = Qnil;
1684 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1686 old_face = Fget_face (old_face);
1688 /* We GCPRO old_face because it might be temporary, and GCing could
1689 occur in various places below. */
1690 GCPRO4 (tag_set, locale, old_face, new_face);
1691 /* check validity of how_to_add now. */
1692 decode_how_to_add_specification (how_to_add);
1693 /* and of tag_set. */
1694 tag_set = decode_specifier_tag_set (tag_set);
1695 /* and of locale. */
1696 locale = decode_locale_list (locale);
1698 new_face = Ffind_face (new_name);
1699 if (NILP (new_face))
1703 CHECK_SYMBOL (new_name);
1705 /* Create the new face with the same status as the old face. */
1706 temp = (NILP (Fgethash (old_face, Vtemporary_faces_cache, Qnil))
1710 new_face = Fmake_face (new_name, Qnil, temp);
1713 fold = XFACE (old_face);
1714 fnew = XFACE (new_face);
1716 #define COPY_PROPERTY(property) \
1717 Fcopy_specifier (fold->property, fnew->property, \
1718 locale, tag_set, exact_p, how_to_add);
1720 COPY_PROPERTY (foreground);
1721 COPY_PROPERTY (background);
1722 COPY_PROPERTY (font);
1723 COPY_PROPERTY (display_table);
1724 COPY_PROPERTY (background_pixmap);
1725 COPY_PROPERTY (underline);
1726 COPY_PROPERTY (strikethru);
1727 COPY_PROPERTY (highlight);
1728 COPY_PROPERTY (dim);
1729 COPY_PROPERTY (blinking);
1730 COPY_PROPERTY (reverse);
1731 #undef COPY_PROPERTY
1732 /* #### should it copy the individual specifiers, if they exist? */
1733 fnew->plist = Fcopy_sequence (fold->plist);
1742 syms_of_faces (void)
1744 /* Qdefault & Qwidget defined in general.c */
1745 defsymbol (&Qmodeline, "modeline");
1746 defsymbol (&Qgui_element, "gui-element");
1747 defsymbol (&Qleft_margin, "left-margin");
1748 defsymbol (&Qright_margin, "right-margin");
1749 defsymbol (&Qtext_cursor, "text-cursor");
1750 defsymbol (&Qvertical_divider, "vertical-divider");
1753 DEFSUBR (Ffind_face);
1754 DEFSUBR (Fget_face);
1755 DEFSUBR (Fface_name);
1756 DEFSUBR (Fbuilt_in_face_specifiers);
1757 DEFSUBR (Fface_list);
1758 DEFSUBR (Fmake_face);
1759 DEFSUBR (Fcopy_face);
1761 defsymbol (&Qfacep, "facep");
1762 defsymbol (&Qforeground, "foreground");
1763 defsymbol (&Qbackground, "background");
1764 /* Qfont defined in general.c */
1765 defsymbol (&Qdisplay_table, "display-table");
1766 defsymbol (&Qbackground_pixmap, "background-pixmap");
1767 defsymbol (&Qunderline, "underline");
1768 defsymbol (&Qstrikethru, "strikethru");
1769 /* Qhighlight, Qreverse defined in general.c */
1770 defsymbol (&Qdim, "dim");
1771 defsymbol (&Qblinking, "blinking");
1773 defsymbol (&Qinit_face_from_resources, "init-face-from-resources");
1774 defsymbol (&Qinit_global_faces, "init-global-faces");
1775 defsymbol (&Qinit_device_faces, "init-device-faces");
1776 defsymbol (&Qinit_frame_faces, "init-frame-faces");
1780 structure_type_create_faces (void)
1782 struct structure_type *st;
1784 st = define_structure_type (Qface, face_validate, face_instantiate);
1786 define_structure_type_keyword (st, Qname, face_name_validate);
1790 vars_of_faces (void)
1792 staticpro (&Vpermanent_faces_cache);
1793 Vpermanent_faces_cache = Qnil;
1794 staticpro (&Vtemporary_faces_cache);
1795 Vtemporary_faces_cache = Qnil;
1797 staticpro (&Vdefault_face);
1798 Vdefault_face = Qnil;
1799 staticpro (&Vgui_element_face);
1800 Vgui_element_face = Qnil;
1801 staticpro (&Vwidget_face);
1802 Vwidget_face = Qnil;
1803 staticpro (&Vmodeline_face);
1804 Vmodeline_face = Qnil;
1805 staticpro (&Vtoolbar_face);
1806 Vtoolbar_face = Qnil;
1808 staticpro (&Vvertical_divider_face);
1809 Vvertical_divider_face = Qnil;
1810 staticpro (&Vleft_margin_face);
1811 Vleft_margin_face = Qnil;
1812 staticpro (&Vright_margin_face);
1813 Vright_margin_face = Qnil;
1814 staticpro (&Vtext_cursor_face);
1815 Vtext_cursor_face = Qnil;
1816 staticpro (&Vpointer_face);
1817 Vpointer_face = Qnil;
1820 Lisp_Object syms[20];
1823 syms[n++] = Qforeground;
1824 syms[n++] = Qbackground;
1826 syms[n++] = Qdisplay_table;
1827 syms[n++] = Qbackground_pixmap;
1828 syms[n++] = Qunderline;
1829 syms[n++] = Qstrikethru;
1830 syms[n++] = Qhighlight;
1832 syms[n++] = Qblinking;
1833 syms[n++] = Qreverse;
1835 Vbuilt_in_face_specifiers = Flist (n, syms);
1836 staticpro (&Vbuilt_in_face_specifiers);
1841 complex_vars_of_faces (void)
1843 Vpermanent_faces_cache =
1844 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
1845 Vtemporary_faces_cache =
1846 make_lisp_hash_table (0, HASH_TABLE_WEAK, HASH_TABLE_EQ);
1848 /* Create the default face now so we know what it is immediately. */
1850 Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus
1852 Vdefault_face = Fmake_face (Qdefault, build_string ("default face"),
1855 /* Provide some last-resort fallbacks to avoid utter fuckage if
1856 someone provides invalid values for the global specifications. */
1859 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1861 #ifdef HAVE_X_WINDOWS
1862 fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
1863 bg_fb = acons (list1 (Qx), build_string ("white"), bg_fb);
1866 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1867 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1869 #ifdef HAVE_MS_WINDOWS
1870 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1871 bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb);
1873 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb);
1874 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb);
1877 /* #### We may want to have different fallback values if NeXTstep
1878 support is compiled in. */
1880 Lisp_Object inst_list = Qnil;
1881 #ifdef HAVE_X_WINDOWS
1882 /* The same gory list from x-faces.el.
1883 (#### Perhaps we should remove the stuff from x-faces.el
1884 and only depend on this stuff here? That should work.)
1886 CONST char *fonts[] =
1888 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
1889 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
1890 "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*",
1891 "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*",
1892 "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*",
1893 "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*",
1894 "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*",
1895 "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*",
1896 "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*",
1897 "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*",
1898 "-*-*-*-r-*-*-*-120-*-*-m-*-*-*",
1899 "-*-*-*-r-*-*-*-120-*-*-c-*-*-*",
1900 "-*-*-*-r-*-*-*-120-*-*-*-*-*-*",
1901 "-*-*-*-*-*-*-*-120-*-*-*-*-*-*",
1904 CONST char **fontptr;
1906 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--)
1907 inst_list = Fcons (Fcons (list1 (Qx), build_string (*fontptr)),
1909 #endif /* HAVE_X_WINDOWS */
1912 inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")),
1914 #endif /* HAVE_TTY */
1915 #ifdef HAVE_MS_WINDOWS
1916 inst_list = Fcons (Fcons (list1 (Qmswindows),
1917 build_string ("Fixedsys:Regular:9::Western")), inst_list);
1918 inst_list = Fcons (Fcons (list1 (Qmswindows),
1919 build_string ("Courier:Regular:10::Western")), inst_list);
1920 inst_list = Fcons (Fcons (list1 (Qmswindows),
1921 build_string ("Courier New:Regular:10::Western")), inst_list);
1922 #endif /* HAVE_MS_WINDOWS */
1923 set_specifier_fallback (Fget (Vdefault_face, Qfont, Qnil), inst_list);
1926 set_specifier_fallback (Fget (Vdefault_face, Qunderline, Qnil),
1927 list1 (Fcons (Qnil, Qnil)));
1928 set_specifier_fallback (Fget (Vdefault_face, Qstrikethru, Qnil),
1929 list1 (Fcons (Qnil, Qnil)));
1930 set_specifier_fallback (Fget (Vdefault_face, Qhighlight, Qnil),
1931 list1 (Fcons (Qnil, Qnil)));
1932 set_specifier_fallback (Fget (Vdefault_face, Qdim, Qnil),
1933 list1 (Fcons (Qnil, Qnil)));
1934 set_specifier_fallback (Fget (Vdefault_face, Qblinking, Qnil),
1935 list1 (Fcons (Qnil, Qnil)));
1936 set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil),
1937 list1 (Fcons (Qnil, Qnil)));
1939 /* gui-element is the parent face of all gui elements such as
1940 modeline, vertical divider and toolbar. */
1941 Vgui_element_face = Fmake_face (Qgui_element,
1942 build_string ("gui element face"),
1945 /* Provide some last-resort fallbacks for gui-element face which
1946 mustn't default to default. */
1948 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1950 #ifdef HAVE_X_WINDOWS
1951 fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
1952 bg_fb = acons (list1 (Qx), build_string ("Gray80"), bg_fb);
1955 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1956 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1958 #ifdef HAVE_MS_WINDOWS
1959 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1960 bg_fb = acons (list1 (Qmswindows), build_string ("Gray75"), bg_fb);
1962 set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb);
1963 set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb);
1966 /* Now create the other faces that redisplay needs to refer to
1967 directly. We could create them in Lisp but it's simpler this
1968 way since we need to get them anyway. */
1970 /* modeline is gui element. */
1971 Vmodeline_face = Fmake_face (Qmodeline, build_string ("modeline face"),
1974 set_specifier_fallback (Fget (Vmodeline_face, Qforeground, Qunbound),
1975 Fget (Vgui_element_face, Qforeground, Qunbound));
1976 set_specifier_fallback (Fget (Vmodeline_face, Qbackground, Qunbound),
1977 Fget (Vgui_element_face, Qbackground, Qunbound));
1978 set_specifier_fallback (Fget (Vmodeline_face, Qbackground_pixmap, Qnil),
1979 Fget (Vgui_element_face, Qbackground_pixmap,
1982 /* toolbar is another gui element */
1983 Vtoolbar_face = Fmake_face (Qtoolbar,
1984 build_string ("toolbar face"),
1986 set_specifier_fallback (Fget (Vtoolbar_face, Qforeground, Qunbound),
1987 Fget (Vgui_element_face, Qforeground, Qunbound));
1988 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground, Qunbound),
1989 Fget (Vgui_element_face, Qbackground, Qunbound));
1990 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_pixmap, Qnil),
1991 Fget (Vgui_element_face, Qbackground_pixmap,
1994 /* vertical divider is another gui element */
1995 Vvertical_divider_face = Fmake_face (Qvertical_divider,
1996 build_string ("vertical divider face"),
1999 set_specifier_fallback (Fget (Vvertical_divider_face, Qforeground, Qunbound),
2000 Fget (Vgui_element_face, Qforeground, Qunbound));
2001 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground, Qunbound),
2002 Fget (Vgui_element_face, Qbackground, Qunbound));
2003 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground_pixmap,
2005 Fget (Vgui_element_face, Qbackground_pixmap,
2008 /* widget is another gui element */
2009 Vwidget_face = Fmake_face (Qwidget,
2010 build_string ("widget face"),
2012 set_specifier_fallback (Fget (Vwidget_face, Qforeground, Qunbound),
2013 Fget (Vgui_element_face, Qforeground, Qunbound));
2014 set_specifier_fallback (Fget (Vwidget_face, Qbackground, Qunbound),
2015 Fget (Vgui_element_face, Qbackground, Qunbound));
2016 set_specifier_fallback (Fget (Vwidget_face, Qbackground_pixmap, Qnil),
2017 Fget (Vgui_element_face, Qbackground_pixmap,
2020 Vleft_margin_face = Fmake_face (Qleft_margin,
2021 build_string ("left margin face"),
2023 Vright_margin_face = Fmake_face (Qright_margin,
2024 build_string ("right margin face"),
2026 Vtext_cursor_face = Fmake_face (Qtext_cursor,
2027 build_string ("face for text cursor"),
2030 Fmake_face (Qpointer,
2032 ("face for foreground/background colors of mouse pointer"),