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, Qleft_margin, Qright_margin defined in general.c */
61 Lisp_Object Qmodeline, Qgui_element, Qtext_cursor, Qvertical_divider;
63 /* In the old implementation Vface_list was a list of the face names,
64 not the faces themselves. We now distinguish between permanent and
65 temporary faces. Permanent faces are kept in a regular hash table,
66 temporary faces in a weak hash table. */
67 Lisp_Object Vpermanent_faces_cache;
68 Lisp_Object Vtemporary_faces_cache;
70 Lisp_Object Vbuilt_in_face_specifiers;
75 mark_face (Lisp_Object obj)
77 Lisp_Face *face = XFACE (obj);
79 mark_object (face->name);
80 mark_object (face->doc_string);
82 mark_object (face->foreground);
83 mark_object (face->background);
84 mark_object (face->font);
85 mark_object (face->display_table);
86 mark_object (face->background_pixmap);
87 mark_object (face->underline);
88 mark_object (face->strikethru);
89 mark_object (face->highlight);
90 mark_object (face->dim);
91 mark_object (face->blinking);
92 mark_object (face->reverse);
94 mark_object (face->charsets_warned_about);
100 print_face (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
102 Lisp_Face *face = XFACE (obj);
106 write_c_string ("#s(face name ", printcharfun);
107 print_internal (face->name, printcharfun, 1);
108 write_c_string (")", printcharfun);
112 write_c_string ("#<face ", printcharfun);
113 print_internal (face->name, printcharfun, 1);
114 if (!NILP (face->doc_string))
116 write_c_string (" ", printcharfun);
117 print_internal (face->doc_string, printcharfun, 1);
119 write_c_string (">", printcharfun);
123 /* Faces are equal if all of their display attributes are equal. We
124 don't compare names or doc-strings, because that would make equal
127 This isn't concerned with "unspecified" attributes, that's what
128 #'face-differs-from-default-p is for. */
130 face_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
132 Lisp_Face *f1 = XFACE (obj1);
133 Lisp_Face *f2 = XFACE (obj2);
138 (internal_equal (f1->foreground, f2->foreground, depth) &&
139 internal_equal (f1->background, f2->background, depth) &&
140 internal_equal (f1->font, f2->font, depth) &&
141 internal_equal (f1->display_table, f2->display_table, depth) &&
142 internal_equal (f1->background_pixmap, f2->background_pixmap, depth) &&
143 internal_equal (f1->underline, f2->underline, depth) &&
144 internal_equal (f1->strikethru, f2->strikethru, depth) &&
145 internal_equal (f1->highlight, f2->highlight, depth) &&
146 internal_equal (f1->dim, f2->dim, depth) &&
147 internal_equal (f1->blinking, f2->blinking, depth) &&
148 internal_equal (f1->reverse, f2->reverse, depth) &&
150 ! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1));
154 face_hash (Lisp_Object obj, int depth)
156 Lisp_Face *f = XFACE (obj);
160 /* No need to hash all of the elements; that would take too long.
161 Just hash the most common ones. */
162 return HASH3 (internal_hash (f->foreground, depth),
163 internal_hash (f->background, depth),
164 internal_hash (f->font, depth));
168 face_getprop (Lisp_Object obj, Lisp_Object prop)
170 Lisp_Face *f = XFACE (obj);
173 (EQ (prop, Qforeground) ? f->foreground :
174 EQ (prop, Qbackground) ? f->background :
175 EQ (prop, Qfont) ? f->font :
176 EQ (prop, Qdisplay_table) ? f->display_table :
177 EQ (prop, Qbackground_pixmap) ? f->background_pixmap :
178 EQ (prop, Qunderline) ? f->underline :
179 EQ (prop, Qstrikethru) ? f->strikethru :
180 EQ (prop, Qhighlight) ? f->highlight :
181 EQ (prop, Qdim) ? f->dim :
182 EQ (prop, Qblinking) ? f->blinking :
183 EQ (prop, Qreverse) ? f->reverse :
184 EQ (prop, Qdoc_string) ? f->doc_string :
185 external_plist_get (&f->plist, prop, 0, ERROR_ME));
189 face_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
191 Lisp_Face *f = XFACE (obj);
193 if (EQ (prop, Qforeground) ||
194 EQ (prop, Qbackground) ||
196 EQ (prop, Qdisplay_table) ||
197 EQ (prop, Qbackground_pixmap) ||
198 EQ (prop, Qunderline) ||
199 EQ (prop, Qstrikethru) ||
200 EQ (prop, Qhighlight) ||
202 EQ (prop, Qblinking) ||
206 if (EQ (prop, Qdoc_string))
209 CHECK_STRING (value);
210 f->doc_string = value;
214 external_plist_put (&f->plist, prop, value, 0, ERROR_ME);
219 face_remprop (Lisp_Object obj, Lisp_Object prop)
221 Lisp_Face *f = XFACE (obj);
223 if (EQ (prop, Qforeground) ||
224 EQ (prop, Qbackground) ||
226 EQ (prop, Qdisplay_table) ||
227 EQ (prop, Qbackground_pixmap) ||
228 EQ (prop, Qunderline) ||
229 EQ (prop, Qstrikethru) ||
230 EQ (prop, Qhighlight) ||
232 EQ (prop, Qblinking) ||
236 if (EQ (prop, Qdoc_string))
238 f->doc_string = Qnil;
242 return external_remprop (&f->plist, prop, 0, ERROR_ME);
246 face_plist (Lisp_Object obj)
248 Lisp_Face *face = XFACE (obj);
249 Lisp_Object result = face->plist;
251 result = cons3 (Qreverse, face->reverse, result);
252 result = cons3 (Qblinking, face->blinking, result);
253 result = cons3 (Qdim, face->dim, result);
254 result = cons3 (Qhighlight, face->highlight, result);
255 result = cons3 (Qstrikethru, face->strikethru, result);
256 result = cons3 (Qunderline, face->underline, result);
257 result = cons3 (Qbackground_pixmap, face->background_pixmap, result);
258 result = cons3 (Qdisplay_table, face->display_table, result);
259 result = cons3 (Qfont, face->font, result);
260 result = cons3 (Qbackground, face->background, result);
261 result = cons3 (Qforeground, face->foreground, result);
266 static const struct lrecord_description face_description[] = {
267 { XD_LISP_OBJECT, offsetof (Lisp_Face, name) },
268 { XD_LISP_OBJECT, offsetof (Lisp_Face, doc_string) },
269 { XD_LISP_OBJECT, offsetof (Lisp_Face, foreground) },
270 { XD_LISP_OBJECT, offsetof (Lisp_Face, background) },
271 { XD_LISP_OBJECT, offsetof (Lisp_Face, font) },
272 { XD_LISP_OBJECT, offsetof (Lisp_Face, display_table) },
273 { XD_LISP_OBJECT, offsetof (Lisp_Face, background_pixmap) },
274 { XD_LISP_OBJECT, offsetof (Lisp_Face, underline) },
275 { XD_LISP_OBJECT, offsetof (Lisp_Face, strikethru) },
276 { XD_LISP_OBJECT, offsetof (Lisp_Face, highlight) },
277 { XD_LISP_OBJECT, offsetof (Lisp_Face, dim) },
278 { XD_LISP_OBJECT, offsetof (Lisp_Face, blinking) },
279 { XD_LISP_OBJECT, offsetof (Lisp_Face, reverse) },
280 { XD_LISP_OBJECT, offsetof (Lisp_Face, plist) },
281 { XD_LISP_OBJECT, offsetof (Lisp_Face, charsets_warned_about) },
285 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face,
286 mark_face, print_face, 0, face_equal,
287 face_hash, face_description, face_getprop,
288 face_putprop, face_remprop,
289 face_plist, Lisp_Face);
291 /************************************************************************/
292 /* face read syntax */
293 /************************************************************************/
296 face_name_validate (Lisp_Object keyword, Lisp_Object value,
299 if (ERRB_EQ (errb, ERROR_ME))
301 CHECK_SYMBOL (value);
305 return SYMBOLP (value);
309 face_validate (Lisp_Object data, Error_behavior errb)
312 Lisp_Object valw = Qnil;
314 data = Fcdr (data); /* skip over Qface */
317 Lisp_Object keyw = Fcar (data);
322 if (EQ (keyw, Qname))
330 maybe_error (Qface, errb, "No face name given");
334 if (NILP (Ffind_face (valw)))
336 maybe_signal_simple_error ("No such face", valw, Qface, errb);
344 face_instantiate (Lisp_Object data)
346 return Fget_face (Fcar (Fcdr (data)));
350 /****************************************************************************
351 * utility functions *
352 ****************************************************************************/
355 reset_face (Lisp_Face *f)
358 f->doc_string = Qnil;
360 f->foreground = Qnil;
361 f->background = Qnil;
363 f->display_table = Qnil;
364 f->background_pixmap = Qnil;
366 f->strikethru = Qnil;
372 f->charsets_warned_about = Qnil;
378 Lisp_Face *result = alloc_lcrecord_type (Lisp_Face, &lrecord_face);
385 /* We store the faces in hash tables with the names as the key and the
386 actual face object as the value. Occasionally we need to use them
387 in a list format. These routines provide us with that. */
388 struct face_list_closure
390 Lisp_Object *face_list;
394 add_face_to_list_mapper (Lisp_Object key, Lisp_Object value,
395 void *face_list_closure)
397 /* This function can GC */
398 struct face_list_closure *fcl =
399 (struct face_list_closure *) face_list_closure;
401 *(fcl->face_list) = Fcons (XFACE (value)->name, (*fcl->face_list));
406 faces_list_internal (Lisp_Object list)
408 Lisp_Object face_list = Qnil;
410 struct face_list_closure face_list_closure;
413 face_list_closure.face_list = &face_list;
414 elisp_maphash (add_face_to_list_mapper, list, &face_list_closure);
421 permanent_faces_list (void)
423 return faces_list_internal (Vpermanent_faces_cache);
427 temporary_faces_list (void)
429 return faces_list_internal (Vtemporary_faces_cache);
434 mark_face_as_clean_mapper (Lisp_Object key, Lisp_Object value,
437 /* This function can GC */
438 int *flag = (int *) flag_closure;
439 XFACE (value)->dirty = *flag;
444 mark_all_faces_internal (int flag)
446 elisp_maphash (mark_face_as_clean_mapper, Vpermanent_faces_cache, &flag);
447 elisp_maphash (mark_face_as_clean_mapper, Vtemporary_faces_cache, &flag);
451 mark_all_faces_as_clean (void)
453 mark_all_faces_internal (0);
456 /* Currently unused (see the comment in face_property_was_changed()). */
458 /* #### OBSOLETE ME, PLEASE. Maybe. Maybe this is just as good as
459 any other solution. */
460 struct face_inheritance_closure
463 Lisp_Object property;
467 update_inheritance_mapper_internal (Lisp_Object cur_face,
468 Lisp_Object inh_face,
469 Lisp_Object property)
471 /* #### fix this function */
472 Lisp_Object elt = Qnil;
477 for (elt = FACE_PROPERTY_SPEC_LIST (cur_face, property, Qall);
481 Lisp_Object values = XCDR (XCAR (elt));
483 for (; !NILP (values); values = XCDR (values))
485 Lisp_Object value = XCDR (XCAR (values));
486 if (VECTORP (value) && XVECTOR_LENGTH (value))
488 if (EQ (Ffind_face (XVECTOR_DATA (value)[0]), inh_face))
489 Fset_specifier_dirty_flag
490 (FACE_PROPERTY_SPECIFIER (inh_face, property));
499 update_face_inheritance_mapper (const void *hash_key, void *hash_contents,
500 void *face_inheritance_closure)
502 Lisp_Object key, contents;
503 struct face_inheritance_closure *fcl =
504 (struct face_inheritance_closure *) face_inheritance_closure;
506 CVOID_TO_LISP (key, hash_key);
507 VOID_TO_LISP (contents, hash_contents);
509 if (EQ (fcl->property, Qfont))
511 update_inheritance_mapper_internal (contents, fcl->face, Qfont);
513 else if (EQ (fcl->property, Qforeground) ||
514 EQ (fcl->property, Qbackground))
516 update_inheritance_mapper_internal (contents, fcl->face, Qforeground);
517 update_inheritance_mapper_internal (contents, fcl->face, Qbackground);
519 else if (EQ (fcl->property, Qunderline) ||
520 EQ (fcl->property, Qstrikethru) ||
521 EQ (fcl->property, Qhighlight) ||
522 EQ (fcl->property, Qdim) ||
523 EQ (fcl->property, Qblinking) ||
524 EQ (fcl->property, Qreverse))
526 update_inheritance_mapper_internal (contents, fcl->face, Qunderline);
527 update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru);
528 update_inheritance_mapper_internal (contents, fcl->face, Qhighlight);
529 update_inheritance_mapper_internal (contents, fcl->face, Qdim);
530 update_inheritance_mapper_internal (contents, fcl->face, Qblinking);
531 update_inheritance_mapper_internal (contents, fcl->face, Qreverse);
537 update_faces_inheritance (Lisp_Object face, Lisp_Object property)
539 struct face_inheritance_closure face_inheritance_closure;
540 struct gcpro gcpro1, gcpro2;
542 GCPRO2 (face, property);
543 face_inheritance_closure.face = face;
544 face_inheritance_closure.property = property;
546 elisp_maphash (update_face_inheritance_mapper, Vpermanent_faces_cache,
547 &face_inheritance_closure);
548 elisp_maphash (update_face_inheritance_mapper, Vtemporary_faces_cache,
549 &face_inheritance_closure);
556 face_property_matching_instance (Lisp_Object face, Lisp_Object property,
557 Lisp_Object charset, Lisp_Object domain,
558 Error_behavior errb, int no_fallback,
562 specifier_instance_no_quit (Fget (face, property, Qnil), charset,
563 domain, errb, no_fallback, depth);
565 if (UNBOUNDP (retval) && !no_fallback)
567 if (EQ (property, Qfont))
569 if (NILP (memq_no_quit (charset,
570 XFACE (face)->charsets_warned_about)))
573 if (! UNBOUNDP (charset))
576 "Unable to instantiate font for face %s, charset %s",
577 string_data (symbol_name
578 (XSYMBOL (XFACE (face)->name))),
579 string_data (symbol_name
580 (XSYMBOL (XCHARSET_NAME (charset)))));
583 warn_when_safe (Qfont, Qwarning,
584 "Unable to instantiate font for face %s",
585 string_data (symbol_name
586 (XSYMBOL (XFACE (face)->name))));
587 XFACE (face)->charsets_warned_about =
588 Fcons (charset, XFACE (face)->charsets_warned_about);
590 retval = Vthe_null_font_instance;
598 DEFUN ("facep", Ffacep, 1, 1, 0, /*
599 Return non-nil if OBJECT is a face.
603 return FACEP (object) ? Qt : Qnil;
606 DEFUN ("find-face", Ffind_face, 1, 1, 0, /*
607 Retrieve the face of the given name.
608 If FACE-OR-NAME is a face object, it is simply returned.
609 Otherwise, FACE-OR-NAME should be a symbol. If there is no such face,
610 nil is returned. Otherwise the associated face object is returned.
616 if (FACEP (face_or_name))
618 CHECK_SYMBOL (face_or_name);
620 /* Check if the name represents a permanent face. */
621 retval = Fgethash (face_or_name, Vpermanent_faces_cache, Qnil);
625 /* Check if the name represents a temporary face. */
626 return Fgethash (face_or_name, Vtemporary_faces_cache, Qnil);
629 DEFUN ("get-face", Fget_face, 1, 1, 0, /*
630 Retrieve the face of the given name.
631 Same as `find-face' except an error is signalled if there is no such
632 face instead of returning nil.
636 Lisp_Object face = Ffind_face (name);
639 signal_simple_error ("No such face", name);
643 DEFUN ("face-name", Fface_name, 1, 1, 0, /*
644 Return the name of the given face.
648 return XFACE (Fget_face (face))->name;
651 DEFUN ("built-in-face-specifiers", Fbuilt_in_face_specifiers, 0, 0, 0, /*
652 Return a list of all built-in face specifier properties.
653 Don't modify this list!
657 return Vbuilt_in_face_specifiers;
660 /* These values are retrieved so often that we make a special
665 default_face_font_info (Lisp_Object domain, int *ascent, int *descent,
666 int *height, int *width, int *proportional_p)
668 Lisp_Object font_instance;
685 /* We use ASCII here. This is probably reasonable because the
686 people calling this function are using the resulting values to
687 come up with overall sizes for windows and frames. */
688 if (WINDOWP (domain))
690 struct face_cachel *cachel;
691 struct window *w = XWINDOW (domain);
693 /* #### It's possible for this function to get called when the
694 face cachels have not been initialized. I don't know why. */
695 if (!Dynarr_length (w->face_cachels))
696 reset_face_cachels (w);
697 cachel = WINDOW_FACE_CACHEL (w, DEFAULT_INDEX);
698 font_instance = FACE_CACHEL_FONT (cachel, Vcharset_ascii);
702 font_instance = FACE_FONT (Vdefault_face, domain, Vcharset_ascii);
706 *height = XFONT_INSTANCE (font_instance)->height;
708 *width = XFONT_INSTANCE (font_instance)->width;
710 *ascent = XFONT_INSTANCE (font_instance)->ascent;
712 *descent = XFONT_INSTANCE (font_instance)->descent;
714 *proportional_p = XFONT_INSTANCE (font_instance)->proportional_p;
718 default_face_height_and_width (Lisp_Object domain,
719 int *height, int *width)
721 default_face_font_info (domain, 0, 0, height, width, 0);
725 default_face_height_and_width_1 (Lisp_Object domain,
726 int *height, int *width)
728 if (window_system_pixelated_geometry (domain))
736 default_face_height_and_width (domain, height, width);
739 DEFUN ("face-list", Fface_list, 0, 1, 0, /*
740 Return a list of the names of all defined faces.
741 If TEMPORARY is nil, only the permanent faces are included.
742 If it is t, only the temporary faces are included. If it is any
743 other non-nil value both permanent and temporary are included.
747 Lisp_Object face_list = Qnil;
749 /* Added the permanent faces, if requested. */
750 if (NILP (temporary) || !EQ (Qt, temporary))
751 face_list = permanent_faces_list ();
753 if (!NILP (temporary))
757 face_list = nconc2 (face_list, temporary_faces_list ());
764 DEFUN ("make-face", Fmake_face, 1, 3, 0, /*
765 Define and return a new FACE described by DOC-STRING.
766 You can modify the font, color, etc of a face with the set-face-* functions.
767 If the face already exists, it is unmodified.
768 If TEMPORARY is non-nil, this face will cease to exist if not in use.
770 (name, doc_string, temporary))
772 /* This function can GC if initialized is non-zero */
777 if (!NILP (doc_string))
778 CHECK_STRING (doc_string);
780 face = Ffind_face (name);
784 f = allocate_face ();
788 f->doc_string = doc_string;
789 f->foreground = Fmake_specifier (Qcolor);
790 set_color_attached_to (f->foreground, face, Qforeground);
791 f->background = Fmake_specifier (Qcolor);
792 set_color_attached_to (f->background, face, Qbackground);
793 f->font = Fmake_specifier (Qfont);
794 set_font_attached_to (f->font, face, Qfont);
795 f->background_pixmap = Fmake_specifier (Qimage);
796 set_image_attached_to (f->background_pixmap, face, Qbackground_pixmap);
797 f->display_table = Fmake_specifier (Qdisplay_table);
798 f->underline = Fmake_specifier (Qface_boolean);
799 set_face_boolean_attached_to (f->underline, face, Qunderline);
800 f->strikethru = Fmake_specifier (Qface_boolean);
801 set_face_boolean_attached_to (f->strikethru, face, Qstrikethru);
802 f->highlight = Fmake_specifier (Qface_boolean);
803 set_face_boolean_attached_to (f->highlight, face, Qhighlight);
804 f->dim = Fmake_specifier (Qface_boolean);
805 set_face_boolean_attached_to (f->dim, face, Qdim);
806 f->blinking = Fmake_specifier (Qface_boolean);
807 set_face_boolean_attached_to (f->blinking, face, Qblinking);
808 f->reverse = Fmake_specifier (Qface_boolean);
809 set_face_boolean_attached_to (f->reverse, face, Qreverse);
810 if (!NILP (Vdefault_face))
812 /* If the default face has already been created, set it as
813 the default fallback specifier for all the specifiers we
814 just created. This implements the standard "all faces
815 inherit from default" behavior. */
816 set_specifier_fallback (f->foreground,
817 Fget (Vdefault_face, Qforeground, Qunbound));
818 set_specifier_fallback (f->background,
819 Fget (Vdefault_face, Qbackground, Qunbound));
820 set_specifier_fallback (f->font,
821 Fget (Vdefault_face, Qfont, Qunbound));
822 set_specifier_fallback (f->background_pixmap,
823 Fget (Vdefault_face, Qbackground_pixmap,
825 set_specifier_fallback (f->display_table,
826 Fget (Vdefault_face, Qdisplay_table, Qunbound));
827 set_specifier_fallback (f->underline,
828 Fget (Vdefault_face, Qunderline, Qunbound));
829 set_specifier_fallback (f->strikethru,
830 Fget (Vdefault_face, Qstrikethru, Qunbound));
831 set_specifier_fallback (f->highlight,
832 Fget (Vdefault_face, Qhighlight, Qunbound));
833 set_specifier_fallback (f->dim,
834 Fget (Vdefault_face, Qdim, Qunbound));
835 set_specifier_fallback (f->blinking,
836 Fget (Vdefault_face, Qblinking, Qunbound));
837 set_specifier_fallback (f->reverse,
838 Fget (Vdefault_face, Qreverse, Qunbound));
841 /* Add the face to the appropriate list. */
842 if (NILP (temporary))
843 Fputhash (name, face, Vpermanent_faces_cache);
845 Fputhash (name, face, Vtemporary_faces_cache);
847 /* Note that it's OK if we dump faces.
848 When we start up again when we're not noninteractive,
849 `init-global-faces' is called and it resources all
851 if (initialized && !noninteractive)
853 struct gcpro gcpro1, gcpro2;
856 call1 (Qinit_face_from_resources, name);
864 /*****************************************************************************
866 ****************************************************************************/
869 init_global_faces (struct device *d)
871 /* When making the initial terminal device, there is no Lisp code
872 loaded, so we can't do this. */
873 if (initialized && !noninteractive)
875 call_critical_lisp_code (d, Qinit_global_faces, Qnil);
880 init_device_faces (struct device *d)
882 /* This function can call lisp */
884 /* When making the initial terminal device, there is no Lisp code
885 loaded, so we can't do this. */
889 XSETDEVICE (tdevice, d);
890 call_critical_lisp_code (d, Qinit_device_faces, tdevice);
895 init_frame_faces (struct frame *frm)
897 /* When making the initial terminal device, there is no Lisp code
898 loaded, so we can't do this. */
902 XSETFRAME (tframe, frm);
904 /* DO NOT change the selected frame here. If the debugger goes off
905 it will try and display on the frame being created, but it is not
906 ready for that yet and a horrible death will occur. Any random
907 code depending on the selected-frame as an implicit arg should be
908 tracked down and shot. For the benefit of the one known,
909 xpm-color-symbols, make-frame sets the variable
910 Vframe_being_created to the frame it is making and sets it to nil
911 when done. Internal functions that this could trigger which are
912 currently depending on selected-frame should use this instead. It
913 is not currently visible at the lisp level. */
914 call_critical_lisp_code (XDEVICE (FRAME_DEVICE (frm)),
915 Qinit_frame_faces, tframe);
920 /****************************************************************************
921 * face cache element functions *
922 ****************************************************************************/
926 #### Here is a description of how the face cache elements ought
927 to be redone. It is *NOT* how they work currently:
929 However, when I started to go about implementing this, I realized
930 that there are all sorts of subtle problems with cache coherency
931 that are coming up. As it turns out, these problems don't
932 manifest themselves now due to the brute-force "kill 'em all"
933 approach to cache invalidation when faces change; but if this
934 is ever made smarter, these problems are going to come up, and
935 some of them are very non-obvious.
937 I'm thinking of redoing the cache code a bit to avoid these
938 coherency problems. The bulk of the problems will arise because
939 the current display structures have simple indices into the
940 face cache, but the cache can be changed at various times,
941 which could make the current display structures incorrect.
942 I guess the dirty and updated flags are an attempt to fix
943 this, but this approach doesn't really work.
945 Here's an approach that should keep things clean and unconfused:
947 1) Imagine a "virtual face cache" that can grow arbitrarily
948 big and for which the only thing allowed is to add new
949 elements. Existing elements cannot be removed or changed.
950 This way, any pointers in the existing redisplay structure
951 into the cache never get screwed up. (This is important
952 because even if a cache element is out of date, if there's
953 a pointer to it then its contents still accurately describe
954 the way the text currently looks on the screen.)
955 2) Each element in the virtual cache either describes exactly
956 one face, or describes the merger of a number of faces
957 by some process. In order to simplify things, for mergers
958 we do not record which faces or ordering was used, but
959 simply that this cache element is the result of merging.
960 Unlike the current implementation, it's important that a
961 single cache element not be used to both describe a
962 single face and describe a merger, even if all the property
964 3) Each cache element can be clean or dirty. "Dirty" means
965 that the face that the element points to has been changed;
966 this gets set at the time the face is changed. This
967 way, when looking up a value in the cache, you can determine
968 whether it's out of date or not. For merged faces it
969 does not matter -- we don't record the faces or priority
970 used to create the merger, so it's impossible to look up
971 one of these faces. We have to recompute it each time.
972 Luckily, this is fine -- doing the merge is much
973 less expensive than recomputing the properties of a
975 4) For each cache element, we keep a hash value. (In order
976 to hash the boolean properties, we convert each of them
977 into a different large prime number so that the hashing works
978 well.) This allows us, when comparing runes, to properly
979 determine whether the face for that rune has changed.
980 This will be especially important for TTY's, where there
981 aren't that many faces and minimizing redraw is very
983 5) We can't actually keep an infinite cache, but that doesn't
984 really matter that much. The only elements we care about
985 are those that are used by either the current or desired
986 display structs. Therefore, we keep a per-window
987 redisplay iteration number, and mark each element with
988 that number as we use it. Just after outputting the
989 window and synching the redisplay structs, we go through
990 the cache and invalidate all elements that are not clean
991 elements referring to a particular face and that do not
992 have an iteration number equal to the current one. We
993 keep them in a chain, and use them to allocate new
994 elements when possible instead of increasing the Dynarr.
998 /* mark for GC a dynarr of face cachels. */
1001 mark_face_cachels (face_cachel_dynarr *elements)
1008 for (elt = 0; elt < Dynarr_length (elements); elt++)
1010 struct face_cachel *cachel = Dynarr_atp (elements, elt);
1015 for (i = 0; i < NUM_LEADING_BYTES; i++)
1016 if (!NILP (cachel->font[i]) && !UNBOUNDP (cachel->font[i]))
1017 mark_object (cachel->font[i]);
1019 mark_object (cachel->face);
1020 mark_object (cachel->foreground);
1021 mark_object (cachel->background);
1022 mark_object (cachel->display_table);
1023 mark_object (cachel->background_pixmap);
1027 /* ensure that the given cachel contains an updated font value for
1028 the given charset. Return the updated font value. */
1031 ensure_face_cachel_contains_charset (struct face_cachel *cachel,
1032 Lisp_Object domain, Lisp_Object charset)
1034 Lisp_Object new_val;
1035 Lisp_Object face = cachel->face;
1037 int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1039 if (!UNBOUNDP (cachel->font[offs])
1040 && cachel->font_updated[offs])
1041 return cachel->font[offs];
1043 if (UNBOUNDP (face))
1045 /* a merged face. */
1047 struct window *w = XWINDOW (domain);
1050 cachel->font_specified[offs] = 0;
1051 for (i = 0; i < cachel->nfaces; i++)
1053 struct face_cachel *oth;
1055 oth = Dynarr_atp (w->face_cachels,
1056 FACE_CACHEL_FINDEX_UNSAFE (cachel, i));
1057 /* Tout le monde aime la recursion */
1058 ensure_face_cachel_contains_charset (oth, domain, charset);
1060 if (oth->font_specified[offs])
1062 new_val = oth->font[offs];
1063 cachel->font_specified[offs] = 1;
1068 if (!cachel->font_specified[offs])
1069 /* need to do the default face. */
1071 struct face_cachel *oth =
1072 Dynarr_atp (w->face_cachels, DEFAULT_INDEX);
1073 ensure_face_cachel_contains_charset (oth, domain, charset);
1075 new_val = oth->font[offs];
1078 if (!UNBOUNDP (cachel->font[offs]) && !EQ (cachel->font[offs], new_val))
1080 cachel->font_updated[offs] = 1;
1081 cachel->font[offs] = new_val;
1085 new_val = face_property_matching_instance (face, Qfont, charset, domain,
1086 /* #### look into ERROR_ME_NOT */
1087 ERROR_ME_NOT, 1, Qzero);
1088 if (UNBOUNDP (new_val))
1091 new_val = face_property_matching_instance (face, Qfont,
1095 ERROR_ME_NOT, 0, Qzero);
1097 if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs]))
1099 cachel->font_updated[offs] = 1;
1100 cachel->font[offs] = new_val;
1101 cachel->font_specified[offs] = (bound || EQ (face, Vdefault_face));
1105 /* Ensure that the given cachel contains updated fonts for all
1106 the charsets specified. */
1109 ensure_face_cachel_complete (struct face_cachel *cachel,
1110 Lisp_Object domain, unsigned char *charsets)
1114 for (i = 0; i < NUM_LEADING_BYTES; i++)
1117 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE);
1118 assert (CHARSETP (charset));
1119 ensure_face_cachel_contains_charset (cachel, domain, charset);
1124 face_cachel_charset_font_metric_info (struct face_cachel *cachel,
1125 unsigned char *charsets,
1126 struct font_metric_info *fm)
1131 fm->height = fm->ascent = 1;
1133 fm->proportional_p = 0;
1135 for (i = 0; i < NUM_LEADING_BYTES; i++)
1139 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE);
1140 Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset);
1141 Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance);
1143 assert (CHARSETP (charset));
1144 assert (FONT_INSTANCEP (font_instance));
1146 if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent;
1147 if (fm->descent < (int) fi->descent) fm->descent = (int) fi->descent;
1148 fm->height = fm->ascent + fm->descent;
1149 if (fi->proportional_p)
1150 fm->proportional_p = 1;
1151 if (EQ (charset, Vcharset_ascii))
1152 fm->width = fi->width;
1157 /* Called when the updated flag has been cleared on a cachel. */
1160 update_face_cachel_data (struct face_cachel *cachel,
1164 if (XFACE (face)->dirty || UNBOUNDP (cachel->face))
1166 int default_face = EQ (face, Vdefault_face);
1167 cachel->face = face;
1169 /* We normally only set the _specified flags if the value was
1170 actually bound. The exception is for the default face where
1171 we always set it since it is the ultimate fallback. */
1173 #define FROB(field) \
1175 Lisp_Object new_val = \
1176 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
1178 if (UNBOUNDP (new_val)) \
1181 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1183 if (!EQ (new_val, cachel->field)) \
1185 cachel->field = new_val; \
1186 cachel->dirty = 1; \
1188 cachel->field##_specified = (bound || default_face); \
1193 FROB (display_table);
1194 FROB (background_pixmap);
1197 * A face's background pixmap will override the face's
1198 * background color. But the background pixmap of the
1199 * default face should not override the background color of
1200 * a face if the background color has been specified or
1203 * To accomplish this we remove the background pixmap of the
1204 * cachel and mark it as having been specified so that cachel
1205 * merging won't override it later.
1208 && cachel->background_specified
1209 && ! cachel->background_pixmap_specified)
1211 cachel->background_pixmap = Qunbound;
1212 cachel->background_pixmap_specified = 1;
1217 ensure_face_cachel_contains_charset (cachel, domain, Vcharset_ascii);
1219 #define FROB(field) \
1221 Lisp_Object new_val = \
1222 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
1224 unsigned int new_val_int; \
1225 if (UNBOUNDP (new_val)) \
1228 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1230 new_val_int = EQ (new_val, Qt); \
1231 if (cachel->field != new_val_int) \
1233 cachel->field = new_val_int; \
1234 cachel->dirty = 1; \
1236 cachel->field##_specified = bound; \
1248 cachel->updated = 1;
1251 /* Merge the cachel identified by FINDEX in window W into the given
1255 merge_face_cachel_data (struct window *w, face_index findex,
1256 struct face_cachel *cachel)
1258 #define FINDEX_FIELD(field) \
1259 Dynarr_atp (w->face_cachels, findex)->field
1261 #define FROB(field) \
1263 if (!cachel->field##_specified && FINDEX_FIELD (field##_specified)) \
1265 cachel->field = FINDEX_FIELD (field); \
1266 cachel->field##_specified = 1; \
1267 cachel->dirty = 1; \
1273 FROB (display_table);
1274 FROB (background_pixmap);
1281 /* And do ASCII, of course. */
1283 int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE;
1285 if (!cachel->font_specified[offs] && FINDEX_FIELD (font_specified[offs]))
1287 cachel->font[offs] = FINDEX_FIELD (font[offs]);
1288 cachel->font_specified[offs] = 1;
1296 cachel->updated = 1;
1299 /* Initialize a cachel. */
1302 reset_face_cachel (struct face_cachel *cachel)
1305 cachel->face = Qunbound;
1307 cachel->merged_faces = 0;
1308 cachel->foreground = Qunbound;
1309 cachel->background = Qunbound;
1313 for (i = 0; i < NUM_LEADING_BYTES; i++)
1314 cachel->font[i] = Qunbound;
1316 cachel->display_table = Qunbound;
1317 cachel->background_pixmap = Qunbound;
1320 /* Add a cachel for the given face to the given window's cache. */
1323 add_face_cachel (struct window *w, Lisp_Object face)
1325 struct face_cachel new_cachel;
1328 reset_face_cachel (&new_cachel);
1329 XSETWINDOW (window, w);
1330 update_face_cachel_data (&new_cachel, window, face);
1331 Dynarr_add (w->face_cachels, new_cachel);
1334 /* Retrieve the index to a cachel for window W that corresponds to
1335 the specified face. If necessary, add a new element to the
1339 get_builtin_face_cache_index (struct window *w, Lisp_Object face)
1346 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1348 struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt);
1350 if (EQ (cachel->face, face))
1353 XSETWINDOW (window, w);
1354 if (!cachel->updated)
1355 update_face_cachel_data (cachel, window, face);
1360 /* If we didn't find the face, add it and then return its index. */
1361 add_face_cachel (w, face);
1366 reset_face_cachels (struct window *w)
1368 /* #### Not initialized in batch mode for the stream device. */
1369 if (w->face_cachels)
1373 for (i = 0; i < Dynarr_length (w->face_cachels); i++)
1375 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, i);
1376 if (cachel->merged_faces)
1377 Dynarr_free (cachel->merged_faces);
1379 Dynarr_reset (w->face_cachels);
1380 get_builtin_face_cache_index (w, Vdefault_face);
1381 get_builtin_face_cache_index (w, Vmodeline_face);
1382 XFRAME (w->frame)->window_face_cache_reset = 1;
1387 mark_face_cachels_as_clean (struct window *w)
1391 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1392 Dynarr_atp (w->face_cachels, elt)->dirty = 0;
1396 mark_face_cachels_as_not_updated (struct window *w)
1400 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1402 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt);
1405 cachel->updated = 0;
1406 for (i = 0; i < NUM_LEADING_BYTES; i++)
1407 cachel->font_updated[i] = 0;
1411 #ifdef MEMORY_USAGE_STATS
1414 compute_face_cachel_usage (face_cachel_dynarr *face_cachels,
1415 struct overhead_stats *ovstats)
1423 total += Dynarr_memory_usage (face_cachels, ovstats);
1424 for (i = 0; i < Dynarr_length (face_cachels); i++)
1426 int_dynarr *merged = Dynarr_at (face_cachels, i).merged_faces;
1428 total += Dynarr_memory_usage (merged, ovstats);
1435 #endif /* MEMORY_USAGE_STATS */
1438 /*****************************************************************************
1439 * merged face functions *
1440 *****************************************************************************/
1442 /* Compare two merged face cachels to determine whether we have to add
1443 a new entry to the face cache.
1445 Note that we do not compare the attributes, but just the faces the
1446 cachels are based on. If they are the same, then the cachels certainly
1447 ought to have the same attributes, except in the case where fonts
1448 for different charsets have been determined in the two -- and in that
1449 case this difference is fine. */
1452 compare_merged_face_cachels (struct face_cachel *cachel1,
1453 struct face_cachel *cachel2)
1457 if (!EQ (cachel1->face, cachel2->face)
1458 || cachel1->nfaces != cachel2->nfaces)
1461 for (i = 0; i < cachel1->nfaces; i++)
1462 if (FACE_CACHEL_FINDEX_UNSAFE (cachel1, i)
1463 != FACE_CACHEL_FINDEX_UNSAFE (cachel2, i))
1469 /* Retrieve the index to a cachel for window W that corresponds to
1470 the specified cachel. If necessary, add a new element to the
1471 cache. This is similar to get_builtin_face_cache_index() but
1472 is intended for merged cachels rather than for cachels representing
1475 Note that a merged cachel for just one face is not the same as
1476 the simple cachel for that face, because it is also merged with
1477 the default face. */
1480 get_merged_face_cache_index (struct window *w,
1481 struct face_cachel *merged_cachel)
1484 int cache_size = Dynarr_length (w->face_cachels);
1486 for (elt = 0; elt < cache_size; elt++)
1488 struct face_cachel *cachel =
1489 Dynarr_atp (w->face_cachels, elt);
1491 if (compare_merged_face_cachels (cachel, merged_cachel))
1495 /* We didn't find it so add this instance to the cache. */
1496 merged_cachel->updated = 1;
1497 merged_cachel->dirty = 1;
1498 Dynarr_add (w->face_cachels, *merged_cachel);
1503 get_extent_fragment_face_cache_index (struct window *w,
1504 struct extent_fragment *ef)
1506 struct face_cachel cachel;
1507 int len = Dynarr_length (ef->extents);
1508 face_index findex = 0;
1510 XSETWINDOW (window, w);
1512 /* Optimize the default case. */
1514 return DEFAULT_INDEX;
1519 /* Merge the faces of the extents together in order. */
1521 reset_face_cachel (&cachel);
1523 for (i = len - 1; i >= 0; i--)
1525 EXTENT current = Dynarr_at (ef->extents, i);
1527 Lisp_Object face = extent_face (current);
1531 findex = get_builtin_face_cache_index (w, face);
1533 merge_face_cachel_data (w, findex, &cachel);
1535 /* remember, we're called from within redisplay
1536 so we can't error. */
1537 else while (CONSP (face))
1539 Lisp_Object one_face = XCAR (face);
1540 if (FACEP (one_face))
1542 findex = get_builtin_face_cache_index (w, one_face);
1543 merge_face_cachel_data (w, findex, &cachel);
1545 /* code duplication here but there's no clean
1547 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES)
1549 if (!cachel.merged_faces)
1550 cachel.merged_faces = Dynarr_new (int);
1551 Dynarr_add (cachel.merged_faces, findex);
1554 cachel.merged_faces_static[cachel.nfaces] = findex;
1562 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES)
1564 if (!cachel.merged_faces)
1565 cachel.merged_faces = Dynarr_new (int);
1566 Dynarr_add (cachel.merged_faces, findex);
1569 cachel.merged_faces_static[cachel.nfaces] = findex;
1574 /* Now finally merge in the default face. */
1575 findex = get_builtin_face_cache_index (w, Vdefault_face);
1576 merge_face_cachel_data (w, findex, &cachel);
1578 return get_merged_face_cache_index (w, &cachel);
1583 /*****************************************************************************
1585 ****************************************************************************/
1588 update_EmacsFrame (Lisp_Object frame, Lisp_Object name)
1590 struct frame *frm = XFRAME (frame);
1592 if (EQ (name, Qfont))
1593 MARK_FRAME_SIZE_SLIPPED (frm);
1595 MAYBE_FRAMEMETH (frm, update_frame_external_traits, (frm, name));
1599 update_EmacsFrames (Lisp_Object locale, Lisp_Object name)
1601 if (FRAMEP (locale))
1603 update_EmacsFrame (locale, name);
1605 else if (DEVICEP (locale))
1607 Lisp_Object frmcons;
1609 DEVICE_FRAME_LOOP (frmcons, XDEVICE (locale))
1610 update_EmacsFrame (XCAR (frmcons), name);
1612 else if (EQ (locale, Qglobal) || EQ (locale, Qfallback))
1614 Lisp_Object frmcons, devcons, concons;
1616 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
1617 update_EmacsFrame (XCAR (frmcons), name);
1622 update_frame_face_values (struct frame *f)
1627 update_EmacsFrame (frm, Qforeground);
1628 update_EmacsFrame (frm, Qbackground);
1629 update_EmacsFrame (frm, Qfont);
1633 face_property_was_changed (Lisp_Object face, Lisp_Object property,
1636 int default_face = EQ (face, Vdefault_face);
1638 /* If the locale could affect the frame value, then call
1639 update_EmacsFrames just in case. */
1641 (EQ (property, Qforeground) ||
1642 EQ (property, Qbackground) ||
1643 EQ (property, Qfont)))
1644 update_EmacsFrames (locale, property);
1646 if (WINDOWP (locale))
1648 MARK_FRAME_FACES_CHANGED (XFRAME (XWINDOW (locale)->frame));
1650 else if (FRAMEP (locale))
1652 MARK_FRAME_FACES_CHANGED (XFRAME (locale));
1654 else if (DEVICEP (locale))
1656 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (locale));
1660 Lisp_Object devcons, concons;
1661 DEVICE_LOOP_NO_BREAK (devcons, concons)
1662 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (XCAR (devcons)));
1666 * This call to update_faces_inheritance isn't needed and makes
1667 * creating and modifying faces _very_ slow. The point of
1668 * update_face_inheritances is to find all faces that inherit
1669 * directly from this face property and set the specifier "dirty"
1670 * flag on the corresponding specifier. This forces recaching of
1671 * cached specifier values in frame and window struct slots. But
1672 * currently no face properties are cached in frame and window
1673 * struct slots, so calling this function does nothing useful!
1675 * Further, since update_faces_inheritance maps over the whole
1676 * face table every time it is called, it gets terribly slow when
1677 * there are many faces. Creating 500 faces on a 50Mhz 486 took
1678 * 433 seconds when update_faces_inheritance was called. With the
1679 * call commented out, creating those same 500 faces took 0.72
1682 /* update_faces_inheritance (face, property);*/
1683 XFACE (face)->dirty = 1;
1686 DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /*
1687 Define and return a new face which is a copy of an existing one,
1688 or makes an already-existing face be exactly like another.
1689 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'.
1691 (old_face, new_name, locale, tag_set, exact_p, how_to_add))
1693 Lisp_Face *fold, *fnew;
1694 Lisp_Object new_face = Qnil;
1695 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1697 old_face = Fget_face (old_face);
1699 /* We GCPRO old_face because it might be temporary, and GCing could
1700 occur in various places below. */
1701 GCPRO4 (tag_set, locale, old_face, new_face);
1702 /* check validity of how_to_add now. */
1703 decode_how_to_add_specification (how_to_add);
1704 /* and of tag_set. */
1705 tag_set = decode_specifier_tag_set (tag_set);
1706 /* and of locale. */
1707 locale = decode_locale_list (locale);
1709 new_face = Ffind_face (new_name);
1710 if (NILP (new_face))
1714 CHECK_SYMBOL (new_name);
1716 /* Create the new face with the same status as the old face. */
1717 temp = (NILP (Fgethash (old_face, Vtemporary_faces_cache, Qnil))
1721 new_face = Fmake_face (new_name, Qnil, temp);
1724 fold = XFACE (old_face);
1725 fnew = XFACE (new_face);
1727 #define COPY_PROPERTY(property) \
1728 Fcopy_specifier (fold->property, fnew->property, \
1729 locale, tag_set, exact_p, how_to_add);
1731 COPY_PROPERTY (foreground);
1732 COPY_PROPERTY (background);
1733 COPY_PROPERTY (font);
1734 COPY_PROPERTY (display_table);
1735 COPY_PROPERTY (background_pixmap);
1736 COPY_PROPERTY (underline);
1737 COPY_PROPERTY (strikethru);
1738 COPY_PROPERTY (highlight);
1739 COPY_PROPERTY (dim);
1740 COPY_PROPERTY (blinking);
1741 COPY_PROPERTY (reverse);
1742 #undef COPY_PROPERTY
1743 /* #### should it copy the individual specifiers, if they exist? */
1744 fnew->plist = Fcopy_sequence (fold->plist);
1753 syms_of_faces (void)
1755 /* Qdefault, Qwidget, Qleft_margin, Qright_margin defined in general.c */
1756 defsymbol (&Qmodeline, "modeline");
1757 defsymbol (&Qgui_element, "gui-element");
1758 defsymbol (&Qtext_cursor, "text-cursor");
1759 defsymbol (&Qvertical_divider, "vertical-divider");
1762 DEFSUBR (Ffind_face);
1763 DEFSUBR (Fget_face);
1764 DEFSUBR (Fface_name);
1765 DEFSUBR (Fbuilt_in_face_specifiers);
1766 DEFSUBR (Fface_list);
1767 DEFSUBR (Fmake_face);
1768 DEFSUBR (Fcopy_face);
1770 defsymbol (&Qfacep, "facep");
1771 defsymbol (&Qforeground, "foreground");
1772 defsymbol (&Qbackground, "background");
1773 /* Qfont defined in general.c */
1774 defsymbol (&Qdisplay_table, "display-table");
1775 defsymbol (&Qbackground_pixmap, "background-pixmap");
1776 defsymbol (&Qunderline, "underline");
1777 defsymbol (&Qstrikethru, "strikethru");
1778 /* Qhighlight, Qreverse defined in general.c */
1779 defsymbol (&Qdim, "dim");
1780 defsymbol (&Qblinking, "blinking");
1782 defsymbol (&Qinit_face_from_resources, "init-face-from-resources");
1783 defsymbol (&Qinit_global_faces, "init-global-faces");
1784 defsymbol (&Qinit_device_faces, "init-device-faces");
1785 defsymbol (&Qinit_frame_faces, "init-frame-faces");
1789 structure_type_create_faces (void)
1791 struct structure_type *st;
1793 st = define_structure_type (Qface, face_validate, face_instantiate);
1795 define_structure_type_keyword (st, Qname, face_name_validate);
1799 vars_of_faces (void)
1801 staticpro (&Vpermanent_faces_cache);
1802 Vpermanent_faces_cache = Qnil;
1803 staticpro (&Vtemporary_faces_cache);
1804 Vtemporary_faces_cache = Qnil;
1806 staticpro (&Vdefault_face);
1807 Vdefault_face = Qnil;
1808 staticpro (&Vgui_element_face);
1809 Vgui_element_face = Qnil;
1810 staticpro (&Vwidget_face);
1811 Vwidget_face = Qnil;
1812 staticpro (&Vmodeline_face);
1813 Vmodeline_face = Qnil;
1814 staticpro (&Vtoolbar_face);
1815 Vtoolbar_face = Qnil;
1817 staticpro (&Vvertical_divider_face);
1818 Vvertical_divider_face = Qnil;
1819 staticpro (&Vleft_margin_face);
1820 Vleft_margin_face = Qnil;
1821 staticpro (&Vright_margin_face);
1822 Vright_margin_face = Qnil;
1823 staticpro (&Vtext_cursor_face);
1824 Vtext_cursor_face = Qnil;
1825 staticpro (&Vpointer_face);
1826 Vpointer_face = Qnil;
1829 Lisp_Object syms[20];
1832 syms[n++] = Qforeground;
1833 syms[n++] = Qbackground;
1835 syms[n++] = Qdisplay_table;
1836 syms[n++] = Qbackground_pixmap;
1837 syms[n++] = Qunderline;
1838 syms[n++] = Qstrikethru;
1839 syms[n++] = Qhighlight;
1841 syms[n++] = Qblinking;
1842 syms[n++] = Qreverse;
1844 Vbuilt_in_face_specifiers = Flist (n, syms);
1845 staticpro (&Vbuilt_in_face_specifiers);
1850 complex_vars_of_faces (void)
1852 Vpermanent_faces_cache =
1853 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
1854 Vtemporary_faces_cache =
1855 make_lisp_hash_table (0, HASH_TABLE_WEAK, HASH_TABLE_EQ);
1857 /* Create the default face now so we know what it is immediately. */
1859 Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus
1861 Vdefault_face = Fmake_face (Qdefault, build_string ("default face"),
1864 /* Provide some last-resort fallbacks to avoid utter fuckage if
1865 someone provides invalid values for the global specifications. */
1868 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1870 #ifdef HAVE_X_WINDOWS
1871 fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
1872 bg_fb = acons (list1 (Qx), build_string ("white"), bg_fb);
1875 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1876 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1878 #ifdef HAVE_MS_WINDOWS
1879 fg_fb = acons (list1 (Qmsprinter), build_string ("black"), fg_fb);
1880 bg_fb = acons (list1 (Qmsprinter), build_string ("white"), bg_fb);
1881 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1882 bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb);
1884 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb);
1885 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb);
1888 /* #### We may want to have different fallback values if NeXTstep
1889 support is compiled in. */
1891 Lisp_Object inst_list = Qnil;
1892 #ifdef HAVE_X_WINDOWS
1893 /* The same gory list from x-faces.el.
1894 (#### Perhaps we should remove the stuff from x-faces.el
1895 and only depend on this stuff here? That should work.)
1897 const char *fonts[] =
1899 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
1900 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
1901 "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*",
1902 "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*",
1903 "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*",
1904 "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*",
1905 "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*",
1906 "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*",
1907 "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*",
1908 "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*",
1909 "-*-*-*-r-*-*-*-120-*-*-m-*-*-*",
1910 "-*-*-*-r-*-*-*-120-*-*-c-*-*-*",
1911 "-*-*-*-r-*-*-*-120-*-*-*-*-*-*",
1912 "-*-*-*-*-*-*-*-120-*-*-*-*-*-*",
1915 const char **fontptr;
1917 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--)
1918 inst_list = Fcons (Fcons (list1 (Qx), build_string (*fontptr)),
1920 #endif /* HAVE_X_WINDOWS */
1923 inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")),
1925 #endif /* HAVE_TTY */
1926 #ifdef HAVE_MS_WINDOWS
1927 /* Fixedsys does not exist for printers */
1928 inst_list = Fcons (Fcons (list1 (Qmsprinter),
1929 build_string ("Courier:Regular:10::Western")), inst_list);
1930 inst_list = Fcons (Fcons (list1 (Qmsprinter),
1931 build_string ("Courier New:Regular:10::Western")), inst_list);
1933 inst_list = Fcons (Fcons (list1 (Qmswindows),
1934 build_string ("Fixedsys:Regular:9::Western")), inst_list);
1935 inst_list = Fcons (Fcons (list1 (Qmswindows),
1936 build_string ("Courier:Regular:10::Western")), inst_list);
1937 inst_list = Fcons (Fcons (list1 (Qmswindows),
1938 build_string ("Courier New:Regular:10::Western")), inst_list);
1939 #endif /* HAVE_MS_WINDOWS */
1940 set_specifier_fallback (Fget (Vdefault_face, Qfont, Qnil), inst_list);
1943 set_specifier_fallback (Fget (Vdefault_face, Qunderline, Qnil),
1944 list1 (Fcons (Qnil, Qnil)));
1945 set_specifier_fallback (Fget (Vdefault_face, Qstrikethru, Qnil),
1946 list1 (Fcons (Qnil, Qnil)));
1947 set_specifier_fallback (Fget (Vdefault_face, Qhighlight, Qnil),
1948 list1 (Fcons (Qnil, Qnil)));
1949 set_specifier_fallback (Fget (Vdefault_face, Qdim, Qnil),
1950 list1 (Fcons (Qnil, Qnil)));
1951 set_specifier_fallback (Fget (Vdefault_face, Qblinking, Qnil),
1952 list1 (Fcons (Qnil, Qnil)));
1953 set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil),
1954 list1 (Fcons (Qnil, Qnil)));
1956 /* gui-element is the parent face of all gui elements such as
1957 modeline, vertical divider and toolbar. */
1958 Vgui_element_face = Fmake_face (Qgui_element,
1959 build_string ("gui element face"),
1962 /* Provide some last-resort fallbacks for gui-element face which
1963 mustn't default to default. */
1965 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1967 #ifdef HAVE_X_WINDOWS
1968 fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
1969 bg_fb = acons (list1 (Qx), build_string ("Gray80"), bg_fb);
1972 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1973 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1975 #ifdef HAVE_MS_WINDOWS
1976 fg_fb = acons (list1 (Qmsprinter), build_string ("black"), fg_fb);
1977 bg_fb = acons (list1 (Qmsprinter), build_string ("white"), bg_fb);
1978 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1979 bg_fb = acons (list1 (Qmswindows), build_string ("Gray75"), bg_fb);
1981 set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb);
1982 set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb);
1985 /* Now create the other faces that redisplay needs to refer to
1986 directly. We could create them in Lisp but it's simpler this
1987 way since we need to get them anyway. */
1989 /* modeline is gui element. */
1990 Vmodeline_face = Fmake_face (Qmodeline, build_string ("modeline face"),
1993 set_specifier_fallback (Fget (Vmodeline_face, Qforeground, Qunbound),
1994 Fget (Vgui_element_face, Qforeground, Qunbound));
1995 set_specifier_fallback (Fget (Vmodeline_face, Qbackground, Qunbound),
1996 Fget (Vgui_element_face, Qbackground, Qunbound));
1997 set_specifier_fallback (Fget (Vmodeline_face, Qbackground_pixmap, Qnil),
1998 Fget (Vgui_element_face, Qbackground_pixmap,
2001 /* toolbar is another gui element */
2002 Vtoolbar_face = Fmake_face (Qtoolbar,
2003 build_string ("toolbar face"),
2005 set_specifier_fallback (Fget (Vtoolbar_face, Qforeground, Qunbound),
2006 Fget (Vgui_element_face, Qforeground, Qunbound));
2007 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground, Qunbound),
2008 Fget (Vgui_element_face, Qbackground, Qunbound));
2009 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_pixmap, Qnil),
2010 Fget (Vgui_element_face, Qbackground_pixmap,
2013 /* vertical divider is another gui element */
2014 Vvertical_divider_face = Fmake_face (Qvertical_divider,
2015 build_string ("vertical divider face"),
2018 set_specifier_fallback (Fget (Vvertical_divider_face, Qforeground, Qunbound),
2019 Fget (Vgui_element_face, Qforeground, Qunbound));
2020 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground, Qunbound),
2021 Fget (Vgui_element_face, Qbackground, Qunbound));
2022 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground_pixmap,
2024 Fget (Vgui_element_face, Qbackground_pixmap,
2027 /* widget is another gui element */
2028 Vwidget_face = Fmake_face (Qwidget,
2029 build_string ("widget face"),
2031 set_specifier_fallback (Fget (Vwidget_face, Qforeground, Qunbound),
2032 Fget (Vgui_element_face, Qforeground, Qunbound));
2033 set_specifier_fallback (Fget (Vwidget_face, Qbackground, Qunbound),
2034 Fget (Vgui_element_face, Qbackground, Qunbound));
2035 set_specifier_fallback (Fget (Vwidget_face, Qbackground_pixmap, Qnil),
2036 Fget (Vgui_element_face, Qbackground_pixmap,
2039 Vleft_margin_face = Fmake_face (Qleft_margin,
2040 build_string ("left margin face"),
2042 Vright_margin_face = Fmake_face (Qright_margin,
2043 build_string ("right margin face"),
2045 Vtext_cursor_face = Fmake_face (Qtext_cursor,
2046 build_string ("face for text cursor"),
2049 Fmake_face (Qpointer,
2051 ("face for foreground/background colors of mouse pointer"),