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. */
41 #include "specifier.h"
45 Lisp_Object Qforeground, Qbackground, Qdisplay_table;
46 Lisp_Object Qbackground_pixmap, Qunderline, Qdim;
47 Lisp_Object Qblinking, Qstrikethru;
49 Lisp_Object Qinit_face_from_resources;
50 Lisp_Object Qinit_frame_faces;
51 Lisp_Object Qinit_device_faces;
52 Lisp_Object Qinit_global_faces;
54 /* These faces are used directly internally. We use these variables
55 to be able to reference them directly and save the overhead of
56 calling Ffind_face. */
57 Lisp_Object Vdefault_face, Vmodeline_face, Vgui_element_face;
58 Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face;
59 Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face;
61 /* Qdefault, Qhighlight defined in general.c */
62 Lisp_Object Qmodeline, Qgui_element, Qleft_margin, Qright_margin, Qtext_cursor;
63 Lisp_Object Qvertical_divider;
65 /* In the old implementation Vface_list was a list of the face names,
66 not the faces themselves. We now distinguish between permanent and
67 temporary faces. Permanent faces are kept in a regular hash table,
68 temporary faces in a weak hash table. */
69 Lisp_Object Vpermanent_faces_cache;
70 Lisp_Object Vtemporary_faces_cache;
72 Lisp_Object Vbuilt_in_face_specifiers;
77 mark_face (Lisp_Object obj, void (*markobj) (Lisp_Object))
79 struct Lisp_Face *face = XFACE (obj);
81 ((markobj) (face->name));
82 ((markobj) (face->doc_string));
84 ((markobj) (face->foreground));
85 ((markobj) (face->background));
86 ((markobj) (face->font));
87 ((markobj) (face->display_table));
88 ((markobj) (face->background_pixmap));
89 ((markobj) (face->underline));
90 ((markobj) (face->strikethru));
91 ((markobj) (face->highlight));
92 ((markobj) (face->dim));
93 ((markobj) (face->blinking));
94 ((markobj) (face->reverse));
96 ((markobj) (face->charsets_warned_about));
102 print_face (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
104 struct Lisp_Face *face = XFACE (obj);
108 write_c_string ("#s(face name ", printcharfun);
109 print_internal (face->name, printcharfun, 1);
110 write_c_string (")", printcharfun);
114 write_c_string ("#<face ", printcharfun);
115 print_internal (face->name, printcharfun, 1);
116 if (!NILP (face->doc_string))
118 write_c_string (" ", printcharfun);
119 print_internal (face->doc_string, printcharfun, 1);
121 write_c_string (">", printcharfun);
125 /* Faces are equal if all of their display attributes are equal. We
126 don't compare names or doc-strings, because that would make equal
129 This isn't concerned with "unspecified" attributes, that's what
130 #'face-differs-from-default-p is for. */
132 face_equal (Lisp_Object o1, Lisp_Object o2, int depth)
134 struct Lisp_Face *f1 = XFACE (o1);
135 struct Lisp_Face *f2 = XFACE (o2);
140 (internal_equal (f1->foreground, f2->foreground, depth) &&
141 internal_equal (f1->background, f2->background, depth) &&
142 internal_equal (f1->font, f2->font, depth) &&
143 internal_equal (f1->display_table, f2->display_table, depth) &&
144 internal_equal (f1->background_pixmap, f2->background_pixmap, depth) &&
145 internal_equal (f1->underline, f2->underline, depth) &&
146 internal_equal (f1->strikethru, f2->strikethru, depth) &&
147 internal_equal (f1->highlight, f2->highlight, depth) &&
148 internal_equal (f1->dim, f2->dim, depth) &&
149 internal_equal (f1->blinking, f2->blinking, depth) &&
150 internal_equal (f1->reverse, f2->reverse, depth) &&
152 ! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1));
156 face_hash (Lisp_Object obj, int depth)
158 struct Lisp_Face *f = XFACE (obj);
162 /* No need to hash all of the elements; that would take too long.
163 Just hash the most common ones. */
164 return HASH3 (internal_hash (f->foreground, depth),
165 internal_hash (f->background, depth),
166 internal_hash (f->font, depth));
170 face_getprop (Lisp_Object obj, Lisp_Object prop)
172 struct Lisp_Face *f = XFACE (obj);
175 ((EQ (prop, Qforeground)) ? f->foreground :
176 (EQ (prop, Qbackground)) ? f->background :
177 (EQ (prop, Qfont)) ? f->font :
178 (EQ (prop, Qdisplay_table)) ? f->display_table :
179 (EQ (prop, Qbackground_pixmap)) ? f->background_pixmap :
180 (EQ (prop, Qunderline)) ? f->underline :
181 (EQ (prop, Qstrikethru)) ? f->strikethru :
182 (EQ (prop, Qhighlight)) ? f->highlight :
183 (EQ (prop, Qdim)) ? f->dim :
184 (EQ (prop, Qblinking)) ? f->blinking :
185 (EQ (prop, Qreverse)) ? f->reverse :
186 (EQ (prop, Qdoc_string)) ? f->doc_string :
187 external_plist_get (&f->plist, prop, 0, ERROR_ME));
191 face_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
193 struct Lisp_Face *f = XFACE (obj);
195 if (EQ (prop, Qforeground) ||
196 EQ (prop, Qbackground) ||
198 EQ (prop, Qdisplay_table) ||
199 EQ (prop, Qbackground_pixmap) ||
200 EQ (prop, Qunderline) ||
201 EQ (prop, Qstrikethru) ||
202 EQ (prop, Qhighlight) ||
204 EQ (prop, Qblinking) ||
208 if (EQ (prop, Qdoc_string))
211 CHECK_STRING (value);
212 f->doc_string = value;
216 external_plist_put (&f->plist, prop, value, 0, ERROR_ME);
221 face_remprop (Lisp_Object obj, Lisp_Object prop)
223 struct Lisp_Face *f = XFACE (obj);
225 if (EQ (prop, Qforeground) ||
226 EQ (prop, Qbackground) ||
228 EQ (prop, Qdisplay_table) ||
229 EQ (prop, Qbackground_pixmap) ||
230 EQ (prop, Qunderline) ||
231 EQ (prop, Qstrikethru) ||
232 EQ (prop, Qhighlight) ||
234 EQ (prop, Qblinking) ||
238 if (EQ (prop, Qdoc_string))
240 f->doc_string = Qnil;
244 return external_remprop (&f->plist, prop, 0, ERROR_ME);
248 face_plist (Lisp_Object obj)
250 struct Lisp_Face *face = XFACE (obj);
251 Lisp_Object result = face->plist;
253 result = cons3 (Qreverse, face->reverse, result);
254 result = cons3 (Qblinking, face->blinking, result);
255 result = cons3 (Qdim, face->dim, result);
256 result = cons3 (Qhighlight, face->highlight, result);
257 result = cons3 (Qstrikethru, face->strikethru, result);
258 result = cons3 (Qunderline, face->underline, result);
259 result = cons3 (Qbackground_pixmap, face->background_pixmap, result);
260 result = cons3 (Qdisplay_table, face->display_table, result);
261 result = cons3 (Qfont, face->font, result);
262 result = cons3 (Qbackground, face->background, result);
263 result = cons3 (Qforeground, face->foreground, result);
268 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face,
269 mark_face, print_face, 0, face_equal,
270 face_hash, face_getprop,
271 face_putprop, face_remprop,
272 face_plist, struct Lisp_Face);
274 /************************************************************************/
275 /* face read syntax */
276 /************************************************************************/
279 face_name_validate (Lisp_Object keyword, Lisp_Object value,
282 if (ERRB_EQ (errb, ERROR_ME))
284 CHECK_SYMBOL (value);
288 return SYMBOLP (value);
292 face_validate (Lisp_Object data, Error_behavior errb)
295 Lisp_Object valw = Qnil;
297 data = Fcdr (data); /* skip over Qface */
300 Lisp_Object keyw = Fcar (data);
305 if (EQ (keyw, Qname))
313 maybe_error (Qface, errb, "No face name given");
317 if (NILP (Ffind_face (valw)))
319 maybe_signal_simple_error ("No such face", valw, Qface, errb);
327 face_instantiate (Lisp_Object data)
329 return Fget_face (Fcar (Fcdr (data)));
333 /****************************************************************************
334 * utility functions *
335 ****************************************************************************/
338 reset_face (struct Lisp_Face *f)
341 f->doc_string = Qnil;
343 f->foreground = Qnil;
344 f->background = Qnil;
346 f->display_table = Qnil;
347 f->background_pixmap = Qnil;
349 f->strikethru = Qnil;
355 f->charsets_warned_about = Qnil;
358 static struct Lisp_Face *
361 struct Lisp_Face *result =
362 alloc_lcrecord_type (struct Lisp_Face, lrecord_face);
369 /* We store the faces in hash tables with the names as the key and the
370 actual face object as the value. Occasionally we need to use them
371 in a list format. These routines provide us with that. */
372 struct face_list_closure
374 Lisp_Object *face_list;
378 add_face_to_list_mapper (CONST void *hash_key, void *hash_contents,
379 void *face_list_closure)
381 /* This function can GC */
382 Lisp_Object key, contents;
383 Lisp_Object *face_list;
384 struct face_list_closure *fcl =
385 (struct face_list_closure *) face_list_closure;
386 CVOID_TO_LISP (key, hash_key);
387 VOID_TO_LISP (contents, hash_contents);
388 face_list = fcl->face_list;
390 *face_list = Fcons (XFACE (contents)->name, *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 (CONST void *hash_key, void *hash_contents,
426 /* This function can GC */
427 Lisp_Object key, contents;
428 int *flag = (int *) flag_closure;
429 CVOID_TO_LISP (key, hash_key);
430 VOID_TO_LISP (contents, hash_contents);
431 XFACE (contents)->dirty = *flag;
436 mark_all_faces_internal (int flag)
438 elisp_maphash (mark_face_as_clean_mapper, Vpermanent_faces_cache, &flag);
439 elisp_maphash (mark_face_as_clean_mapper, Vtemporary_faces_cache, &flag);
443 mark_all_faces_as_clean (void)
445 mark_all_faces_internal (0);
448 /* Currently unused (see the comment in face_property_was_changed()). */
450 /* #### OBSOLETE ME, PLEASE. Maybe. Maybe this is just as good as
451 any other solution. */
452 struct face_inheritance_closure
455 Lisp_Object property;
459 update_inheritance_mapper_internal (Lisp_Object cur_face,
460 Lisp_Object inh_face,
461 Lisp_Object property)
463 /* #### fix this function */
464 Lisp_Object elt = Qnil;
469 for (elt = FACE_PROPERTY_SPEC_LIST (cur_face, property, Qall);
473 Lisp_Object values = XCDR (XCAR (elt));
475 for (; !NILP (values); values = XCDR (values))
477 Lisp_Object value = XCDR (XCAR (values));
478 if (VECTORP (value) && XVECTOR_LENGTH (value))
480 if (EQ (Ffind_face (XVECTOR_DATA (value)[0]), inh_face))
481 Fset_specifier_dirty_flag
482 (FACE_PROPERTY_SPECIFIER (inh_face, property));
491 update_face_inheritance_mapper (CONST void *hash_key, void *hash_contents,
492 void *face_inheritance_closure)
494 Lisp_Object key, contents;
495 struct face_inheritance_closure *fcl =
496 (struct face_inheritance_closure *) face_inheritance_closure;
498 CVOID_TO_LISP (key, hash_key);
499 VOID_TO_LISP (contents, hash_contents);
501 if (EQ (fcl->property, Qfont))
503 update_inheritance_mapper_internal (contents, fcl->face, Qfont);
505 else if (EQ (fcl->property, Qforeground) ||
506 EQ (fcl->property, Qbackground))
508 update_inheritance_mapper_internal (contents, fcl->face, Qforeground);
509 update_inheritance_mapper_internal (contents, fcl->face, Qbackground);
511 else if (EQ (fcl->property, Qunderline) ||
512 EQ (fcl->property, Qstrikethru) ||
513 EQ (fcl->property, Qhighlight) ||
514 EQ (fcl->property, Qdim) ||
515 EQ (fcl->property, Qblinking) ||
516 EQ (fcl->property, Qreverse))
518 update_inheritance_mapper_internal (contents, fcl->face, Qunderline);
519 update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru);
520 update_inheritance_mapper_internal (contents, fcl->face, Qhighlight);
521 update_inheritance_mapper_internal (contents, fcl->face, Qdim);
522 update_inheritance_mapper_internal (contents, fcl->face, Qblinking);
523 update_inheritance_mapper_internal (contents, fcl->face, Qreverse);
529 update_faces_inheritance (Lisp_Object face, Lisp_Object property)
531 struct face_inheritance_closure face_inheritance_closure;
532 struct gcpro gcpro1, gcpro2;
534 GCPRO2 (face, property);
535 face_inheritance_closure.face = face;
536 face_inheritance_closure.property = property;
538 elisp_maphash (update_face_inheritance_mapper, Vpermanent_faces_cache,
539 &face_inheritance_closure);
540 elisp_maphash (update_face_inheritance_mapper, Vtemporary_faces_cache,
541 &face_inheritance_closure);
548 face_property_matching_instance (Lisp_Object face, Lisp_Object property,
549 Lisp_Object charset, Lisp_Object domain,
550 Error_behavior errb, int no_fallback,
554 specifier_instance_no_quit (Fget (face, property, Qnil), charset,
555 domain, errb, no_fallback, depth);
557 if (UNBOUNDP (retval) && !no_fallback)
559 if (EQ (property, Qfont))
561 if (NILP (memq_no_quit (charset,
562 XFACE (face)->charsets_warned_about)))
565 if (! UNBOUNDP (charset))
568 "Unable to instantiate font for face %s, charset %s",
569 string_data (symbol_name
570 (XSYMBOL (XFACE (face)->name))),
571 string_data (symbol_name
572 (XSYMBOL (XCHARSET_NAME (charset)))));
575 warn_when_safe (Qfont, Qwarning,
576 "Unable to instantiate font for face %s",
577 string_data (symbol_name
578 (XSYMBOL (XFACE (face)->name))));
579 XFACE (face)->charsets_warned_about =
580 Fcons (charset, XFACE (face)->charsets_warned_about);
582 retval = Vthe_null_font_instance;
590 DEFUN ("facep", Ffacep, 1, 1, 0, /*
591 Return non-nil if OBJECT is a face.
595 return FACEP (object) ? Qt : Qnil;
598 DEFUN ("find-face", Ffind_face, 1, 1, 0, /*
599 Retrieve the face of the given name.
600 If FACE-OR-NAME is a face object, it is simply returned.
601 Otherwise, FACE-OR-NAME should be a symbol. If there is no such face,
602 nil is returned. Otherwise the associated face object is returned.
608 if (FACEP (face_or_name))
610 CHECK_SYMBOL (face_or_name);
612 /* Check if the name represents a permanent face. */
613 retval = Fgethash (face_or_name, Vpermanent_faces_cache, Qnil);
617 /* Check if the name represents a temporary face. */
618 return Fgethash (face_or_name, Vtemporary_faces_cache, Qnil);
621 DEFUN ("get-face", Fget_face, 1, 1, 0, /*
622 Retrieve the face of the given name.
623 Same as `find-face' except an error is signalled if there is no such
624 face instead of returning nil.
628 Lisp_Object face = Ffind_face (name);
631 signal_simple_error ("No such face", name);
635 DEFUN ("face-name", Fface_name, 1, 1, 0, /*
636 Return the name of the given face.
640 return XFACE (Fget_face (face))->name;
643 DEFUN ("built-in-face-specifiers", Fbuilt_in_face_specifiers, 0, 0, 0, /*
644 Return a list of all built-in face specifier properties.
645 Don't modify this list!
649 return Vbuilt_in_face_specifiers;
652 /* These values are retrieved so often that we make a special
657 default_face_font_info (Lisp_Object domain, int *ascent, int *descent,
658 int *height, int *width, int *proportional_p)
660 Lisp_Object font_instance;
677 /* We use ASCII here. This is probably reasonable because the
678 people calling this function are using the resulting values to
679 come up with overall sizes for windows and frames. */
680 if (WINDOWP (domain))
682 struct face_cachel *cachel;
683 struct window *w = XWINDOW (domain);
685 /* #### It's possible for this function to get called when the
686 face cachels have not been initialized. I don't know why. */
687 if (!Dynarr_length (w->face_cachels))
688 reset_face_cachels (w);
689 cachel = WINDOW_FACE_CACHEL (w, DEFAULT_INDEX);
690 font_instance = FACE_CACHEL_FONT (cachel, Vcharset_ascii);
694 font_instance = FACE_FONT (Vdefault_face, domain, Vcharset_ascii);
698 *height = XFONT_INSTANCE (font_instance)->height;
700 *width = XFONT_INSTANCE (font_instance)->width;
702 *ascent = XFONT_INSTANCE (font_instance)->ascent;
704 *descent = XFONT_INSTANCE (font_instance)->descent;
706 *proportional_p = XFONT_INSTANCE (font_instance)->proportional_p;
710 default_face_height_and_width (Lisp_Object domain,
711 int *height, int *width)
713 default_face_font_info (domain, 0, 0, height, width, 0);
717 default_face_height_and_width_1 (Lisp_Object domain,
718 int *height, int *width)
720 if (window_system_pixelated_geometry (domain))
728 default_face_height_and_width (domain, height, width);
731 DEFUN ("face-list", Fface_list, 0, 1, 0, /*
732 Return a list of the names of all defined faces.
733 If TEMPORARY is nil, only the permanent faces are included.
734 If it is t, only the temporary faces are included. If it is any
735 other non-nil value both permanent and temporary are included.
739 Lisp_Object face_list = Qnil;
741 /* Added the permanent faces, if requested. */
742 if (NILP (temporary) || !EQ (Qt, temporary))
743 face_list = permanent_faces_list ();
745 if (!NILP (temporary))
749 face_list = nconc2 (face_list, temporary_faces_list ());
756 DEFUN ("make-face", Fmake_face, 1, 3, 0, /*
757 Define and return a new FACE described by DOC-STRING.
758 You can modify the font, color, etc of a face with the set-face-* functions.
759 If the face already exists, it is unmodified.
760 If TEMPORARY is non-nil, this face will cease to exist if not in use.
762 (name, doc_string, temporary))
764 /* This function can GC if initialized is non-zero */
769 if (!NILP (doc_string))
770 CHECK_STRING (doc_string);
772 face = Ffind_face (name);
776 f = allocate_face ();
780 f->doc_string = doc_string;
781 f->foreground = Fmake_specifier (Qcolor);
782 set_color_attached_to (f->foreground, face, Qforeground);
783 f->background = Fmake_specifier (Qcolor);
784 set_color_attached_to (f->background, face, Qbackground);
785 f->font = Fmake_specifier (Qfont);
786 set_font_attached_to (f->font, face, Qfont);
787 f->background_pixmap = Fmake_specifier (Qimage);
788 set_image_attached_to (f->background_pixmap, face, Qbackground_pixmap);
789 f->display_table = Fmake_specifier (Qdisplay_table);
790 f->underline = Fmake_specifier (Qface_boolean);
791 set_face_boolean_attached_to (f->underline, face, Qunderline);
792 f->strikethru = Fmake_specifier (Qface_boolean);
793 set_face_boolean_attached_to (f->strikethru, face, Qstrikethru);
794 f->highlight = Fmake_specifier (Qface_boolean);
795 set_face_boolean_attached_to (f->highlight, face, Qhighlight);
796 f->dim = Fmake_specifier (Qface_boolean);
797 set_face_boolean_attached_to (f->dim, face, Qdim);
798 f->blinking = Fmake_specifier (Qface_boolean);
799 set_face_boolean_attached_to (f->blinking, face, Qblinking);
800 f->reverse = Fmake_specifier (Qface_boolean);
801 set_face_boolean_attached_to (f->reverse, face, Qreverse);
802 if (!NILP (Vdefault_face))
804 /* If the default face has already been created, set it as
805 the default fallback specifier for all the specifiers we
806 just created. This implements the standard "all faces
807 inherit from default" behavior. */
808 set_specifier_fallback (f->foreground,
809 Fget (Vdefault_face, Qforeground, Qunbound));
810 set_specifier_fallback (f->background,
811 Fget (Vdefault_face, Qbackground, Qunbound));
812 set_specifier_fallback (f->font,
813 Fget (Vdefault_face, Qfont, Qunbound));
814 set_specifier_fallback (f->background_pixmap,
815 Fget (Vdefault_face, Qbackground_pixmap,
817 set_specifier_fallback (f->display_table,
818 Fget (Vdefault_face, Qdisplay_table, Qunbound));
819 set_specifier_fallback (f->underline,
820 Fget (Vdefault_face, Qunderline, Qunbound));
821 set_specifier_fallback (f->strikethru,
822 Fget (Vdefault_face, Qstrikethru, Qunbound));
823 set_specifier_fallback (f->highlight,
824 Fget (Vdefault_face, Qhighlight, Qunbound));
825 set_specifier_fallback (f->dim,
826 Fget (Vdefault_face, Qdim, Qunbound));
827 set_specifier_fallback (f->blinking,
828 Fget (Vdefault_face, Qblinking, Qunbound));
829 set_specifier_fallback (f->reverse,
830 Fget (Vdefault_face, Qreverse, Qunbound));
833 /* Add the face to the appropriate list. */
834 if (NILP (temporary))
835 Fputhash (name, face, Vpermanent_faces_cache);
837 Fputhash (name, face, Vtemporary_faces_cache);
839 /* Note that it's OK if we dump faces.
840 When we start up again when we're not noninteractive,
841 `init-global-faces' is called and it resources all
843 if (initialized && !noninteractive)
845 struct gcpro gcpro1, gcpro2;
848 call1 (Qinit_face_from_resources, name);
856 /*****************************************************************************
858 ****************************************************************************/
861 init_global_faces (struct device *d)
863 /* When making the initial terminal device, there is no Lisp code
864 loaded, so we can't do this. */
865 if (initialized && !noninteractive)
867 call_critical_lisp_code (d, Qinit_global_faces, Qnil);
872 init_device_faces (struct device *d)
874 /* This function can call lisp */
876 /* When making the initial terminal device, there is no Lisp code
877 loaded, so we can't do this. */
881 XSETDEVICE (tdevice, d);
882 call_critical_lisp_code (d, Qinit_device_faces, tdevice);
887 init_frame_faces (struct frame *frm)
889 /* When making the initial terminal device, there is no Lisp code
890 loaded, so we can't do this. */
894 XSETFRAME (tframe, frm);
896 /* DO NOT change the selected frame here. If the debugger goes off
897 it will try and display on the frame being created, but it is not
898 ready for that yet and a horrible death will occur. Any random
899 code depending on the selected-frame as an implicit arg should be
900 tracked down and shot. For the benefit of the one known,
901 xpm-color-symbols, make-frame sets the variable
902 Vframe_being_created to the frame it is making and sets it to nil
903 when done. Internal functions that this could trigger which are
904 currently depending on selected-frame should use this instead. It
905 is not currently visible at the lisp level. */
906 call_critical_lisp_code (XDEVICE (FRAME_DEVICE (frm)),
907 Qinit_frame_faces, tframe);
912 /****************************************************************************
913 * face cache element functions *
914 ****************************************************************************/
918 #### Here is a description of how the face cache elements ought
919 to be redone. It is *NOT* how they work currently:
921 However, when I started to go about implementing this, I realized
922 that there are all sorts of subtle problems with cache coherency
923 that are coming up. As it turns out, these problems don't
924 manifest themselves now due to the brute-force "kill 'em all"
925 approach to cache invalidation when faces change; but if this
926 is ever made smarter, these problems are going to come up, and
927 some of them are very non-obvious.
929 I'm thinking of redoing the cache code a bit to avoid these
930 coherency problems. The bulk of the problems will arise because
931 the current display structures have simple indices into the
932 face cache, but the cache can be changed at various times,
933 which could make the current display structures incorrect.
934 I guess the dirty and updated flags are an attempt to fix
935 this, but this approach doesn't really work.
937 Here's an approach that should keep things clean and unconfused:
939 1) Imagine a "virtual face cache" that can grow arbitrarily
940 big and for which the only thing allowed is to add new
941 elements. Existing elements cannot be removed or changed.
942 This way, any pointers in the existing redisplay structure
943 into the cache never get screwed up. (This is important
944 because even if a cache element is out of date, if there's
945 a pointer to it then its contents still accurately describe
946 the way the text currently looks on the screen.)
947 2) Each element in the virtual cache either describes exactly
948 one face, or describes the merger of a number of faces
949 by some process. In order to simplify things, for mergers
950 we do not record which faces or ordering was used, but
951 simply that this cache element is the result of merging.
952 Unlike the current implementation, it's important that a
953 single cache element not be used to both describe a
954 single face and describe a merger, even if all the property
956 3) Each cache element can be clean or dirty. "Dirty" means
957 that the face that the element points to has been changed;
958 this gets set at the time the face is changed. This
959 way, when looking up a value in the cache, you can determine
960 whether it's out of date or not. For merged faces it
961 does not matter -- we don't record the faces or priority
962 used to create the merger, so it's impossible to look up
963 one of these faces. We have to recompute it each time.
964 Luckily, this is fine -- doing the merge is much
965 less expensive than recomputing the properties of a
967 4) For each cache element, we keep a hash value. (In order
968 to hash the boolean properties, we convert each of them
969 into a different large prime number so that the hashing works
970 well.) This allows us, when comparing runes, to properly
971 determine whether the face for that rune has changed.
972 This will be especially important for TTY's, where there
973 aren't that many faces and minimizing redraw is very
975 5) We can't actually keep an infinite cache, but that doesn't
976 really matter that much. The only elements we care about
977 are those that are used by either the current or desired
978 display structs. Therefore, we keep a per-window
979 redisplay iteration number, and mark each element with
980 that number as we use it. Just after outputting the
981 window and synching the redisplay structs, we go through
982 the cache and invalidate all elements that are not clean
983 elements referring to a particular face and that do not
984 have an iteration number equal to the current one. We
985 keep them in a chain, and use them to allocate new
986 elements when possible instead of increasing the Dynarr.
990 /* mark for GC a dynarr of face cachels. */
993 mark_face_cachels (face_cachel_dynarr *elements,
994 void (*markobj) (Lisp_Object))
1001 for (elt = 0; elt < Dynarr_length (elements); elt++)
1003 struct face_cachel *cachel = Dynarr_atp (elements, elt);
1008 for (i = 0; i < NUM_LEADING_BYTES; i++)
1009 if (!NILP (cachel->font[i]) && !UNBOUNDP (cachel->font[i]))
1010 ((markobj) (cachel->font[i]));
1012 ((markobj) (cachel->face));
1013 ((markobj) (cachel->foreground));
1014 ((markobj) (cachel->background));
1015 ((markobj) (cachel->display_table));
1016 ((markobj) (cachel->background_pixmap));
1020 /* ensure that the given cachel contains an updated font value for
1021 the given charset. Return the updated font value. */
1024 ensure_face_cachel_contains_charset (struct face_cachel *cachel,
1025 Lisp_Object domain, Lisp_Object charset)
1027 Lisp_Object new_val;
1028 Lisp_Object face = cachel->face;
1030 int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1032 if (!UNBOUNDP (cachel->font[offs])
1033 && cachel->font_updated[offs])
1034 return cachel->font[offs];
1036 if (UNBOUNDP (face))
1038 /* a merged face. */
1040 struct window *w = XWINDOW (domain);
1043 cachel->font_specified[offs] = 0;
1044 for (i = 0; i < cachel->nfaces; i++)
1046 struct face_cachel *oth;
1048 oth = Dynarr_atp (w->face_cachels,
1049 FACE_CACHEL_FINDEX_UNSAFE (cachel, i));
1050 /* Tout le monde aime la recursion */
1051 ensure_face_cachel_contains_charset (oth, domain, charset);
1053 if (oth->font_specified[offs])
1055 new_val = oth->font[offs];
1056 cachel->font_specified[offs] = 1;
1061 if (!cachel->font_specified[offs])
1062 /* need to do the default face. */
1064 struct face_cachel *oth =
1065 Dynarr_atp (w->face_cachels, DEFAULT_INDEX);
1066 ensure_face_cachel_contains_charset (oth, domain, charset);
1068 new_val = oth->font[offs];
1071 if (!UNBOUNDP (cachel->font[offs]) && !EQ (cachel->font[offs], new_val))
1073 cachel->font_updated[offs] = 1;
1074 cachel->font[offs] = new_val;
1078 new_val = face_property_matching_instance (face, Qfont, charset, domain,
1079 /* #### look into ERROR_ME_NOT */
1080 ERROR_ME_NOT, 1, Qzero);
1081 if (UNBOUNDP (new_val))
1084 new_val = face_property_matching_instance (face, Qfont,
1088 ERROR_ME_NOT, 0, Qzero);
1090 if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs]))
1092 cachel->font_updated[offs] = 1;
1093 cachel->font[offs] = new_val;
1094 cachel->font_specified[offs] = (bound || EQ (face, Vdefault_face));
1098 /* Ensure that the given cachel contains updated fonts for all
1099 the charsets specified. */
1102 ensure_face_cachel_complete (struct face_cachel *cachel,
1103 Lisp_Object domain, unsigned char *charsets)
1107 for (i = 0; i < NUM_LEADING_BYTES; i++)
1110 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE);
1111 assert (CHARSETP (charset));
1112 ensure_face_cachel_contains_charset (cachel, domain, charset);
1117 face_cachel_charset_font_metric_info (struct face_cachel *cachel,
1118 unsigned char *charsets,
1119 struct font_metric_info *fm)
1124 fm->height = fm->ascent = 1;
1126 fm->proportional_p = 0;
1128 for (i = 0; i < NUM_LEADING_BYTES; i++)
1132 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE);
1133 Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset);
1134 struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance);
1136 assert (CHARSETP (charset));
1137 assert (FONT_INSTANCEP (font_instance));
1139 if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent;
1140 if (fm->descent < (int) fi->descent) fm->descent = (int) fi->descent;
1141 fm->height = fm->ascent + fm->descent;
1142 if (fi->proportional_p)
1143 fm->proportional_p = 1;
1144 if (EQ (charset, Vcharset_ascii))
1145 fm->width = fi->width;
1150 /* Called when the updated flag has been cleared on a cachel. */
1153 update_face_cachel_data (struct face_cachel *cachel,
1157 if (XFACE (face)->dirty || UNBOUNDP (cachel->face))
1159 int default_face = EQ (face, Vdefault_face);
1160 cachel->face = face;
1162 /* We normally only set the _specified flags if the value was
1163 actually bound. The exception is for the default face where
1164 we always set it since it is the ultimate fallback. */
1166 #define FROB(field) \
1168 Lisp_Object new_val = \
1169 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
1171 if (UNBOUNDP (new_val)) \
1174 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1176 if (!EQ (new_val, cachel->field)) \
1178 cachel->field = new_val; \
1179 cachel->dirty = 1; \
1181 cachel->field##_specified = (bound || default_face); \
1186 FROB (display_table);
1187 FROB (background_pixmap);
1190 * A face's background pixmap will override the face's
1191 * background color. But the background pixmap of the
1192 * default face should not override the background color of
1193 * a face if the background color has been specified or
1196 * To accomplish this we remove the background pixmap of the
1197 * cachel and mark it as having been specified so that cachel
1198 * merging won't override it later.
1201 && cachel->background_specified
1202 && ! cachel->background_pixmap_specified)
1204 cachel->background_pixmap = Qunbound;
1205 cachel->background_pixmap_specified = 1;
1210 ensure_face_cachel_contains_charset (cachel, domain, Vcharset_ascii);
1212 #define FROB(field) \
1214 Lisp_Object new_val = \
1215 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
1217 unsigned int new_val_int; \
1218 if (UNBOUNDP (new_val)) \
1221 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
1223 new_val_int = EQ (new_val, Qt); \
1224 if (cachel->field != new_val_int) \
1226 cachel->field = new_val_int; \
1227 cachel->dirty = 1; \
1229 cachel->field##_specified = bound; \
1241 cachel->updated = 1;
1244 /* Merge the cachel identified by FINDEX in window W into the given
1248 merge_face_cachel_data (struct window *w, face_index findex,
1249 struct face_cachel *cachel)
1251 #define FINDEX_FIELD(field) \
1252 Dynarr_atp (w->face_cachels, findex)->field
1254 #define FROB(field) \
1256 if (!cachel->field##_specified && FINDEX_FIELD (field##_specified)) \
1258 cachel->field = FINDEX_FIELD (field); \
1259 cachel->field##_specified = 1; \
1260 cachel->dirty = 1; \
1266 FROB (display_table);
1267 FROB (background_pixmap);
1274 /* And do ASCII, of course. */
1276 int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE;
1278 if (!cachel->font_specified[offs] && FINDEX_FIELD (font_specified[offs]))
1280 cachel->font[offs] = FINDEX_FIELD (font[offs]);
1281 cachel->font_specified[offs] = 1;
1289 cachel->updated = 1;
1292 /* Initialize a cachel. */
1295 reset_face_cachel (struct face_cachel *cachel)
1298 cachel->face = Qunbound;
1300 cachel->merged_faces = 0;
1301 cachel->foreground = Qunbound;
1302 cachel->background = Qunbound;
1306 for (i = 0; i < NUM_LEADING_BYTES; i++)
1307 cachel->font[i] = Qunbound;
1309 cachel->display_table = Qunbound;
1310 cachel->background_pixmap = Qunbound;
1313 /* Add a cachel for the given face to the given window's cache. */
1316 add_face_cachel (struct window *w, Lisp_Object face)
1318 struct face_cachel new_cachel;
1321 reset_face_cachel (&new_cachel);
1322 XSETWINDOW (window, w);
1323 update_face_cachel_data (&new_cachel, window, face);
1324 Dynarr_add (w->face_cachels, new_cachel);
1327 /* Retrieve the index to a cachel for window W that corresponds to
1328 the specified face. If necessary, add a new element to the
1332 get_builtin_face_cache_index (struct window *w, Lisp_Object face)
1339 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1341 struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt);
1343 if (EQ (cachel->face, face))
1346 XSETWINDOW (window, w);
1347 if (!cachel->updated)
1348 update_face_cachel_data (cachel, window, face);
1353 /* If we didn't find the face, add it and then return its index. */
1354 add_face_cachel (w, face);
1359 reset_face_cachels (struct window *w)
1361 /* #### Not initialized in batch mode for the stream device. */
1362 if (w->face_cachels)
1366 for (i = 0; i < Dynarr_length (w->face_cachels); i++)
1368 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, i);
1369 if (cachel->merged_faces)
1370 Dynarr_free (cachel->merged_faces);
1372 Dynarr_reset (w->face_cachels);
1373 get_builtin_face_cache_index (w, Vdefault_face);
1374 get_builtin_face_cache_index (w, Vmodeline_face);
1375 XFRAME (w->frame)->window_face_cache_reset = 1;
1380 mark_face_cachels_as_clean (struct window *w)
1384 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1385 Dynarr_atp (w->face_cachels, elt)->dirty = 0;
1389 mark_face_cachels_as_not_updated (struct window *w)
1393 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1395 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt);
1398 cachel->updated = 0;
1399 for (i = 0; i < NUM_LEADING_BYTES; i++)
1400 cachel->font_updated[i] = 0;
1404 #ifdef MEMORY_USAGE_STATS
1407 compute_face_cachel_usage (face_cachel_dynarr *face_cachels,
1408 struct overhead_stats *ovstats)
1416 total += Dynarr_memory_usage (face_cachels, ovstats);
1417 for (i = 0; i < Dynarr_length (face_cachels); i++)
1419 int_dynarr *merged = Dynarr_at (face_cachels, i).merged_faces;
1421 total += Dynarr_memory_usage (merged, ovstats);
1428 #endif /* MEMORY_USAGE_STATS */
1431 /*****************************************************************************
1432 * merged face functions *
1433 *****************************************************************************/
1435 /* Compare two merged face cachels to determine whether we have to add
1436 a new entry to the face cache.
1438 Note that we do not compare the attributes, but just the faces the
1439 cachels are based on. If they are the same, then the cachels certainly
1440 ought to have the same attributes, except in the case where fonts
1441 for different charsets have been determined in the two -- and in that
1442 case this difference is fine. */
1445 compare_merged_face_cachels (struct face_cachel *cachel1,
1446 struct face_cachel *cachel2)
1450 if (!EQ (cachel1->face, cachel2->face)
1451 || cachel1->nfaces != cachel2->nfaces)
1454 for (i = 0; i < cachel1->nfaces; i++)
1455 if (FACE_CACHEL_FINDEX_UNSAFE (cachel1, i)
1456 != FACE_CACHEL_FINDEX_UNSAFE (cachel2, i))
1462 /* Retrieve the index to a cachel for window W that corresponds to
1463 the specified cachel. If necessary, add a new element to the
1464 cache. This is similar to get_builtin_face_cache_index() but
1465 is intended for merged cachels rather than for cachels representing
1468 Note that a merged cachel for just one face is not the same as
1469 the simple cachel for that face, because it is also merged with
1470 the default face. */
1473 get_merged_face_cache_index (struct window *w,
1474 struct face_cachel *merged_cachel)
1477 int cache_size = Dynarr_length (w->face_cachels);
1479 for (elt = 0; elt < cache_size; elt++)
1481 struct face_cachel *cachel =
1482 Dynarr_atp (w->face_cachels, elt);
1484 if (compare_merged_face_cachels (cachel, merged_cachel))
1488 /* We didn't find it so add this instance to the cache. */
1489 merged_cachel->updated = 1;
1490 merged_cachel->dirty = 1;
1491 Dynarr_add (w->face_cachels, *merged_cachel);
1496 get_extent_fragment_face_cache_index (struct window *w,
1497 struct extent_fragment *ef)
1499 struct face_cachel cachel;
1500 int len = Dynarr_length (ef->extents);
1501 face_index findex = 0;
1503 XSETWINDOW (window, w);
1505 /* Optimize the default case. */
1507 return DEFAULT_INDEX;
1512 /* Merge the faces of the extents together in order. */
1514 reset_face_cachel (&cachel);
1516 for (i = len - 1; i >= 0; i--)
1518 EXTENT current = Dynarr_at (ef->extents, i);
1520 Lisp_Object face = extent_face (current);
1524 findex = get_builtin_face_cache_index (w, face);
1526 merge_face_cachel_data (w, findex, &cachel);
1528 /* remember, we're called from within redisplay
1529 so we can't error. */
1530 else while (CONSP (face))
1532 Lisp_Object one_face = XCAR (face);
1533 if (FACEP (one_face))
1535 findex = get_builtin_face_cache_index (w, one_face);
1536 merge_face_cachel_data (w, findex, &cachel);
1538 /* code duplication here but there's no clean
1540 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES)
1542 if (!cachel.merged_faces)
1543 cachel.merged_faces = Dynarr_new (int);
1544 Dynarr_add (cachel.merged_faces, findex);
1547 cachel.merged_faces_static[cachel.nfaces] = findex;
1555 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES)
1557 if (!cachel.merged_faces)
1558 cachel.merged_faces = Dynarr_new (int);
1559 Dynarr_add (cachel.merged_faces, findex);
1562 cachel.merged_faces_static[cachel.nfaces] = findex;
1567 /* Now finally merge in the default face. */
1568 findex = get_builtin_face_cache_index (w, Vdefault_face);
1569 merge_face_cachel_data (w, findex, &cachel);
1571 return get_merged_face_cache_index (w, &cachel);
1576 /*****************************************************************************
1578 ****************************************************************************/
1581 update_EmacsFrame (Lisp_Object frame, Lisp_Object name)
1583 struct frame *frm = XFRAME (frame);
1585 if (EQ (name, Qfont))
1586 MARK_FRAME_SIZE_SLIPPED (frm);
1588 MAYBE_FRAMEMETH (frm, update_frame_external_traits, (frm, name));
1592 update_EmacsFrames (Lisp_Object locale, Lisp_Object name)
1594 if (FRAMEP (locale))
1596 update_EmacsFrame (locale, name);
1598 else if (DEVICEP (locale))
1600 Lisp_Object frmcons;
1602 DEVICE_FRAME_LOOP (frmcons, XDEVICE (locale))
1603 update_EmacsFrame (XCAR (frmcons), name);
1605 else if (EQ (locale, Qglobal) || EQ (locale, Qfallback))
1607 Lisp_Object frmcons, devcons, concons;
1609 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
1610 update_EmacsFrame (XCAR (frmcons), name);
1615 update_frame_face_values (struct frame *f)
1620 update_EmacsFrame (frm, Qforeground);
1621 update_EmacsFrame (frm, Qbackground);
1622 update_EmacsFrame (frm, Qfont);
1626 face_property_was_changed (Lisp_Object face, Lisp_Object property,
1629 int default_face = EQ (face, Vdefault_face);
1631 /* If the locale could affect the frame value, then call
1632 update_EmacsFrames just in case. */
1634 (EQ (property, Qforeground) ||
1635 EQ (property, Qbackground) ||
1636 EQ (property, Qfont)))
1637 update_EmacsFrames (locale, property);
1639 if (WINDOWP (locale))
1641 struct frame *f = XFRAME (XWINDOW (locale)->frame);
1642 MARK_FRAME_FACES_CHANGED (f);
1644 else if (FRAMEP (locale))
1646 struct frame *f = XFRAME (locale);
1647 MARK_FRAME_FACES_CHANGED (f);
1649 else if (DEVICEP (locale))
1651 struct device *d = XDEVICE (locale);
1652 MARK_DEVICE_FRAMES_FACES_CHANGED (d);
1656 Lisp_Object devcons, concons;
1658 DEVICE_LOOP_NO_BREAK (devcons, concons)
1659 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (XCAR (devcons)));
1663 * This call to update_faces_inheritance isn't needed and makes
1664 * creating and modifying faces _very_ slow. The point of
1665 * update_face_inheritances is to find all faces that inherit
1666 * directly from this face property and set the specifier "dirty"
1667 * flag on the corresponding specifier. This forces recaching of
1668 * cached specifier values in frame and window struct slots. But
1669 * currently no face properties are cached in frame and window
1670 * struct slots, so calling this function does nothing useful!
1672 * Further, since update_faces_inheritance maps over the whole
1673 * face table every time it is called, it gets terribly slow when
1674 * there are many faces. Creating 500 faces on a 50Mhz 486 took
1675 * 433 seconds when update_faces_inheritance was called. With the
1676 * call commented out, creating those same 500 faces took 0.72
1679 /* update_faces_inheritance (face, property);*/
1680 XFACE (face)->dirty = 1;
1683 DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /*
1684 Define and return a new face which is a copy of an existing one,
1685 or makes an already-existing face be exactly like another.
1686 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'.
1688 (old_face, new_name, locale, tag_set, exact_p, how_to_add))
1690 struct Lisp_Face *fold, *fnew;
1691 Lisp_Object new_face = Qnil;
1692 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1694 old_face = Fget_face (old_face);
1696 /* We GCPRO old_face because it might be temporary, and GCing could
1697 occur in various places below. */
1698 GCPRO4 (tag_set, locale, old_face, new_face);
1699 /* check validity of how_to_add now. */
1700 decode_how_to_add_specification (how_to_add);
1701 /* and of tag_set. */
1702 tag_set = decode_specifier_tag_set (tag_set);
1703 /* and of locale. */
1704 locale = decode_locale_list (locale);
1706 new_face = Ffind_face (new_name);
1707 if (NILP (new_face))
1711 CHECK_SYMBOL (new_name);
1713 /* Create the new face with the same status as the old face. */
1714 temp = (NILP (Fgethash (old_face, Vtemporary_faces_cache, Qnil))
1718 new_face = Fmake_face (new_name, Qnil, temp);
1721 fold = XFACE (old_face);
1722 fnew = XFACE (new_face);
1724 #define COPY_PROPERTY(property) \
1725 Fcopy_specifier (fold->property, fnew->property, \
1726 locale, tag_set, exact_p, how_to_add);
1728 COPY_PROPERTY (foreground);
1729 COPY_PROPERTY (background);
1730 COPY_PROPERTY (font);
1731 COPY_PROPERTY (display_table);
1732 COPY_PROPERTY (background_pixmap);
1733 COPY_PROPERTY (underline);
1734 COPY_PROPERTY (strikethru);
1735 COPY_PROPERTY (highlight);
1736 COPY_PROPERTY (dim);
1737 COPY_PROPERTY (blinking);
1738 COPY_PROPERTY (reverse);
1739 #undef COPY_PROPERTY
1740 /* #### should it copy the individual specifiers, if they exist? */
1741 fnew->plist = Fcopy_sequence (fold->plist);
1750 syms_of_faces (void)
1752 /* Qdefault defined in general.c */
1753 defsymbol (&Qmodeline, "modeline");
1754 defsymbol (&Qgui_element, "gui-element");
1755 defsymbol (&Qleft_margin, "left-margin");
1756 defsymbol (&Qright_margin, "right-margin");
1757 defsymbol (&Qtext_cursor, "text-cursor");
1758 defsymbol (&Qvertical_divider, "vertical-divider");
1761 DEFSUBR (Ffind_face);
1762 DEFSUBR (Fget_face);
1763 DEFSUBR (Fface_name);
1764 DEFSUBR (Fbuilt_in_face_specifiers);
1765 DEFSUBR (Fface_list);
1766 DEFSUBR (Fmake_face);
1767 DEFSUBR (Fcopy_face);
1769 defsymbol (&Qfacep, "facep");
1770 defsymbol (&Qforeground, "foreground");
1771 defsymbol (&Qbackground, "background");
1772 /* Qfont defined in general.c */
1773 defsymbol (&Qdisplay_table, "display-table");
1774 defsymbol (&Qbackground_pixmap, "background-pixmap");
1775 defsymbol (&Qunderline, "underline");
1776 defsymbol (&Qstrikethru, "strikethru");
1777 /* Qhighlight, Qreverse defined in general.c */
1778 defsymbol (&Qdim, "dim");
1779 defsymbol (&Qblinking, "blinking");
1781 defsymbol (&Qinit_face_from_resources, "init-face-from-resources");
1782 defsymbol (&Qinit_global_faces, "init-global-faces");
1783 defsymbol (&Qinit_device_faces, "init-device-faces");
1784 defsymbol (&Qinit_frame_faces, "init-frame-faces");
1788 structure_type_create_faces (void)
1790 struct structure_type *st;
1792 st = define_structure_type (Qface, face_validate, face_instantiate);
1794 define_structure_type_keyword (st, Qname, face_name_validate);
1798 vars_of_faces (void)
1800 staticpro (&Vpermanent_faces_cache);
1801 Vpermanent_faces_cache = Qnil;
1802 staticpro (&Vtemporary_faces_cache);
1803 Vtemporary_faces_cache = Qnil;
1805 staticpro (&Vdefault_face);
1806 Vdefault_face = Qnil;
1807 staticpro (&Vgui_element_face);
1808 Vgui_element_face = Qnil;
1809 staticpro (&Vmodeline_face);
1810 Vmodeline_face = Qnil;
1811 staticpro (&Vtoolbar_face);
1812 Vtoolbar_face = Qnil;
1814 staticpro (&Vvertical_divider_face);
1815 Vvertical_divider_face = Qnil;
1816 staticpro (&Vleft_margin_face);
1817 Vleft_margin_face = Qnil;
1818 staticpro (&Vright_margin_face);
1819 Vright_margin_face = Qnil;
1820 staticpro (&Vtext_cursor_face);
1821 Vtext_cursor_face = Qnil;
1822 staticpro (&Vpointer_face);
1823 Vpointer_face = Qnil;
1826 Lisp_Object syms[20];
1829 syms[n++] = Qforeground;
1830 syms[n++] = Qbackground;
1832 syms[n++] = Qdisplay_table;
1833 syms[n++] = Qbackground_pixmap;
1834 syms[n++] = Qunderline;
1835 syms[n++] = Qstrikethru;
1836 syms[n++] = Qhighlight;
1838 syms[n++] = Qblinking;
1839 syms[n++] = Qreverse;
1841 Vbuilt_in_face_specifiers = pure_list (n, syms);
1842 staticpro (&Vbuilt_in_face_specifiers);
1847 complex_vars_of_faces (void)
1849 Vpermanent_faces_cache = make_lisp_hashtable (10, HASHTABLE_NONWEAK,
1851 Vtemporary_faces_cache = make_lisp_hashtable (0, HASHTABLE_WEAK,
1854 /* Create the default face now so we know what it is immediately. */
1856 Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus
1858 Vdefault_face = Fmake_face (Qdefault, build_string ("default face"),
1861 /* Provide some last-resort fallbacks to avoid utter fuckage if
1862 someone provides invalid values for the global specifications. */
1865 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1867 #ifdef HAVE_X_WINDOWS
1868 fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
1869 bg_fb = acons (list1 (Qx), build_string ("white"), bg_fb);
1872 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1873 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1875 #ifdef HAVE_MS_WINDOWS
1876 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1877 bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb);
1879 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb);
1880 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb);
1883 /* #### We may want to have different fallback values if NeXTstep
1884 support is compiled in. */
1886 Lisp_Object inst_list = Qnil;
1887 #ifdef HAVE_X_WINDOWS
1888 /* The same gory list from x-faces.el.
1889 (#### Perhaps we should remove the stuff from x-faces.el
1890 and only depend on this stuff here? That should work.)
1892 CONST char *fonts[] =
1894 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
1895 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
1896 "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*",
1897 "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*",
1898 "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*",
1899 "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*",
1900 "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*",
1901 "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*",
1902 "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*",
1903 "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*",
1904 "-*-*-*-r-*-*-*-120-*-*-m-*-*-*",
1905 "-*-*-*-r-*-*-*-120-*-*-c-*-*-*",
1906 "-*-*-*-r-*-*-*-120-*-*-*-*-*-*",
1907 "-*-*-*-*-*-*-*-120-*-*-*-*-*-*",
1910 CONST char **fontptr;
1912 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--)
1913 inst_list = Fcons (Fcons (list1 (Qx), build_string (*fontptr)),
1915 #endif /* HAVE_X_WINDOWS */
1918 inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")),
1920 #endif /* HAVE_TTY */
1921 #ifdef HAVE_MS_WINDOWS
1922 inst_list = Fcons (Fcons (list1 (Qmswindows),
1923 build_string ("Fixedsys:Regular:9::Western")), inst_list);
1924 inst_list = Fcons (Fcons (list1 (Qmswindows),
1925 build_string ("Courier:Regular:10::Western")), inst_list);
1926 inst_list = Fcons (Fcons (list1 (Qmswindows),
1927 build_string ("Courier New:Regular:10::Western")), inst_list);
1928 #endif /* HAVE_MS_WINDOWS */
1929 set_specifier_fallback (Fget (Vdefault_face, Qfont, Qnil), inst_list);
1932 set_specifier_fallback (Fget (Vdefault_face, Qunderline, Qnil),
1933 list1 (Fcons (Qnil, Qnil)));
1934 set_specifier_fallback (Fget (Vdefault_face, Qstrikethru, Qnil),
1935 list1 (Fcons (Qnil, Qnil)));
1936 set_specifier_fallback (Fget (Vdefault_face, Qhighlight, Qnil),
1937 list1 (Fcons (Qnil, Qnil)));
1938 set_specifier_fallback (Fget (Vdefault_face, Qdim, Qnil),
1939 list1 (Fcons (Qnil, Qnil)));
1940 set_specifier_fallback (Fget (Vdefault_face, Qblinking, Qnil),
1941 list1 (Fcons (Qnil, Qnil)));
1942 set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil),
1943 list1 (Fcons (Qnil, Qnil)));
1945 /* gui-element is the parent face of all gui elements such as
1946 modeline, vertical divider and toolbar. */
1947 Vgui_element_face = Fmake_face (Qgui_element,
1948 build_string ("gui element face"),
1951 /* Provide some last-resort fallbacks for gui-element face which
1952 mustn't default to default. */
1954 Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
1956 #ifdef HAVE_X_WINDOWS
1957 fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
1958 bg_fb = acons (list1 (Qx), build_string ("Gray80"), bg_fb);
1961 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
1962 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
1964 #ifdef HAVE_MS_WINDOWS
1965 fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
1966 bg_fb = acons (list1 (Qmswindows), build_string ("Gray75"), bg_fb);
1968 set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb);
1969 set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb);
1972 /* Now create the other faces that redisplay needs to refer to
1973 directly. We could create them in Lisp but it's simpler this
1974 way since we need to get them anyway. */
1976 /* modeline is gui element. */
1977 Vmodeline_face = Fmake_face (Qmodeline, build_string ("modeline face"),
1980 set_specifier_fallback (Fget (Vmodeline_face, Qforeground, Qunbound),
1981 Fget (Vgui_element_face, Qforeground, Qunbound));
1982 set_specifier_fallback (Fget (Vmodeline_face, Qbackground, Qunbound),
1983 Fget (Vgui_element_face, Qbackground, Qunbound));
1984 set_specifier_fallback (Fget (Vmodeline_face, Qbackground_pixmap, Qnil),
1985 Fget (Vgui_element_face, Qbackground_pixmap,
1988 /* toolbar is another gui element */
1989 Vtoolbar_face = Fmake_face (Qtoolbar,
1990 build_string ("toolbar face"),
1992 set_specifier_fallback (Fget (Vtoolbar_face, Qforeground, Qunbound),
1993 Fget (Vgui_element_face, Qforeground, Qunbound));
1994 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground, Qunbound),
1995 Fget (Vgui_element_face, Qbackground, Qunbound));
1996 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_pixmap, Qnil),
1997 Fget (Vgui_element_face, Qbackground_pixmap,
2000 /* vertical divider is another gui element */
2001 Vvertical_divider_face = Fmake_face (Qvertical_divider,
2002 build_string ("vertical divider face"),
2005 set_specifier_fallback (Fget (Vvertical_divider_face, Qforeground, Qunbound),
2006 Fget (Vgui_element_face, Qforeground, Qunbound));
2007 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground, Qunbound),
2008 Fget (Vgui_element_face, Qbackground, Qunbound));
2009 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground_pixmap,
2011 Fget (Vgui_element_face, Qbackground_pixmap,
2014 Vleft_margin_face = Fmake_face (Qleft_margin,
2015 build_string ("left margin face"),
2017 Vright_margin_face = Fmake_face (Qright_margin,
2018 build_string ("right margin face"),
2020 Vtext_cursor_face = Fmake_face (Qtext_cursor,
2021 build_string ("face for text cursor"),
2024 Fmake_face (Qpointer,
2026 ("face for foreground/background colors of mouse pointer"),