Mercurial > hg > xemacs-beta
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 } |