comparison src/faces.c @ 428:3ecd8885ac67 r21-2-22

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