Mercurial > hg > xemacs-beta
annotate src/faces.c @ 5043:d0c14ea98592
various frame-geometry fixes
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-15 Ben Wing <ben@xemacs.org>
* EmacsFrame.c:
* EmacsFrame.c (EmacsFrameResize):
* console-msw-impl.h:
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (FRAME_MSWINDOWS_TARGET_RECT):
* device-tty.c:
* device-tty.c (tty_asynch_device_change):
* event-msw.c:
* event-msw.c (mswindows_wnd_proc):
* faces.c (Fface_list):
* faces.h:
* frame-gtk.c:
* frame-gtk.c (gtk_set_initial_frame_size):
* frame-gtk.c (gtk_set_frame_size):
* frame-msw.c:
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_set_frame_size):
* frame-msw.c (mswindows_size_frame_internal):
* frame-msw.c (msprinter_init_frame_3):
* frame.c:
* frame.c (enum):
* frame.c (Fmake_frame):
* frame.c (adjust_frame_size):
* frame.c (store_minibuf_frame_prop):
* frame.c (Fframe_property):
* frame.c (Fframe_properties):
* frame.c (Fframe_displayable_pixel_height):
* frame.c (Fframe_displayable_pixel_width):
* frame.c (internal_set_frame_size):
* frame.c (Fset_frame_height):
* frame.c (Fset_frame_pixel_height):
* frame.c (Fset_frame_displayable_pixel_height):
* frame.c (Fset_frame_width):
* frame.c (Fset_frame_pixel_width):
* frame.c (Fset_frame_displayable_pixel_width):
* frame.c (Fset_frame_size):
* frame.c (Fset_frame_pixel_size):
* frame.c (Fset_frame_displayable_pixel_size):
* frame.c (frame_conversion_internal_1):
* frame.c (get_frame_displayable_pixel_size):
* frame.c (change_frame_size_1):
* frame.c (change_frame_size):
* frame.c (generate_title_string):
* frame.h:
* gtk-xemacs.c:
* gtk-xemacs.c (gtk_xemacs_size_request):
* gtk-xemacs.c (gtk_xemacs_size_allocate):
* gtk-xemacs.c (gtk_xemacs_paint):
* gutter.c:
* gutter.c (update_gutter_geometry):
* redisplay.c (end_hold_frame_size_changes):
* redisplay.c (redisplay_frame):
* toolbar.c:
* toolbar.c (update_frame_toolbars_geometry):
* window.c:
* window.c (frame_pixsize_valid_p):
* window.c (check_frame_size):
Various fixes to frame geometry to make it a bit easier to understand
and fix some bugs.
1. IMPORTANT: Some renamings. Will need to be applied carefully to
the carbon repository, in the following order:
-- pixel_to_char_size -> pixel_to_frame_unit_size
-- char_to_pixel_size -> frame_unit_to_pixel_size
-- pixel_to_real_char_size -> pixel_to_char_size
-- char_to_real_pixel_size -> char_to_pixel_size
-- Reverse second and third arguments of change_frame_size() and
change_frame_size_1() to try to make functions consistent in
putting width before height.
-- Eliminate old round_size_to_char, because it didn't really
do anything differently from round_size_to_real_char()
-- round_size_to_real_char -> round_size_to_char; any places that
called the old round_size_to_char should just call the new one.
2. IMPORTANT FOR CARBON: The set_frame_size() method is now passed
sizes in "frame units", like all other frame-sizing functions,
rather than some hacked-up combination of char-cell units and
total pixel size. This only affects window systems that use
"pixelated geometry", and I'm not sure if Carbon is one of them.
MS Windows is pixelated, X and GTK are not. For pixelated-geometry
systems, the size in set_frame_size() is in displayable pixels
rather than total pixels and needs to be converted appropriately;
take a look at the changes made to mswindows_set_frame_size()
method if necessary.
3. Add a big long comment in frame.c describing how frame geometry
works.
4. Remove MS Windows-specific character height and width fields,
duplicative and unused.
5. frame-displayable-pixel-* and set-frame-displayable-pixel-*
didn't use to work on MS Windows, but they do now.
6. In general, clean up the handling of "pixelated geometry" so
that fewer functions have to worry about this. This is really
an abomination that should be removed entirely but that will
have to happen later. Fix some buggy code in
frame_conversion_internal() that happened to "work" because it
was countered by oppositely buggy code in change_frame_size().
7. Clean up some frame-size code in toolbar.c and use functions
already provided in frame.c instead of rolling its own.
8. Fix check_frame_size() in window.c, which formerly didn't take
pixelated geometry into account.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 15 Feb 2010 22:14:11 -0600 |
parents | d95c102a96d3 |
children | 07dcc7000bbf |
rev | line source |
---|---|
428 | 1 /* "Face" primitives |
2 Copyright (C) 1994 Free Software Foundation, Inc. | |
3 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
4 Copyright (C) 1995, 1996, 2001, 2002, 2005, 2010 Ben Wing. |
428 | 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" | |
872 | 33 #include "device-impl.h" |
428 | 34 #include "elhash.h" |
872 | 35 #include "extents-impl.h" /* for extent_face */ |
428 | 36 #include "faces.h" |
872 | 37 #include "frame-impl.h" |
428 | 38 #include "glyphs.h" |
872 | 39 #include "objects-impl.h" |
428 | 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 | |
440 | 60 /* Qdefault, Qhighlight, Qleft_margin, Qright_margin defined in general.c */ |
61 Lisp_Object Qmodeline, Qgui_element, Qtext_cursor, Qvertical_divider; | |
428 | 62 |
2867 | 63 Lisp_Object Qface_alias, Qcyclic_face_alias; |
2865 | 64 |
428 | 65 /* In the old implementation Vface_list was a list of the face names, |
66 not the faces themselves. We now distinguish between permanent and | |
67 temporary faces. Permanent faces are kept in a regular hash table, | |
68 temporary faces in a weak hash table. */ | |
69 Lisp_Object Vpermanent_faces_cache; | |
70 Lisp_Object Vtemporary_faces_cache; | |
71 | |
72 Lisp_Object Vbuilt_in_face_specifiers; | |
73 | |
74 | |
3659 | 75 #ifdef DEBUG_XEMACS |
76 Fixnum debug_x_faces; | |
77 #endif | |
78 | |
4187 | 79 #if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901) |
3659 | 80 |
81 #ifdef DEBUG_XEMACS | |
82 # define DEBUG_FACES(FORMAT, ...) \ | |
83 do { if (debug_x_faces) stderr_out(FORMAT, __VA_ARGS__); } while (0) | |
84 #else /* DEBUG_XEMACS */ | |
85 # define DEBUG_FACES(format, ...) | |
86 #endif /* DEBUG_XEMACS */ | |
87 | |
88 #elif defined(__GNUC__) | |
89 | |
90 #ifdef DEBUG_XEMACS | |
91 # define DEBUG_FACES(format, args...) \ | |
92 do { if (debug_x_faces) stderr_out(format, args ); } while (0) | |
93 #else /* DEBUG_XEMACS */ | |
94 # define DEBUG_FACES(format, args...) | |
95 #endif /* DEBUG_XEMACS */ | |
96 | |
97 #else /* defined(__STDC_VERSION__) [...] */ | |
98 # define DEBUG_FACES (void) | |
99 #endif | |
428 | 100 |
101 static Lisp_Object | |
102 mark_face (Lisp_Object obj) | |
103 { | |
440 | 104 Lisp_Face *face = XFACE (obj); |
428 | 105 |
106 mark_object (face->name); | |
107 mark_object (face->doc_string); | |
108 | |
109 mark_object (face->foreground); | |
110 mark_object (face->background); | |
111 mark_object (face->font); | |
112 mark_object (face->display_table); | |
113 mark_object (face->background_pixmap); | |
114 mark_object (face->underline); | |
115 mark_object (face->strikethru); | |
116 mark_object (face->highlight); | |
117 mark_object (face->dim); | |
118 mark_object (face->blinking); | |
119 mark_object (face->reverse); | |
120 | |
121 mark_object (face->charsets_warned_about); | |
122 | |
123 return face->plist; | |
124 } | |
125 | |
126 static void | |
2286 | 127 print_face (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) |
428 | 128 { |
440 | 129 Lisp_Face *face = XFACE (obj); |
428 | 130 |
131 if (print_readably) | |
132 { | |
800 | 133 write_fmt_string_lisp (printcharfun, "#s(face name %S)", 1, face->name); |
428 | 134 } |
135 else | |
136 { | |
800 | 137 write_fmt_string_lisp (printcharfun, "#<face %S", 1, face->name); |
428 | 138 if (!NILP (face->doc_string)) |
800 | 139 write_fmt_string_lisp (printcharfun, " %S", 1, face->doc_string); |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
140 write_ascstring (printcharfun, ">"); |
428 | 141 } |
142 } | |
143 | |
144 /* Faces are equal if all of their display attributes are equal. We | |
145 don't compare names or doc-strings, because that would make equal | |
146 be eq. | |
147 | |
148 This isn't concerned with "unspecified" attributes, that's what | |
149 #'face-differs-from-default-p is for. */ | |
150 static int | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
151 face_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
152 int UNUSED (foldcase)) |
428 | 153 { |
440 | 154 Lisp_Face *f1 = XFACE (obj1); |
155 Lisp_Face *f2 = XFACE (obj2); | |
428 | 156 |
157 depth++; | |
158 | |
159 return | |
160 (internal_equal (f1->foreground, f2->foreground, depth) && | |
161 internal_equal (f1->background, f2->background, depth) && | |
162 internal_equal (f1->font, f2->font, depth) && | |
163 internal_equal (f1->display_table, f2->display_table, depth) && | |
164 internal_equal (f1->background_pixmap, f2->background_pixmap, depth) && | |
165 internal_equal (f1->underline, f2->underline, depth) && | |
166 internal_equal (f1->strikethru, f2->strikethru, depth) && | |
167 internal_equal (f1->highlight, f2->highlight, depth) && | |
168 internal_equal (f1->dim, f2->dim, depth) && | |
169 internal_equal (f1->blinking, f2->blinking, depth) && | |
170 internal_equal (f1->reverse, f2->reverse, depth) && | |
171 | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
172 ! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1, 0)); |
428 | 173 } |
174 | |
665 | 175 static Hashcode |
428 | 176 face_hash (Lisp_Object obj, int depth) |
177 { | |
440 | 178 Lisp_Face *f = XFACE (obj); |
428 | 179 |
180 depth++; | |
181 | |
182 /* No need to hash all of the elements; that would take too long. | |
183 Just hash the most common ones. */ | |
184 return HASH3 (internal_hash (f->foreground, depth), | |
185 internal_hash (f->background, depth), | |
186 internal_hash (f->font, depth)); | |
187 } | |
188 | |
189 static Lisp_Object | |
190 face_getprop (Lisp_Object obj, Lisp_Object prop) | |
191 { | |
440 | 192 Lisp_Face *f = XFACE (obj); |
428 | 193 |
194 return | |
195 (EQ (prop, Qforeground) ? f->foreground : | |
196 EQ (prop, Qbackground) ? f->background : | |
197 EQ (prop, Qfont) ? f->font : | |
198 EQ (prop, Qdisplay_table) ? f->display_table : | |
199 EQ (prop, Qbackground_pixmap) ? f->background_pixmap : | |
200 EQ (prop, Qunderline) ? f->underline : | |
201 EQ (prop, Qstrikethru) ? f->strikethru : | |
202 EQ (prop, Qhighlight) ? f->highlight : | |
203 EQ (prop, Qdim) ? f->dim : | |
204 EQ (prop, Qblinking) ? f->blinking : | |
205 EQ (prop, Qreverse) ? f->reverse : | |
206 EQ (prop, Qdoc_string) ? f->doc_string : | |
207 external_plist_get (&f->plist, prop, 0, ERROR_ME)); | |
208 } | |
209 | |
210 static int | |
211 face_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) | |
212 { | |
440 | 213 Lisp_Face *f = XFACE (obj); |
428 | 214 |
215 if (EQ (prop, Qforeground) || | |
216 EQ (prop, Qbackground) || | |
217 EQ (prop, Qfont) || | |
218 EQ (prop, Qdisplay_table) || | |
219 EQ (prop, Qbackground_pixmap) || | |
220 EQ (prop, Qunderline) || | |
221 EQ (prop, Qstrikethru) || | |
222 EQ (prop, Qhighlight) || | |
223 EQ (prop, Qdim) || | |
224 EQ (prop, Qblinking) || | |
225 EQ (prop, Qreverse)) | |
226 return 0; | |
227 | |
228 if (EQ (prop, Qdoc_string)) | |
229 { | |
230 if (!NILP (value)) | |
231 CHECK_STRING (value); | |
232 f->doc_string = value; | |
233 return 1; | |
234 } | |
235 | |
236 external_plist_put (&f->plist, prop, value, 0, ERROR_ME); | |
237 return 1; | |
238 } | |
239 | |
240 static int | |
241 face_remprop (Lisp_Object obj, Lisp_Object prop) | |
242 { | |
440 | 243 Lisp_Face *f = XFACE (obj); |
428 | 244 |
245 if (EQ (prop, Qforeground) || | |
246 EQ (prop, Qbackground) || | |
247 EQ (prop, Qfont) || | |
248 EQ (prop, Qdisplay_table) || | |
249 EQ (prop, Qbackground_pixmap) || | |
250 EQ (prop, Qunderline) || | |
251 EQ (prop, Qstrikethru) || | |
252 EQ (prop, Qhighlight) || | |
253 EQ (prop, Qdim) || | |
254 EQ (prop, Qblinking) || | |
255 EQ (prop, Qreverse)) | |
256 return -1; | |
257 | |
258 if (EQ (prop, Qdoc_string)) | |
259 { | |
260 f->doc_string = Qnil; | |
261 return 1; | |
262 } | |
263 | |
264 return external_remprop (&f->plist, prop, 0, ERROR_ME); | |
265 } | |
266 | |
267 static Lisp_Object | |
268 face_plist (Lisp_Object obj) | |
269 { | |
440 | 270 Lisp_Face *face = XFACE (obj); |
428 | 271 Lisp_Object result = face->plist; |
272 | |
273 result = cons3 (Qreverse, face->reverse, result); | |
274 result = cons3 (Qblinking, face->blinking, result); | |
275 result = cons3 (Qdim, face->dim, result); | |
276 result = cons3 (Qhighlight, face->highlight, result); | |
277 result = cons3 (Qstrikethru, face->strikethru, result); | |
278 result = cons3 (Qunderline, face->underline, result); | |
279 result = cons3 (Qbackground_pixmap, face->background_pixmap, result); | |
280 result = cons3 (Qdisplay_table, face->display_table, result); | |
281 result = cons3 (Qfont, face->font, result); | |
282 result = cons3 (Qbackground, face->background, result); | |
283 result = cons3 (Qforeground, face->foreground, result); | |
284 | |
285 return result; | |
286 } | |
287 | |
1204 | 288 static const struct memory_description face_description[] = { |
440 | 289 { XD_LISP_OBJECT, offsetof (Lisp_Face, name) }, |
290 { XD_LISP_OBJECT, offsetof (Lisp_Face, doc_string) }, | |
291 { XD_LISP_OBJECT, offsetof (Lisp_Face, foreground) }, | |
292 { XD_LISP_OBJECT, offsetof (Lisp_Face, background) }, | |
293 { XD_LISP_OBJECT, offsetof (Lisp_Face, font) }, | |
294 { XD_LISP_OBJECT, offsetof (Lisp_Face, display_table) }, | |
295 { XD_LISP_OBJECT, offsetof (Lisp_Face, background_pixmap) }, | |
296 { XD_LISP_OBJECT, offsetof (Lisp_Face, underline) }, | |
297 { XD_LISP_OBJECT, offsetof (Lisp_Face, strikethru) }, | |
298 { XD_LISP_OBJECT, offsetof (Lisp_Face, highlight) }, | |
299 { XD_LISP_OBJECT, offsetof (Lisp_Face, dim) }, | |
300 { XD_LISP_OBJECT, offsetof (Lisp_Face, blinking) }, | |
301 { XD_LISP_OBJECT, offsetof (Lisp_Face, reverse) }, | |
302 { XD_LISP_OBJECT, offsetof (Lisp_Face, plist) }, | |
303 { XD_LISP_OBJECT, offsetof (Lisp_Face, charsets_warned_about) }, | |
428 | 304 { XD_END } |
305 }; | |
306 | |
934 | 307 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face, |
308 1, /*dumpable-flag*/ | |
309 mark_face, print_face, 0, face_equal, | |
1204 | 310 face_hash, face_description, |
311 face_getprop, | |
934 | 312 face_putprop, face_remprop, |
313 face_plist, Lisp_Face); | |
428 | 314 |
315 /************************************************************************/ | |
316 /* face read syntax */ | |
317 /************************************************************************/ | |
318 | |
319 static int | |
2286 | 320 face_name_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
578 | 321 Error_Behavior errb) |
428 | 322 { |
323 if (ERRB_EQ (errb, ERROR_ME)) | |
324 { | |
325 CHECK_SYMBOL (value); | |
326 return 1; | |
327 } | |
328 | |
329 return SYMBOLP (value); | |
330 } | |
331 | |
332 static int | |
578 | 333 face_validate (Lisp_Object data, Error_Behavior errb) |
428 | 334 { |
335 int name_seen = 0; | |
336 Lisp_Object valw = Qnil; | |
337 | |
338 data = Fcdr (data); /* skip over Qface */ | |
339 while (!NILP (data)) | |
340 { | |
341 Lisp_Object keyw = Fcar (data); | |
342 | |
343 data = Fcdr (data); | |
344 valw = Fcar (data); | |
345 data = Fcdr (data); | |
346 if (EQ (keyw, Qname)) | |
347 name_seen = 1; | |
348 else | |
2500 | 349 ABORT (); |
428 | 350 } |
351 | |
352 if (!name_seen) | |
353 { | |
563 | 354 maybe_sferror ("No face name given", Qunbound, Qface, errb); |
428 | 355 return 0; |
356 } | |
357 | |
358 if (NILP (Ffind_face (valw))) | |
359 { | |
563 | 360 maybe_invalid_argument ("No such face", valw, Qface, errb); |
428 | 361 return 0; |
362 } | |
363 | |
364 return 1; | |
365 } | |
366 | |
367 static Lisp_Object | |
368 face_instantiate (Lisp_Object data) | |
369 { | |
370 return Fget_face (Fcar (Fcdr (data))); | |
371 } | |
372 | |
373 | |
374 /**************************************************************************** | |
375 * utility functions * | |
376 ****************************************************************************/ | |
377 | |
378 static void | |
440 | 379 reset_face (Lisp_Face *f) |
428 | 380 { |
381 f->name = Qnil; | |
382 f->doc_string = Qnil; | |
383 f->dirty = 0; | |
384 f->foreground = Qnil; | |
385 f->background = Qnil; | |
386 f->font = Qnil; | |
387 f->display_table = Qnil; | |
388 f->background_pixmap = Qnil; | |
389 f->underline = Qnil; | |
390 f->strikethru = Qnil; | |
391 f->highlight = Qnil; | |
392 f->dim = Qnil; | |
393 f->blinking = Qnil; | |
394 f->reverse = Qnil; | |
395 f->plist = Qnil; | |
396 f->charsets_warned_about = Qnil; | |
397 } | |
398 | |
440 | 399 static Lisp_Face * |
428 | 400 allocate_face (void) |
401 { | |
3017 | 402 Lisp_Face *result = ALLOC_LCRECORD_TYPE (Lisp_Face, &lrecord_face); |
428 | 403 |
404 reset_face (result); | |
405 return result; | |
406 } | |
407 | |
408 | |
409 /* We store the faces in hash tables with the names as the key and the | |
410 actual face object as the value. Occasionally we need to use them | |
411 in a list format. These routines provide us with that. */ | |
412 struct face_list_closure | |
413 { | |
414 Lisp_Object *face_list; | |
415 }; | |
416 | |
417 static int | |
2286 | 418 add_face_to_list_mapper (Lisp_Object UNUSED (key), Lisp_Object value, |
428 | 419 void *face_list_closure) |
420 { | |
421 /* This function can GC */ | |
422 struct face_list_closure *fcl = | |
423 (struct face_list_closure *) face_list_closure; | |
424 | |
425 *(fcl->face_list) = Fcons (XFACE (value)->name, (*fcl->face_list)); | |
426 return 0; | |
427 } | |
428 | |
429 static Lisp_Object | |
430 faces_list_internal (Lisp_Object list) | |
431 { | |
432 Lisp_Object face_list = Qnil; | |
433 struct gcpro gcpro1; | |
434 struct face_list_closure face_list_closure; | |
435 | |
436 GCPRO1 (face_list); | |
437 face_list_closure.face_list = &face_list; | |
438 elisp_maphash (add_face_to_list_mapper, list, &face_list_closure); | |
439 UNGCPRO; | |
440 | |
441 return face_list; | |
442 } | |
443 | |
444 static Lisp_Object | |
445 permanent_faces_list (void) | |
446 { | |
447 return faces_list_internal (Vpermanent_faces_cache); | |
448 } | |
449 | |
450 static Lisp_Object | |
451 temporary_faces_list (void) | |
452 { | |
453 return faces_list_internal (Vtemporary_faces_cache); | |
454 } | |
455 | |
456 | |
457 static int | |
2286 | 458 mark_face_as_clean_mapper (Lisp_Object UNUSED (key), Lisp_Object value, |
428 | 459 void *flag_closure) |
460 { | |
461 /* This function can GC */ | |
462 int *flag = (int *) flag_closure; | |
463 XFACE (value)->dirty = *flag; | |
464 return 0; | |
465 } | |
466 | |
467 static void | |
468 mark_all_faces_internal (int flag) | |
469 { | |
470 elisp_maphash (mark_face_as_clean_mapper, Vpermanent_faces_cache, &flag); | |
471 elisp_maphash (mark_face_as_clean_mapper, Vtemporary_faces_cache, &flag); | |
472 } | |
473 | |
474 void | |
475 mark_all_faces_as_clean (void) | |
476 { | |
477 mark_all_faces_internal (0); | |
478 } | |
479 | |
480 /* Currently unused (see the comment in face_property_was_changed()). */ | |
481 #if 0 | |
482 /* #### OBSOLETE ME, PLEASE. Maybe. Maybe this is just as good as | |
483 any other solution. */ | |
484 struct face_inheritance_closure | |
485 { | |
486 Lisp_Object face; | |
487 Lisp_Object property; | |
488 }; | |
489 | |
490 static void | |
491 update_inheritance_mapper_internal (Lisp_Object cur_face, | |
492 Lisp_Object inh_face, | |
493 Lisp_Object property) | |
494 { | |
495 /* #### fix this function */ | |
496 Lisp_Object elt = Qnil; | |
497 struct gcpro gcpro1; | |
498 | |
499 GCPRO1 (elt); | |
500 | |
501 for (elt = FACE_PROPERTY_SPEC_LIST (cur_face, property, Qall); | |
502 !NILP (elt); | |
503 elt = XCDR (elt)) | |
504 { | |
505 Lisp_Object values = XCDR (XCAR (elt)); | |
506 | |
507 for (; !NILP (values); values = XCDR (values)) | |
508 { | |
509 Lisp_Object value = XCDR (XCAR (values)); | |
510 if (VECTORP (value) && XVECTOR_LENGTH (value)) | |
511 { | |
512 if (EQ (Ffind_face (XVECTOR_DATA (value)[0]), inh_face)) | |
513 Fset_specifier_dirty_flag | |
514 (FACE_PROPERTY_SPECIFIER (inh_face, property)); | |
515 } | |
516 } | |
517 } | |
518 | |
519 UNGCPRO; | |
520 } | |
521 | |
522 static int | |
442 | 523 update_face_inheritance_mapper (const void *hash_key, void *hash_contents, |
428 | 524 void *face_inheritance_closure) |
525 { | |
526 Lisp_Object key, contents; | |
527 struct face_inheritance_closure *fcl = | |
528 (struct face_inheritance_closure *) face_inheritance_closure; | |
529 | |
5013 | 530 key = GET_LISP_FROM_VOID (hash_key); |
531 contents = GET_LISP_FROM_VOID (hash_contents); | |
428 | 532 |
533 if (EQ (fcl->property, Qfont)) | |
534 { | |
535 update_inheritance_mapper_internal (contents, fcl->face, Qfont); | |
536 } | |
537 else if (EQ (fcl->property, Qforeground) || | |
538 EQ (fcl->property, Qbackground)) | |
539 { | |
540 update_inheritance_mapper_internal (contents, fcl->face, Qforeground); | |
541 update_inheritance_mapper_internal (contents, fcl->face, Qbackground); | |
542 } | |
543 else if (EQ (fcl->property, Qunderline) || | |
544 EQ (fcl->property, Qstrikethru) || | |
545 EQ (fcl->property, Qhighlight) || | |
546 EQ (fcl->property, Qdim) || | |
547 EQ (fcl->property, Qblinking) || | |
548 EQ (fcl->property, Qreverse)) | |
549 { | |
550 update_inheritance_mapper_internal (contents, fcl->face, Qunderline); | |
551 update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru); | |
552 update_inheritance_mapper_internal (contents, fcl->face, Qhighlight); | |
553 update_inheritance_mapper_internal (contents, fcl->face, Qdim); | |
554 update_inheritance_mapper_internal (contents, fcl->face, Qblinking); | |
555 update_inheritance_mapper_internal (contents, fcl->face, Qreverse); | |
556 } | |
557 return 0; | |
558 } | |
559 | |
560 static void | |
561 update_faces_inheritance (Lisp_Object face, Lisp_Object property) | |
562 { | |
563 struct face_inheritance_closure face_inheritance_closure; | |
564 struct gcpro gcpro1, gcpro2; | |
565 | |
566 GCPRO2 (face, property); | |
567 face_inheritance_closure.face = face; | |
568 face_inheritance_closure.property = property; | |
569 | |
570 elisp_maphash (update_face_inheritance_mapper, Vpermanent_faces_cache, | |
571 &face_inheritance_closure); | |
572 elisp_maphash (update_face_inheritance_mapper, Vtemporary_faces_cache, | |
573 &face_inheritance_closure); | |
574 | |
575 UNGCPRO; | |
576 } | |
577 #endif /* 0 */ | |
578 | |
579 Lisp_Object | |
580 face_property_matching_instance (Lisp_Object face, Lisp_Object property, | |
581 Lisp_Object charset, Lisp_Object domain, | |
578 | 582 Error_Behavior errb, int no_fallback, |
3659 | 583 Lisp_Object depth, |
584 enum font_specifier_matchspec_stages stage) | |
428 | 585 { |
771 | 586 Lisp_Object retval; |
872 | 587 Lisp_Object matchspec = Qunbound; |
588 struct gcpro gcpro1; | |
771 | 589 |
872 | 590 if (!NILP (charset)) |
4187 | 591 matchspec = noseeum_cons (charset, |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
592 stage == STAGE_INITIAL ? Qinitial : Qfinal); |
3659 | 593 |
872 | 594 GCPRO1 (matchspec); |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
595 /* This call to specifier_instance_no_quit(), will end up calling |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
596 font_instantiate() if the property in a question is a font (currently, |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
597 this means EQ (property, Qfont), because only the face property named |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
598 `font' contains a font object). See the comments there. */ |
872 | 599 retval = specifier_instance_no_quit (Fget (face, property, Qnil), matchspec, |
771 | 600 domain, errb, no_fallback, depth); |
872 | 601 UNGCPRO; |
602 if (CONSP (matchspec)) | |
603 free_cons (matchspec); | |
428 | 604 |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
605 if (UNBOUNDP (retval) && !no_fallback && STAGE_FINAL == stage) |
428 | 606 { |
607 if (EQ (property, Qfont)) | |
608 { | |
609 if (NILP (memq_no_quit (charset, | |
610 XFACE (face)->charsets_warned_about))) | |
611 { | |
793 | 612 if (!UNBOUNDP (charset)) |
428 | 613 warn_when_safe |
793 | 614 (Qfont, Qnotice, |
615 "Unable to instantiate font for charset %s, face %s", | |
616 XSTRING_DATA (symbol_name | |
617 (XSYMBOL (XCHARSET_NAME (charset)))), | |
618 XSTRING_DATA (symbol_name | |
619 (XSYMBOL (XFACE (face)->name)))); | |
428 | 620 XFACE (face)->charsets_warned_about = |
621 Fcons (charset, XFACE (face)->charsets_warned_about); | |
622 } | |
623 retval = Vthe_null_font_instance; | |
624 } | |
625 } | |
626 | |
627 return retval; | |
628 } | |
629 | |
630 | |
631 DEFUN ("facep", Ffacep, 1, 1, 0, /* | |
444 | 632 Return t if OBJECT is a face. |
428 | 633 */ |
634 (object)) | |
635 { | |
636 return FACEP (object) ? Qt : Qnil; | |
637 } | |
638 | |
639 DEFUN ("find-face", Ffind_face, 1, 1, 0, /* | |
640 Retrieve the face of the given name. | |
641 If FACE-OR-NAME is a face object, it is simply returned. | |
642 Otherwise, FACE-OR-NAME should be a symbol. If there is no such face, | |
643 nil is returned. Otherwise the associated face object is returned. | |
644 */ | |
645 (face_or_name)) | |
646 { | |
647 Lisp_Object retval; | |
2865 | 648 Lisp_Object face_name; |
649 Lisp_Object face_alias; | |
650 int i; | |
428 | 651 |
652 if (FACEP (face_or_name)) | |
653 return face_or_name; | |
2865 | 654 |
655 face_name = face_or_name; | |
656 CHECK_SYMBOL (face_name); | |
657 | |
2867 | 658 # define FACE_ALIAS_MAX_DEPTH 32 |
2865 | 659 |
660 i = 0; | |
661 while (! NILP ((face_alias = Fget (face_name, Qface_alias, Qnil))) | |
2867 | 662 && i < FACE_ALIAS_MAX_DEPTH) |
2865 | 663 { |
664 face_name = face_alias; | |
665 CHECK_SYMBOL (face_alias); | |
666 i += 1; | |
667 } | |
668 | |
669 /* #### This test actually makes the aliasing max depth to 30, which is more | |
670 #### than enough IMO. -- dvl */ | |
2867 | 671 if (i == FACE_ALIAS_MAX_DEPTH) |
672 signal_error (Qcyclic_face_alias, | |
2865 | 673 "Max face aliasing depth reached", |
674 face_name); | |
675 | |
2867 | 676 # undef FACE_ALIAS_MAX_DEPTH |
428 | 677 |
678 /* Check if the name represents a permanent face. */ | |
2865 | 679 retval = Fgethash (face_name, Vpermanent_faces_cache, Qnil); |
428 | 680 if (!NILP (retval)) |
681 return retval; | |
682 | |
683 /* Check if the name represents a temporary face. */ | |
2865 | 684 return Fgethash (face_name, Vtemporary_faces_cache, Qnil); |
428 | 685 } |
686 | |
687 DEFUN ("get-face", Fget_face, 1, 1, 0, /* | |
688 Retrieve the face of the given name. | |
689 Same as `find-face' except an error is signalled if there is no such | |
690 face instead of returning nil. | |
691 */ | |
692 (name)) | |
693 { | |
694 Lisp_Object face = Ffind_face (name); | |
695 | |
696 if (NILP (face)) | |
563 | 697 invalid_argument ("No such face", name); |
428 | 698 return face; |
699 } | |
700 | |
701 DEFUN ("face-name", Fface_name, 1, 1, 0, /* | |
702 Return the name of the given face. | |
703 */ | |
704 (face)) | |
705 { | |
706 return XFACE (Fget_face (face))->name; | |
707 } | |
708 | |
709 DEFUN ("built-in-face-specifiers", Fbuilt_in_face_specifiers, 0, 0, 0, /* | |
710 Return a list of all built-in face specifier properties. | |
4534
f32c7f843961
#'built-in-face-specifiers; document that we're returning a copy.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4532
diff
changeset
|
711 |
f32c7f843961
#'built-in-face-specifiers; document that we're returning a copy.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4532
diff
changeset
|
712 This is a copy; there is no way to modify XEmacs' idea of the built-in face |
f32c7f843961
#'built-in-face-specifiers; document that we're returning a copy.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4532
diff
changeset
|
713 specifier properties from Lisp. |
428 | 714 */ |
715 ()) | |
716 { | |
4532
16906fefc8df
Return a list copy in #'built-in-face-specifiers, pre-empting modification.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4210
diff
changeset
|
717 return Fcopy_list(Vbuilt_in_face_specifiers); |
428 | 718 } |
719 | |
720 /* These values are retrieved so often that we make a special | |
721 function. | |
722 */ | |
723 | |
724 void | |
725 default_face_font_info (Lisp_Object domain, int *ascent, int *descent, | |
726 int *height, int *width, int *proportional_p) | |
727 { | |
728 Lisp_Object font_instance; | |
3707 | 729 struct face_cachel *cachel; |
730 struct window *w = NULL; | |
428 | 731 |
732 if (noninteractive) | |
733 { | |
734 if (ascent) | |
4187 | 735 *ascent = 1; |
428 | 736 if (descent) |
4187 | 737 *descent = 0; |
428 | 738 if (height) |
4187 | 739 *height = 1; |
428 | 740 if (width) |
4187 | 741 *width = 1; |
428 | 742 if (proportional_p) |
4187 | 743 *proportional_p = 0; |
428 | 744 return; |
745 } | |
746 | |
3707 | 747 /* We use ASCII here. This is reasonable because the people calling this |
748 function are using the resulting values to come up with overall sizes | |
4187 | 749 for windows and frames. |
3707 | 750 |
751 It's possible for this function to get called when the face cachels | |
752 have not been initialized--put a call to debug-print in | |
753 init-locale-at-early-startup to see it happen. */ | |
754 | |
755 if (WINDOWP (domain) && (w = XWINDOW (domain)) && w->face_cachels) | |
428 | 756 { |
757 if (!Dynarr_length (w->face_cachels)) | |
4187 | 758 reset_face_cachels (w); |
428 | 759 cachel = WINDOW_FACE_CACHEL (w, DEFAULT_INDEX); |
760 font_instance = FACE_CACHEL_FONT (cachel, Vcharset_ascii); | |
761 } | |
762 else | |
763 { | |
764 font_instance = FACE_FONT (Vdefault_face, domain, Vcharset_ascii); | |
765 } | |
766 | |
3707 | 767 if (UNBOUNDP (font_instance)) |
768 { | |
769 return; | |
770 } | |
771 | |
428 | 772 if (height) |
773 *height = XFONT_INSTANCE (font_instance)->height; | |
774 if (width) | |
775 *width = XFONT_INSTANCE (font_instance)->width; | |
776 if (ascent) | |
777 *ascent = XFONT_INSTANCE (font_instance)->ascent; | |
778 if (descent) | |
779 *descent = XFONT_INSTANCE (font_instance)->descent; | |
780 if (proportional_p) | |
781 *proportional_p = XFONT_INSTANCE (font_instance)->proportional_p; | |
782 } | |
783 | |
784 void | |
785 default_face_height_and_width (Lisp_Object domain, | |
786 int *height, int *width) | |
787 { | |
788 default_face_font_info (domain, 0, 0, height, width, 0); | |
789 } | |
790 | |
791 DEFUN ("face-list", Fface_list, 0, 1, 0, /* | |
792 Return a list of the names of all defined faces. | |
793 If TEMPORARY is nil, only the permanent faces are included. | |
794 If it is t, only the temporary faces are included. If it is any | |
795 other non-nil value both permanent and temporary are included. | |
796 */ | |
797 (temporary)) | |
798 { | |
799 Lisp_Object face_list = Qnil; | |
800 | |
801 /* Added the permanent faces, if requested. */ | |
802 if (NILP (temporary) || !EQ (Qt, temporary)) | |
803 face_list = permanent_faces_list (); | |
804 | |
805 if (!NILP (temporary)) | |
806 { | |
807 struct gcpro gcpro1; | |
808 GCPRO1 (face_list); | |
809 face_list = nconc2 (face_list, temporary_faces_list ()); | |
810 UNGCPRO; | |
811 } | |
812 | |
813 return face_list; | |
814 } | |
815 | |
816 DEFUN ("make-face", Fmake_face, 1, 3, 0, /* | |
444 | 817 Define a new face with name NAME (a symbol), described by DOC-STRING. |
818 You can modify the font, color, etc. of a face with the set-face-* functions. | |
428 | 819 If the face already exists, it is unmodified. |
820 If TEMPORARY is non-nil, this face will cease to exist if not in use. | |
821 */ | |
822 (name, doc_string, temporary)) | |
823 { | |
824 /* This function can GC if initialized is non-zero */ | |
440 | 825 Lisp_Face *f; |
428 | 826 Lisp_Object face; |
827 | |
828 CHECK_SYMBOL (name); | |
829 if (!NILP (doc_string)) | |
830 CHECK_STRING (doc_string); | |
831 | |
832 face = Ffind_face (name); | |
833 if (!NILP (face)) | |
834 return face; | |
835 | |
836 f = allocate_face (); | |
793 | 837 face = wrap_face (f); |
428 | 838 |
839 f->name = name; | |
840 f->doc_string = doc_string; | |
841 f->foreground = Fmake_specifier (Qcolor); | |
842 set_color_attached_to (f->foreground, face, Qforeground); | |
843 f->background = Fmake_specifier (Qcolor); | |
844 set_color_attached_to (f->background, face, Qbackground); | |
845 f->font = Fmake_specifier (Qfont); | |
846 set_font_attached_to (f->font, face, Qfont); | |
847 f->background_pixmap = Fmake_specifier (Qimage); | |
848 set_image_attached_to (f->background_pixmap, face, Qbackground_pixmap); | |
849 f->display_table = Fmake_specifier (Qdisplay_table); | |
850 f->underline = Fmake_specifier (Qface_boolean); | |
851 set_face_boolean_attached_to (f->underline, face, Qunderline); | |
852 f->strikethru = Fmake_specifier (Qface_boolean); | |
853 set_face_boolean_attached_to (f->strikethru, face, Qstrikethru); | |
854 f->highlight = Fmake_specifier (Qface_boolean); | |
855 set_face_boolean_attached_to (f->highlight, face, Qhighlight); | |
856 f->dim = Fmake_specifier (Qface_boolean); | |
857 set_face_boolean_attached_to (f->dim, face, Qdim); | |
858 f->blinking = Fmake_specifier (Qface_boolean); | |
859 set_face_boolean_attached_to (f->blinking, face, Qblinking); | |
860 f->reverse = Fmake_specifier (Qface_boolean); | |
861 set_face_boolean_attached_to (f->reverse, face, Qreverse); | |
862 if (!NILP (Vdefault_face)) | |
863 { | |
864 /* If the default face has already been created, set it as | |
865 the default fallback specifier for all the specifiers we | |
866 just created. This implements the standard "all faces | |
867 inherit from default" behavior. */ | |
868 set_specifier_fallback (f->foreground, | |
869 Fget (Vdefault_face, Qforeground, Qunbound)); | |
870 set_specifier_fallback (f->background, | |
871 Fget (Vdefault_face, Qbackground, Qunbound)); | |
872 set_specifier_fallback (f->font, | |
873 Fget (Vdefault_face, Qfont, Qunbound)); | |
874 set_specifier_fallback (f->background_pixmap, | |
875 Fget (Vdefault_face, Qbackground_pixmap, | |
876 Qunbound)); | |
877 set_specifier_fallback (f->display_table, | |
878 Fget (Vdefault_face, Qdisplay_table, Qunbound)); | |
879 set_specifier_fallback (f->underline, | |
880 Fget (Vdefault_face, Qunderline, Qunbound)); | |
881 set_specifier_fallback (f->strikethru, | |
882 Fget (Vdefault_face, Qstrikethru, Qunbound)); | |
883 set_specifier_fallback (f->highlight, | |
884 Fget (Vdefault_face, Qhighlight, Qunbound)); | |
885 set_specifier_fallback (f->dim, | |
886 Fget (Vdefault_face, Qdim, Qunbound)); | |
887 set_specifier_fallback (f->blinking, | |
888 Fget (Vdefault_face, Qblinking, Qunbound)); | |
889 set_specifier_fallback (f->reverse, | |
890 Fget (Vdefault_face, Qreverse, Qunbound)); | |
891 } | |
892 | |
893 /* Add the face to the appropriate list. */ | |
894 if (NILP (temporary)) | |
895 Fputhash (name, face, Vpermanent_faces_cache); | |
896 else | |
897 Fputhash (name, face, Vtemporary_faces_cache); | |
898 | |
899 /* Note that it's OK if we dump faces. | |
900 When we start up again when we're not noninteractive, | |
901 `init-global-faces' is called and it resources all | |
902 existing faces. */ | |
903 if (initialized && !noninteractive) | |
904 { | |
905 struct gcpro gcpro1, gcpro2; | |
906 | |
907 GCPRO2 (name, face); | |
908 call1 (Qinit_face_from_resources, name); | |
909 UNGCPRO; | |
910 } | |
911 | |
912 return face; | |
913 } | |
914 | |
915 | |
916 /***************************************************************************** | |
917 initialization code | |
918 ****************************************************************************/ | |
919 | |
920 void | |
921 init_global_faces (struct device *d) | |
922 { | |
923 /* When making the initial terminal device, there is no Lisp code | |
924 loaded, so we can't do this. */ | |
925 if (initialized && !noninteractive) | |
872 | 926 call_critical_lisp_code (d, Qinit_global_faces, wrap_device (d)); |
428 | 927 } |
928 | |
929 void | |
930 init_device_faces (struct device *d) | |
931 { | |
932 /* This function can call lisp */ | |
933 | |
934 /* When making the initial terminal device, there is no Lisp code | |
935 loaded, so we can't do this. */ | |
936 if (initialized) | |
872 | 937 call_critical_lisp_code (d, Qinit_device_faces, wrap_device (d)); |
428 | 938 } |
939 | |
940 void | |
941 init_frame_faces (struct frame *frm) | |
942 { | |
943 /* When making the initial terminal device, there is no Lisp code | |
944 loaded, so we can't do this. */ | |
945 if (initialized) | |
946 { | |
793 | 947 Lisp_Object tframe = wrap_frame (frm); |
948 | |
428 | 949 |
950 /* DO NOT change the selected frame here. If the debugger goes off | |
4187 | 951 it will try and display on the frame being created, but it is not |
952 ready for that yet and a horrible death will occur. Any random | |
953 code depending on the selected-frame as an implicit arg should be | |
954 tracked down and shot. For the benefit of the one known, | |
955 xpm-color-symbols, make-frame sets the variable | |
956 Vframe_being_created to the frame it is making and sets it to nil | |
957 when done. Internal functions that this could trigger which are | |
958 currently depending on selected-frame should use this instead. It | |
959 is not currently visible at the lisp level. */ | |
428 | 960 call_critical_lisp_code (XDEVICE (FRAME_DEVICE (frm)), |
961 Qinit_frame_faces, tframe); | |
962 } | |
963 } | |
964 | |
965 | |
966 /**************************************************************************** | |
967 * face cache element functions * | |
968 ****************************************************************************/ | |
969 | |
970 /* | |
971 | |
972 #### Here is a description of how the face cache elements ought | |
973 to be redone. It is *NOT* how they work currently: | |
974 | |
975 However, when I started to go about implementing this, I realized | |
976 that there are all sorts of subtle problems with cache coherency | |
977 that are coming up. As it turns out, these problems don't | |
978 manifest themselves now due to the brute-force "kill 'em all" | |
979 approach to cache invalidation when faces change; but if this | |
980 is ever made smarter, these problems are going to come up, and | |
981 some of them are very non-obvious. | |
982 | |
983 I'm thinking of redoing the cache code a bit to avoid these | |
984 coherency problems. The bulk of the problems will arise because | |
985 the current display structures have simple indices into the | |
986 face cache, but the cache can be changed at various times, | |
987 which could make the current display structures incorrect. | |
988 I guess the dirty and updated flags are an attempt to fix | |
989 this, but this approach doesn't really work. | |
990 | |
991 Here's an approach that should keep things clean and unconfused: | |
992 | |
993 1) Imagine a "virtual face cache" that can grow arbitrarily | |
994 big and for which the only thing allowed is to add new | |
995 elements. Existing elements cannot be removed or changed. | |
996 This way, any pointers in the existing redisplay structure | |
997 into the cache never get screwed up. (This is important | |
998 because even if a cache element is out of date, if there's | |
999 a pointer to it then its contents still accurately describe | |
1000 the way the text currently looks on the screen.) | |
1001 2) Each element in the virtual cache either describes exactly | |
1002 one face, or describes the merger of a number of faces | |
1003 by some process. In order to simplify things, for mergers | |
1004 we do not record which faces or ordering was used, but | |
1005 simply that this cache element is the result of merging. | |
1006 Unlike the current implementation, it's important that a | |
1007 single cache element not be used to both describe a | |
1008 single face and describe a merger, even if all the property | |
1009 values are the same. | |
1010 3) Each cache element can be clean or dirty. "Dirty" means | |
1011 that the face that the element points to has been changed; | |
1012 this gets set at the time the face is changed. This | |
1013 way, when looking up a value in the cache, you can determine | |
1014 whether it's out of date or not. For merged faces it | |
1015 does not matter -- we don't record the faces or priority | |
1016 used to create the merger, so it's impossible to look up | |
1017 one of these faces. We have to recompute it each time. | |
1018 Luckily, this is fine -- doing the merge is much | |
1019 less expensive than recomputing the properties of a | |
1020 single face. | |
1021 4) For each cache element, we keep a hash value. (In order | |
1022 to hash the boolean properties, we convert each of them | |
1023 into a different large prime number so that the hashing works | |
1024 well.) This allows us, when comparing runes, to properly | |
1025 determine whether the face for that rune has changed. | |
1026 This will be especially important for TTY's, where there | |
1027 aren't that many faces and minimizing redraw is very | |
1028 important. | |
1029 5) We can't actually keep an infinite cache, but that doesn't | |
1030 really matter that much. The only elements we care about | |
1031 are those that are used by either the current or desired | |
1032 display structs. Therefore, we keep a per-window | |
1033 redisplay iteration number, and mark each element with | |
1034 that number as we use it. Just after outputting the | |
1035 window and synching the redisplay structs, we go through | |
1036 the cache and invalidate all elements that are not clean | |
1037 elements referring to a particular face and that do not | |
1038 have an iteration number equal to the current one. We | |
1039 keep them in a chain, and use them to allocate new | |
1040 elements when possible instead of increasing the Dynarr. | |
1041 | |
872 | 1042 --ben (?? At least I think I wrote this!) |
428 | 1043 */ |
1044 | |
1045 /* mark for GC a dynarr of face cachels. */ | |
1046 | |
1047 void | |
1048 mark_face_cachels (face_cachel_dynarr *elements) | |
1049 { | |
1050 int elt; | |
1051 | |
1052 if (!elements) | |
1053 return; | |
1054 | |
1055 for (elt = 0; elt < Dynarr_length (elements); elt++) | |
1056 { | |
1057 struct face_cachel *cachel = Dynarr_atp (elements, elt); | |
1058 | |
1059 { | |
1060 int i; | |
1061 | |
1062 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
1063 if (!NILP (cachel->font[i]) && !UNBOUNDP (cachel->font[i])) | |
1064 mark_object (cachel->font[i]); | |
1065 } | |
1066 mark_object (cachel->face); | |
1067 mark_object (cachel->foreground); | |
1068 mark_object (cachel->background); | |
1069 mark_object (cachel->display_table); | |
1070 mark_object (cachel->background_pixmap); | |
1071 } | |
1072 } | |
1073 | |
1074 /* ensure that the given cachel contains an updated font value for | |
3094 | 1075 the given charset. Return the updated font value (which can be |
1076 Qunbound, so this value must not be passed unchecked to Lisp). | |
1077 | |
1078 #### Xft: This function will need to be updated for new font model. */ | |
428 | 1079 |
1080 Lisp_Object | |
1081 ensure_face_cachel_contains_charset (struct face_cachel *cachel, | |
1082 Lisp_Object domain, Lisp_Object charset) | |
1083 { | |
1084 Lisp_Object new_val; | |
1085 Lisp_Object face = cachel->face; | |
3659 | 1086 int bound = 1, final_stage = 0; |
428 | 1087 int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; |
1088 | |
4187 | 1089 if (!UNBOUNDP (cachel->font[offs]) && |
3659 | 1090 bit_vector_bit(FACE_CACHEL_FONT_UPDATED (cachel), offs)) |
428 | 1091 return cachel->font[offs]; |
1092 | |
1093 if (UNBOUNDP (face)) | |
1094 { | |
1095 /* a merged face. */ | |
1096 int i; | |
1097 struct window *w = XWINDOW (domain); | |
1098 | |
1099 new_val = Qunbound; | |
3659 | 1100 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 0); |
1101 | |
428 | 1102 for (i = 0; i < cachel->nfaces; i++) |
1103 { | |
1104 struct face_cachel *oth; | |
1105 | |
1106 oth = Dynarr_atp (w->face_cachels, | |
1107 FACE_CACHEL_FINDEX_UNSAFE (cachel, i)); | |
1108 /* Tout le monde aime la recursion */ | |
1109 ensure_face_cachel_contains_charset (oth, domain, charset); | |
1110 | |
3659 | 1111 if (bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(oth), offs)) |
428 | 1112 { |
1113 new_val = oth->font[offs]; | |
3659 | 1114 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1); |
1115 set_bit_vector_bit | |
4187 | 1116 (FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs, |
3659 | 1117 bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(oth), offs)); |
428 | 1118 break; |
1119 } | |
1120 } | |
1121 | |
3659 | 1122 if (!bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs)) |
428 | 1123 /* need to do the default face. */ |
1124 { | |
1125 struct face_cachel *oth = | |
1126 Dynarr_atp (w->face_cachels, DEFAULT_INDEX); | |
1127 ensure_face_cachel_contains_charset (oth, domain, charset); | |
1128 | |
1129 new_val = oth->font[offs]; | |
1130 } | |
1131 | |
4187 | 1132 if (!UNBOUNDP (cachel->font[offs]) && |
3659 | 1133 !EQ (cachel->font[offs], new_val)) |
428 | 1134 cachel->dirty = 1; |
3659 | 1135 set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1); |
428 | 1136 cachel->font[offs] = new_val; |
3659 | 1137 DEBUG_FACES("just recursed on the unbound face, returning " |
1138 "something %s\n", UNBOUNDP(new_val) ? "not bound" | |
1139 : "bound"); | |
428 | 1140 return new_val; |
1141 } | |
1142 | |
3659 | 1143 do { |
1144 | |
1145 /* Lookup the face, specifying the initial stage and that fallbacks | |
1146 shouldn't happen. */ | |
1147 new_val = face_property_matching_instance (face, Qfont, charset, domain, | |
1148 /* ERROR_ME_DEBUG_WARN is | |
1149 fine here. */ | |
1150 ERROR_ME_DEBUG_WARN, 1, Qzero, | |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1151 STAGE_INITIAL); |
3659 | 1152 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " |
4187 | 1153 "result was something %s\n", |
1154 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), | |
3659 | 1155 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), |
1156 UNBOUNDP(new_val) ? "not bound" : "bound"); | |
1157 | |
1158 if (!UNBOUNDP (new_val)) break; | |
1159 | |
1160 bound = 0; | |
1161 /* Lookup the face again, this time allowing the fallback. If this | |
1162 succeeds, it'll give a font intended for the script in question, | |
1163 which is preferable to translating to ISO10646-1 and using the | |
4667
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1164 fixed-width fallback. |
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1165 |
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1166 #### This is questionable. The problem is that unusual scripts |
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1167 will typically fallback to the hard-coded values as the user is |
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1168 unlikely to have specified them herself, a common complaint. */ |
3659 | 1169 new_val = face_property_matching_instance (face, Qfont, |
1170 charset, domain, | |
1171 ERROR_ME_DEBUG_WARN, 0, | |
4187 | 1172 Qzero, |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1173 STAGE_INITIAL); |
3659 | 1174 |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1175 DEBUG_FACES ("just called f_p_m_i on face %s, charset %s, initial, " |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1176 "allow fallback, result was something %s\n", |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1177 XSTRING_DATA (XSYMBOL_NAME (XFACE (cachel->face)->name)), |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1178 XSTRING_DATA (XSYMBOL_NAME (XCHARSET_NAME (charset))), |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1179 UNBOUNDP (new_val) ? "not bound" : "bound"); |
3659 | 1180 |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1181 if (!UNBOUNDP (new_val)) |
3659 | 1182 { |
1183 break; | |
1184 } | |
1185 | |
1186 bound = 1; | |
1187 /* Try the face itself with the final-stage specifiers. */ | |
1188 new_val = face_property_matching_instance (face, Qfont, | |
1189 charset, domain, | |
1190 ERROR_ME_DEBUG_WARN, 1, | |
4187 | 1191 Qzero, |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1192 STAGE_FINAL); |
3659 | 1193 |
1194 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, final, " | |
4187 | 1195 "result was something %s\n", |
1196 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), | |
3659 | 1197 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), |
1198 UNBOUNDP(new_val) ? "not bound" : "bound"); | |
1199 /* Tell X11 redisplay that it should translate to iso10646-1. */ | |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1200 if (!UNBOUNDP (new_val)) |
3659 | 1201 { |
1202 final_stage = 1; | |
1203 break; | |
1204 } | |
1205 | |
1206 bound = 0; | |
1207 | |
1208 /* Lookup the face again, this time both allowing the fallback and | |
1209 allowing its final stage to be used. */ | |
1210 new_val = face_property_matching_instance (face, Qfont, | |
1211 charset, domain, | |
1212 ERROR_ME_DEBUG_WARN, 0, | |
4187 | 1213 Qzero, |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1214 STAGE_FINAL); |
3659 | 1215 |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1216 DEBUG_FACES ("just called f_p_m_i on face %s, charset %s, initial, " |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1217 "allow fallback, result was something %s\n", |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1218 XSTRING_DATA (XSYMBOL_NAME (XFACE (cachel->face)->name)), |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1219 XSTRING_DATA (XSYMBOL_NAME (XCHARSET_NAME (charset))), |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
1220 UNBOUNDP (new_val) ? "not bound" : "bound"); |
3659 | 1221 if (!UNBOUNDP(new_val)) |
1222 { | |
1223 /* Tell X11 redisplay that it should translate to iso10646-1. */ | |
1224 final_stage = 1; | |
1225 break; | |
1226 } | |
1227 } while (0); | |
1228 | |
428 | 1229 if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs])) |
1230 cachel->dirty = 1; | |
3659 | 1231 |
1232 set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1); | |
1233 set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs, | |
1234 final_stage); | |
4187 | 1235 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, |
3659 | 1236 (bound || EQ (face, Vdefault_face))); |
428 | 1237 cachel->font[offs] = new_val; |
1238 return new_val; | |
1239 } | |
1240 | |
1241 /* Ensure that the given cachel contains updated fonts for all | |
1242 the charsets specified. */ | |
1243 | |
1244 void | |
1245 ensure_face_cachel_complete (struct face_cachel *cachel, | |
1246 Lisp_Object domain, unsigned char *charsets) | |
1247 { | |
1248 int i; | |
1249 | |
1250 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
1251 if (charsets[i]) | |
1252 { | |
826 | 1253 Lisp_Object charset = charset_by_leading_byte (i + MIN_LEADING_BYTE); |
428 | 1254 assert (CHARSETP (charset)); |
1255 ensure_face_cachel_contains_charset (cachel, domain, charset); | |
1256 } | |
1257 } | |
1258 | |
1259 void | |
1260 face_cachel_charset_font_metric_info (struct face_cachel *cachel, | |
1261 unsigned char *charsets, | |
1262 struct font_metric_info *fm) | |
1263 { | |
1264 int i; | |
1265 | |
1266 fm->width = 1; | |
1267 fm->height = fm->ascent = 1; | |
1268 fm->descent = 0; | |
1269 fm->proportional_p = 0; | |
1270 | |
1271 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
1272 { | |
1273 if (charsets[i]) | |
1274 { | |
826 | 1275 Lisp_Object charset = charset_by_leading_byte (i + MIN_LEADING_BYTE); |
428 | 1276 Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset); |
440 | 1277 Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance); |
428 | 1278 |
1279 assert (CHARSETP (charset)); | |
1280 assert (FONT_INSTANCEP (font_instance)); | |
1281 | |
1282 if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent; | |
1283 if (fm->descent < (int) fi->descent) fm->descent = (int) fi->descent; | |
1284 fm->height = fm->ascent + fm->descent; | |
1285 if (fi->proportional_p) | |
1286 fm->proportional_p = 1; | |
1287 if (EQ (charset, Vcharset_ascii)) | |
1288 fm->width = fi->width; | |
1289 } | |
1290 } | |
1291 } | |
1292 | |
1293 #define FROB(field) \ | |
1294 do { \ | |
1295 Lisp_Object new_val = \ | |
1296 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \ | |
1297 int bound = 1; \ | |
1298 if (UNBOUNDP (new_val)) \ | |
1299 { \ | |
1300 bound = 0; \ | |
1301 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \ | |
1302 } \ | |
1303 if (!EQ (new_val, cachel->field)) \ | |
1304 { \ | |
1305 cachel->field = new_val; \ | |
1306 cachel->dirty = 1; \ | |
1307 } \ | |
1308 cachel->field##_specified = (bound || default_face); \ | |
1309 } while (0) | |
1310 | |
446 | 1311 /* |
1312 * A face's background pixmap will override the face's | |
1313 * background color. But the background pixmap of the | |
1314 * default face should not override the background color of | |
1315 * a face if the background color has been specified or | |
1316 * inherited. | |
1317 * | |
1318 * To accomplish this we remove the background pixmap of the | |
1319 * cachel and mark it as having been specified so that cachel | |
1320 * merging won't override it later. | |
1321 */ | |
1322 #define MAYBE_UNFROB_BACKGROUND_PIXMAP \ | |
1323 do \ | |
1324 { \ | |
1325 if (! default_face \ | |
1326 && cachel->background_specified \ | |
1327 && ! cachel->background_pixmap_specified) \ | |
1328 { \ | |
1329 cachel->background_pixmap = Qunbound; \ | |
1330 cachel->background_pixmap_specified = 1; \ | |
1331 } \ | |
1332 } while (0) | |
1333 | |
1334 | |
1335 /* Add a cachel for the given face to the given window's cache. */ | |
1336 | |
1337 static void | |
1338 add_face_cachel (struct window *w, Lisp_Object face) | |
1339 { | |
1340 int must_finish_frobbing = ! WINDOW_FACE_CACHEL (w, DEFAULT_INDEX); | |
1341 struct face_cachel new_cachel; | |
1342 Lisp_Object domain; | |
1343 | |
1344 reset_face_cachel (&new_cachel); | |
793 | 1345 domain = wrap_window (w); |
446 | 1346 update_face_cachel_data (&new_cachel, domain, face); |
1347 Dynarr_add (w->face_cachels, new_cachel); | |
1348 | |
1349 /* The face's background pixmap have not yet been frobbed (see comment | |
4667
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1350 in update_face_cachel_data), so we have to do it now */ |
446 | 1351 if (must_finish_frobbing) |
1352 { | |
1353 int default_face = EQ (face, Vdefault_face); | |
4844
91b3d00e717f
Various cleanups for Dynarr code, from Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
4827
diff
changeset
|
1354 struct face_cachel *cachel = Dynarr_lastp (w->face_cachels); |
446 | 1355 |
1356 FROB (background_pixmap); | |
1357 MAYBE_UNFROB_BACKGROUND_PIXMAP; | |
1358 } | |
1359 } | |
1360 | |
1361 /* Called when the updated flag has been cleared on a cachel. | |
1362 This function returns 1 if the caller must finish the update (see comment | |
1363 below), 0 otherwise. | |
1364 */ | |
1365 | |
1366 void | |
1367 update_face_cachel_data (struct face_cachel *cachel, | |
1368 Lisp_Object domain, | |
1369 Lisp_Object face) | |
1370 { | |
1371 if (XFACE (face)->dirty || UNBOUNDP (cachel->face)) | |
1372 { | |
1373 int default_face = EQ (face, Vdefault_face); | |
1374 cachel->face = face; | |
1375 | |
1376 /* We normally only set the _specified flags if the value was | |
4187 | 1377 actually bound. The exception is for the default face where |
1378 we always set it since it is the ultimate fallback. */ | |
446 | 1379 |
428 | 1380 FROB (foreground); |
1381 FROB (background); | |
1382 FROB (display_table); | |
446 | 1383 |
1384 /* #### WARNING: the background pixmap property of faces is currently | |
1385 the only one dealing with images. The problem we have here is that | |
1386 frobbing the background pixmap might lead to image instantiation | |
1387 which in turn might require that the cache we're building be up to | |
1388 date, hence a crash. Here's a typical scenario of this: | |
1389 | |
4667
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1390 - a new window is created and its face cache elements are |
446 | 1391 initialized through a call to reset_face_cachels[1]. At that point, |
1392 the cache for the default and modeline faces (normaly taken care of | |
1393 by redisplay itself) are null. | |
1394 - the default face has a background pixmap which needs to be | |
1395 instantiated right here, as a consequence of cache initialization. | |
1396 - the background pixmap image happens to be instantiated as a string | |
1397 (this happens on tty's for instance). | |
1398 - In order to do this, we need to compute the string geometry. | |
1399 - In order to do this, we might have to access the window's default | |
1400 face cache. But this is the cache we're building right now, it is | |
1401 null. | |
1402 - BARF !!!!! | |
428 | 1403 |
446 | 1404 To sum up, this means that it is in general unsafe to instantiate |
1405 images before face cache updating is complete (appart from image | |
1406 related face attributes). The solution we use below is to actually | |
1407 detect whether we're building the window's face_cachels for the first | |
1408 time, and simply NOT frob the background pixmap in that case. If | |
1409 other image-related face attributes are ever implemented, they should | |
1410 be protected the same way right here. | |
1411 | |
1412 One note: | |
1413 * See comment in `default_face_font_info' in face.c. Who wrote it ? | |
1414 Maybe we have the begining of an answer here ? | |
1415 | |
1416 Footnotes: | |
1417 [1] See comment at the top of `allocate_window' in window.c. | |
1418 | |
1419 -- didier | |
1420 */ | |
1421 if (! WINDOWP (domain) | |
1422 || WINDOW_FACE_CACHEL (DOMAIN_XWINDOW (domain), DEFAULT_INDEX)) | |
428 | 1423 { |
446 | 1424 FROB (background_pixmap); |
1425 MAYBE_UNFROB_BACKGROUND_PIXMAP; | |
428 | 1426 } |
1427 #undef FROB | |
446 | 1428 #undef MAYBE_UNFROB_BACKGROUND_PIXMAP |
428 | 1429 |
1430 ensure_face_cachel_contains_charset (cachel, domain, Vcharset_ascii); | |
1431 | |
1432 #define FROB(field) \ | |
1433 do { \ | |
1434 Lisp_Object new_val = \ | |
1435 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \ | |
1436 int bound = 1; \ | |
1437 unsigned int new_val_int; \ | |
1438 if (UNBOUNDP (new_val)) \ | |
1439 { \ | |
1440 bound = 0; \ | |
1441 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \ | |
1442 } \ | |
1443 new_val_int = EQ (new_val, Qt); \ | |
1444 if (cachel->field != new_val_int) \ | |
1445 { \ | |
1446 cachel->field = new_val_int; \ | |
1447 cachel->dirty = 1; \ | |
1448 } \ | |
1449 cachel->field##_specified = bound; \ | |
1450 } while (0) | |
1451 | |
1452 FROB (underline); | |
1453 FROB (strikethru); | |
1454 FROB (highlight); | |
1455 FROB (dim); | |
1456 FROB (reverse); | |
1457 FROB (blinking); | |
1458 #undef FROB | |
1459 } | |
1460 | |
1461 cachel->updated = 1; | |
1462 } | |
1463 | |
1464 /* Merge the cachel identified by FINDEX in window W into the given | |
1465 cachel. */ | |
1466 | |
1467 static void | |
1468 merge_face_cachel_data (struct window *w, face_index findex, | |
1469 struct face_cachel *cachel) | |
1470 { | |
3659 | 1471 int offs; |
1472 | |
428 | 1473 #define FINDEX_FIELD(field) \ |
1474 Dynarr_atp (w->face_cachels, findex)->field | |
1475 | |
1476 #define FROB(field) \ | |
1477 do { \ | |
1478 if (!cachel->field##_specified && FINDEX_FIELD (field##_specified)) \ | |
1479 { \ | |
1480 cachel->field = FINDEX_FIELD (field); \ | |
1481 cachel->field##_specified = 1; \ | |
1482 cachel->dirty = 1; \ | |
1483 } \ | |
1484 } while (0) | |
1485 | |
1486 FROB (foreground); | |
1487 FROB (background); | |
1488 FROB (display_table); | |
1489 FROB (background_pixmap); | |
1490 FROB (underline); | |
1491 FROB (strikethru); | |
1492 FROB (highlight); | |
1493 FROB (dim); | |
1494 FROB (reverse); | |
1495 FROB (blinking); | |
1496 | |
3659 | 1497 for (offs = 0; offs < NUM_LEADING_BYTES; ++offs) |
1498 { | |
1499 if (!(bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs)) | |
1500 && bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED | |
1501 (Dynarr_atp(w->face_cachels, findex)), offs)) | |
1502 { | |
1503 cachel->font[offs] = FINDEX_FIELD (font[offs]); | |
1504 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1); | |
1505 /* Also propagate whether we're translating to Unicode for the | |
1506 given face. */ | |
4187 | 1507 set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs, |
3659 | 1508 bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE |
1509 (Dynarr_atp(w->face_cachels, | |
1510 findex)), offs)); | |
1511 cachel->dirty = 1; | |
1512 } | |
1513 } | |
428 | 1514 #undef FROB |
1515 #undef FINDEX_FIELD | |
1516 | |
1517 cachel->updated = 1; | |
1518 } | |
1519 | |
1520 /* Initialize a cachel. */ | |
3094 | 1521 /* #### Xft: this function will need to be changed for new font model. */ |
428 | 1522 |
1523 void | |
1524 reset_face_cachel (struct face_cachel *cachel) | |
1525 { | |
1526 xzero (*cachel); | |
1527 cachel->face = Qunbound; | |
1528 cachel->nfaces = 0; | |
1529 cachel->merged_faces = 0; | |
1530 cachel->foreground = Qunbound; | |
1531 cachel->background = Qunbound; | |
1532 { | |
1533 int i; | |
1534 | |
1535 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
1536 cachel->font[i] = Qunbound; | |
1537 } | |
1538 cachel->display_table = Qunbound; | |
1539 cachel->background_pixmap = Qunbound; | |
3659 | 1540 FACE_CACHEL_FONT_SPECIFIED (cachel)->size = sizeof(cachel->font_specified); |
1541 FACE_CACHEL_FONT_UPDATED (cachel)->size = sizeof(cachel->font_updated); | |
428 | 1542 } |
1543 | |
1544 /* Retrieve the index to a cachel for window W that corresponds to | |
1545 the specified face. If necessary, add a new element to the | |
1546 cache. */ | |
1547 | |
1548 face_index | |
1549 get_builtin_face_cache_index (struct window *w, Lisp_Object face) | |
1550 { | |
1551 int elt; | |
1552 | |
1553 if (noninteractive) | |
1554 return 0; | |
1555 | |
1556 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) | |
1557 { | |
1558 struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt); | |
1559 | |
1560 if (EQ (cachel->face, face)) | |
1561 { | |
793 | 1562 Lisp_Object window = wrap_window (w); |
1563 | |
428 | 1564 if (!cachel->updated) |
1565 update_face_cachel_data (cachel, window, face); | |
1566 return elt; | |
1567 } | |
1568 } | |
1569 | |
1570 /* If we didn't find the face, add it and then return its index. */ | |
1571 add_face_cachel (w, face); | |
1572 return elt; | |
1573 } | |
1574 | |
1575 void | |
1576 reset_face_cachels (struct window *w) | |
1577 { | |
1578 /* #### Not initialized in batch mode for the stream device. */ | |
1579 if (w->face_cachels) | |
1580 { | |
1581 int i; | |
4208 | 1582 face_index fi; |
428 | 1583 |
1584 for (i = 0; i < Dynarr_length (w->face_cachels); i++) | |
1585 { | |
1586 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, i); | |
1587 if (cachel->merged_faces) | |
1588 Dynarr_free (cachel->merged_faces); | |
1589 } | |
1590 Dynarr_reset (w->face_cachels); | |
4187 | 1591 /* #### NOTE: be careful with the order ! |
1592 The cpp macros DEFAULT_INDEX and MODELINE_INDEX defined in | |
4208 | 1593 redisplay.h depend on the code below. Please make sure to assert the |
1594 correct values if you ever add new built-in faces here. | |
4187 | 1595 -- dvl */ |
4208 | 1596 fi = get_builtin_face_cache_index (w, Vdefault_face); |
4210 | 1597 assert (noninteractive || fi == DEFAULT_INDEX); |
4208 | 1598 fi = get_builtin_face_cache_index (w, Vmodeline_face); |
4210 | 1599 assert (noninteractive || fi == MODELINE_INDEX); |
428 | 1600 XFRAME (w->frame)->window_face_cache_reset = 1; |
1601 } | |
1602 } | |
1603 | |
1604 void | |
1605 mark_face_cachels_as_clean (struct window *w) | |
1606 { | |
1607 int elt; | |
1608 | |
1609 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) | |
1610 Dynarr_atp (w->face_cachels, elt)->dirty = 0; | |
1611 } | |
1612 | |
3094 | 1613 /* #### Xft: this function will need to be changed for new font model. */ |
428 | 1614 void |
1615 mark_face_cachels_as_not_updated (struct window *w) | |
1616 { | |
1617 int elt; | |
1618 | |
1619 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) | |
1620 { | |
1621 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt); | |
1622 | |
1623 cachel->updated = 0; | |
4187 | 1624 memset(FACE_CACHEL_FONT_UPDATED(cachel)->bits, 0, |
3659 | 1625 BIT_VECTOR_LONG_STORAGE (NUM_LEADING_BYTES)); |
428 | 1626 } |
1627 } | |
1628 | |
1629 #ifdef MEMORY_USAGE_STATS | |
1630 | |
1631 int | |
1632 compute_face_cachel_usage (face_cachel_dynarr *face_cachels, | |
1633 struct overhead_stats *ovstats) | |
1634 { | |
1635 int total = 0; | |
1636 | |
1637 if (face_cachels) | |
1638 { | |
1639 int i; | |
1640 | |
1641 total += Dynarr_memory_usage (face_cachels, ovstats); | |
1642 for (i = 0; i < Dynarr_length (face_cachels); i++) | |
1643 { | |
1644 int_dynarr *merged = Dynarr_at (face_cachels, i).merged_faces; | |
1645 if (merged) | |
1646 total += Dynarr_memory_usage (merged, ovstats); | |
1647 } | |
1648 } | |
1649 | |
1650 return total; | |
1651 } | |
1652 | |
1653 #endif /* MEMORY_USAGE_STATS */ | |
1654 | |
1655 | |
1656 /***************************************************************************** | |
1657 * merged face functions * | |
1658 *****************************************************************************/ | |
1659 | |
1660 /* Compare two merged face cachels to determine whether we have to add | |
1661 a new entry to the face cache. | |
1662 | |
1663 Note that we do not compare the attributes, but just the faces the | |
1664 cachels are based on. If they are the same, then the cachels certainly | |
1665 ought to have the same attributes, except in the case where fonts | |
1666 for different charsets have been determined in the two -- and in that | |
1667 case this difference is fine. */ | |
1668 | |
1669 static int | |
1670 compare_merged_face_cachels (struct face_cachel *cachel1, | |
1671 struct face_cachel *cachel2) | |
1672 { | |
1673 int i; | |
1674 | |
1675 if (!EQ (cachel1->face, cachel2->face) | |
1676 || cachel1->nfaces != cachel2->nfaces) | |
1677 return 0; | |
1678 | |
1679 for (i = 0; i < cachel1->nfaces; i++) | |
1680 if (FACE_CACHEL_FINDEX_UNSAFE (cachel1, i) | |
1681 != FACE_CACHEL_FINDEX_UNSAFE (cachel2, i)) | |
1682 return 0; | |
1683 | |
1684 return 1; | |
1685 } | |
1686 | |
1687 /* Retrieve the index to a cachel for window W that corresponds to | |
1688 the specified cachel. If necessary, add a new element to the | |
1689 cache. This is similar to get_builtin_face_cache_index() but | |
1690 is intended for merged cachels rather than for cachels representing | |
1691 just a face. | |
1692 | |
1693 Note that a merged cachel for just one face is not the same as | |
1694 the simple cachel for that face, because it is also merged with | |
1695 the default face. */ | |
1696 | |
1697 static face_index | |
1698 get_merged_face_cache_index (struct window *w, | |
1699 struct face_cachel *merged_cachel) | |
1700 { | |
1701 int elt; | |
1702 int cache_size = Dynarr_length (w->face_cachels); | |
1703 | |
1704 for (elt = 0; elt < cache_size; elt++) | |
1705 { | |
1706 struct face_cachel *cachel = | |
1707 Dynarr_atp (w->face_cachels, elt); | |
1708 | |
1709 if (compare_merged_face_cachels (cachel, merged_cachel)) | |
1710 return elt; | |
1711 } | |
1712 | |
1713 /* We didn't find it so add this instance to the cache. */ | |
1714 merged_cachel->updated = 1; | |
1715 merged_cachel->dirty = 1; | |
1716 Dynarr_add (w->face_cachels, *merged_cachel); | |
1717 return cache_size; | |
1718 } | |
1719 | |
1720 face_index | |
1721 get_extent_fragment_face_cache_index (struct window *w, | |
1722 struct extent_fragment *ef) | |
1723 { | |
1724 struct face_cachel cachel; | |
1725 int len = Dynarr_length (ef->extents); | |
1726 face_index findex = 0; | |
1727 | |
1728 /* Optimize the default case. */ | |
1729 if (len == 0) | |
1730 return DEFAULT_INDEX; | |
1731 else | |
1732 { | |
1733 int i; | |
1734 | |
1735 /* Merge the faces of the extents together in order. */ | |
1736 | |
1737 reset_face_cachel (&cachel); | |
1738 | |
1739 for (i = len - 1; i >= 0; i--) | |
1740 { | |
1741 EXTENT current = Dynarr_at (ef->extents, i); | |
1742 int has_findex = 0; | |
1743 Lisp_Object face = extent_face (current); | |
1744 | |
1745 if (FACEP (face)) | |
1746 { | |
1747 findex = get_builtin_face_cache_index (w, face); | |
1748 has_findex = 1; | |
1749 merge_face_cachel_data (w, findex, &cachel); | |
1750 } | |
1751 /* remember, we're called from within redisplay | |
1752 so we can't error. */ | |
1753 else while (CONSP (face)) | |
1754 { | |
1755 Lisp_Object one_face = XCAR (face); | |
1756 if (FACEP (one_face)) | |
1757 { | |
1758 findex = get_builtin_face_cache_index (w, one_face); | |
1759 merge_face_cachel_data (w, findex, &cachel); | |
1760 | |
1761 /* code duplication here but there's no clean | |
1762 way to avoid it. */ | |
1763 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES) | |
1764 { | |
1765 if (!cachel.merged_faces) | |
1766 cachel.merged_faces = Dynarr_new (int); | |
1767 Dynarr_add (cachel.merged_faces, findex); | |
1768 } | |
1769 else | |
1770 cachel.merged_faces_static[cachel.nfaces] = findex; | |
1771 cachel.nfaces++; | |
1772 } | |
1773 face = XCDR (face); | |
1774 } | |
1775 | |
1776 if (has_findex) | |
1777 { | |
1778 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES) | |
1779 { | |
1780 if (!cachel.merged_faces) | |
1781 cachel.merged_faces = Dynarr_new (int); | |
1782 Dynarr_add (cachel.merged_faces, findex); | |
1783 } | |
1784 else | |
1785 cachel.merged_faces_static[cachel.nfaces] = findex; | |
1786 cachel.nfaces++; | |
1787 } | |
1788 } | |
1789 | |
1790 /* Now finally merge in the default face. */ | |
1791 findex = get_builtin_face_cache_index (w, Vdefault_face); | |
1792 merge_face_cachel_data (w, findex, &cachel); | |
1793 | |
444 | 1794 findex = get_merged_face_cache_index (w, &cachel); |
1795 if (cachel.merged_faces && | |
1796 /* merged_faces did not get stored and available via return value */ | |
1797 Dynarr_at (w->face_cachels, findex).merged_faces != | |
1798 cachel.merged_faces) | |
1799 { | |
1800 Dynarr_free (cachel.merged_faces); | |
1801 cachel.merged_faces = 0; | |
1802 } | |
1803 return findex; | |
428 | 1804 } |
1805 } | |
1806 | |
3094 | 1807 /* Return a cache index for window W from merging the faces in FACE_LIST. |
1808 COUNT is the number of faces in the list. | |
1809 | |
1810 The default face should not be included in the list, as it is always | |
1811 implicitly merged into the cachel. | |
1812 | |
1813 WARNING: this interface may change. */ | |
1814 | |
1815 face_index | |
1816 merge_face_list_to_cache_index (struct window *w, | |
1817 Lisp_Object *face_list, int count) | |
1818 { | |
1819 int i; | |
1820 face_index findex = 0; | |
1821 struct face_cachel cachel; | |
1822 | |
1823 reset_face_cachel (&cachel); | |
1824 | |
1825 for (i = 0; i < count; i++) | |
1826 { | |
1827 Lisp_Object face = face_list[i]; | |
1828 | |
1829 if (!NILP (face)) | |
1830 { | |
1831 CHECK_FACE(face); /* #### presumably unnecessary */ | |
1832 findex = get_builtin_face_cache_index (w, face); | |
1833 merge_face_cachel_data (w, findex, &cachel); | |
1834 } | |
1835 } | |
1836 | |
1837 /* Now finally merge in the default face. */ | |
1838 findex = get_builtin_face_cache_index (w, Vdefault_face); | |
1839 merge_face_cachel_data (w, findex, &cachel); | |
1840 | |
1841 return get_merged_face_cache_index (w, &cachel); | |
1842 } | |
1843 | |
428 | 1844 |
1845 /***************************************************************************** | |
1846 interface functions | |
1847 ****************************************************************************/ | |
1848 | |
1849 static void | |
1850 update_EmacsFrame (Lisp_Object frame, Lisp_Object name) | |
1851 { | |
1852 struct frame *frm = XFRAME (frame); | |
1853 | |
3676 | 1854 if (!FRAME_LIVE_P(frm)) |
1855 return; | |
1856 | |
428 | 1857 if (EQ (name, Qfont)) |
1858 MARK_FRAME_SIZE_SLIPPED (frm); | |
1859 | |
1860 MAYBE_FRAMEMETH (frm, update_frame_external_traits, (frm, name)); | |
1861 } | |
1862 | |
1863 static void | |
1864 update_EmacsFrames (Lisp_Object locale, Lisp_Object name) | |
1865 { | |
1866 if (FRAMEP (locale)) | |
1867 { | |
1868 update_EmacsFrame (locale, name); | |
1869 } | |
1870 else if (DEVICEP (locale)) | |
1871 { | |
1872 Lisp_Object frmcons; | |
1873 | |
1874 DEVICE_FRAME_LOOP (frmcons, XDEVICE (locale)) | |
1875 update_EmacsFrame (XCAR (frmcons), name); | |
1876 } | |
1877 else if (EQ (locale, Qglobal) || EQ (locale, Qfallback)) | |
1878 { | |
1879 Lisp_Object frmcons, devcons, concons; | |
1880 | |
1881 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) | |
1882 update_EmacsFrame (XCAR (frmcons), name); | |
1883 } | |
1884 } | |
1885 | |
1886 void | |
1887 update_frame_face_values (struct frame *f) | |
1888 { | |
793 | 1889 Lisp_Object frm = wrap_frame (f); |
428 | 1890 |
1891 update_EmacsFrame (frm, Qforeground); | |
1892 update_EmacsFrame (frm, Qbackground); | |
1893 update_EmacsFrame (frm, Qfont); | |
1894 } | |
1895 | |
1896 void | |
1897 face_property_was_changed (Lisp_Object face, Lisp_Object property, | |
1898 Lisp_Object locale) | |
1899 { | |
1900 int default_face = EQ (face, Vdefault_face); | |
1901 | |
1902 /* If the locale could affect the frame value, then call | |
1903 update_EmacsFrames just in case. */ | |
1904 if (default_face && | |
1905 (EQ (property, Qforeground) || | |
1906 EQ (property, Qbackground) || | |
1907 EQ (property, Qfont))) | |
1908 update_EmacsFrames (locale, property); | |
1909 | |
1910 if (WINDOWP (locale)) | |
1911 { | |
1912 MARK_FRAME_FACES_CHANGED (XFRAME (XWINDOW (locale)->frame)); | |
1913 } | |
1914 else if (FRAMEP (locale)) | |
1915 { | |
1916 MARK_FRAME_FACES_CHANGED (XFRAME (locale)); | |
1917 } | |
1918 else if (DEVICEP (locale)) | |
1919 { | |
1920 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (locale)); | |
1921 } | |
1922 else | |
1923 { | |
1924 Lisp_Object devcons, concons; | |
1925 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
1926 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (XCAR (devcons))); | |
1927 } | |
1928 | |
1929 /* | |
1930 * This call to update_faces_inheritance isn't needed and makes | |
1931 * creating and modifying faces _very_ slow. The point of | |
1932 * update_face_inheritances is to find all faces that inherit | |
1933 * directly from this face property and set the specifier "dirty" | |
1934 * flag on the corresponding specifier. This forces recaching of | |
1935 * cached specifier values in frame and window struct slots. But | |
1936 * currently no face properties are cached in frame and window | |
1937 * struct slots, so calling this function does nothing useful! | |
1938 * | |
1939 * Further, since update_faces_inheritance maps over the whole | |
1940 * face table every time it is called, it gets terribly slow when | |
1941 * there are many faces. Creating 500 faces on a 50Mhz 486 took | |
1942 * 433 seconds when update_faces_inheritance was called. With the | |
1943 * call commented out, creating those same 500 faces took 0.72 | |
1944 * seconds. | |
1945 */ | |
1946 /* update_faces_inheritance (face, property);*/ | |
1947 XFACE (face)->dirty = 1; | |
1948 } | |
1949 | |
1950 DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /* | |
1951 Define and return a new face which is a copy of an existing one, | |
1952 or makes an already-existing face be exactly like another. | |
1953 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'. | |
1954 */ | |
1955 (old_face, new_name, locale, tag_set, exact_p, how_to_add)) | |
1956 { | |
440 | 1957 Lisp_Face *fold, *fnew; |
428 | 1958 Lisp_Object new_face = Qnil; |
1959 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
1960 | |
1961 old_face = Fget_face (old_face); | |
1962 | |
1963 /* We GCPRO old_face because it might be temporary, and GCing could | |
1964 occur in various places below. */ | |
1965 GCPRO4 (tag_set, locale, old_face, new_face); | |
1966 /* check validity of how_to_add now. */ | |
1967 decode_how_to_add_specification (how_to_add); | |
1968 /* and of tag_set. */ | |
1969 tag_set = decode_specifier_tag_set (tag_set); | |
1970 /* and of locale. */ | |
1971 locale = decode_locale_list (locale); | |
1972 | |
1973 new_face = Ffind_face (new_name); | |
1974 if (NILP (new_face)) | |
1975 { | |
1976 Lisp_Object temp; | |
1977 | |
1978 CHECK_SYMBOL (new_name); | |
1979 | |
1980 /* Create the new face with the same status as the old face. */ | |
1981 temp = (NILP (Fgethash (old_face, Vtemporary_faces_cache, Qnil)) | |
1982 ? Qnil | |
1983 : Qt); | |
1984 | |
1985 new_face = Fmake_face (new_name, Qnil, temp); | |
1986 } | |
1987 | |
1988 fold = XFACE (old_face); | |
1989 fnew = XFACE (new_face); | |
1990 | |
1991 #define COPY_PROPERTY(property) \ | |
1992 Fcopy_specifier (fold->property, fnew->property, \ | |
4187 | 1993 locale, tag_set, exact_p, how_to_add); |
428 | 1994 |
1995 COPY_PROPERTY (foreground); | |
1996 COPY_PROPERTY (background); | |
1997 COPY_PROPERTY (font); | |
1998 COPY_PROPERTY (display_table); | |
1999 COPY_PROPERTY (background_pixmap); | |
2000 COPY_PROPERTY (underline); | |
2001 COPY_PROPERTY (strikethru); | |
2002 COPY_PROPERTY (highlight); | |
2003 COPY_PROPERTY (dim); | |
2004 COPY_PROPERTY (blinking); | |
2005 COPY_PROPERTY (reverse); | |
2006 #undef COPY_PROPERTY | |
2007 /* #### should it copy the individual specifiers, if they exist? */ | |
2008 fnew->plist = Fcopy_sequence (fold->plist); | |
2009 | |
2010 UNGCPRO; | |
2011 | |
2012 return new_name; | |
2013 } | |
2014 | |
3659 | 2015 #ifdef MULE |
2016 | |
3918 | 2017 Lisp_Object Qone_dimensional, Qtwo_dimensional, Qx_coverage_instantiator; |
3659 | 2018 |
4187 | 2019 DEFUN ("specifier-tag-one-dimensional-p", |
2020 Fspecifier_tag_one_dimensional_p, | |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
2021 1, 1, 0, /* |
3659 | 2022 Return non-nil if (charset-dimension CHARSET) is 1. |
2023 | |
2024 Used by the X11 platform font code; see `define-specifier-tag'. You | |
2025 shouldn't ever need to call this yourself. | |
2026 */ | |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
2027 (charset)) |
3659 | 2028 { |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
2029 CHECK_CHARSET (charset); |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
2030 return (1 == XCHARSET_DIMENSION (charset)) ? Qt : Qnil; |
3659 | 2031 } |
2032 | |
4187 | 2033 DEFUN ("specifier-tag-two-dimensional-p", |
2034 Fspecifier_tag_two_dimensional_p, | |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
2035 1, 1, 0, /* |
3659 | 2036 Return non-nil if (charset-dimension CHARSET) is 2. |
2037 | |
2038 Used by the X11 platform font code; see `define-specifier-tag'. You | |
2039 shouldn't ever need to call this yourself. | |
2040 */ | |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
2041 (charset)) |
3659 | 2042 { |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
2043 CHECK_CHARSET (charset); |
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
2044 return (2 == XCHARSET_DIMENSION (charset)) ? Qt : Qnil; |
3659 | 2045 } |
2046 | |
4187 | 2047 DEFUN ("specifier-tag-final-stage-p", |
2048 Fspecifier_tag_final_stage_p, | |
3659 | 2049 2, 2, 0, /* |
2050 Return non-nil if STAGE is 'final. | |
2051 | |
2052 Used by the X11 platform font code for giving fallbacks; see | |
4187 | 2053 `define-specifier-tag'. You shouldn't ever need to call this. |
3659 | 2054 */ |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
2055 (UNUSED (charset), stage)) |
3659 | 2056 { |
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
2057 return EQ (stage, Qfinal) ? Qt : Qnil; |
3659 | 2058 } |
2059 | |
4187 | 2060 DEFUN ("specifier-tag-initial-stage-p", |
2061 Fspecifier_tag_initial_stage_p, | |
3659 | 2062 2, 2, 0, /* |
2063 Return non-nil if STAGE is 'initial. | |
2064 | |
2065 Used by the X11 platform font code for giving fallbacks; see | |
4187 | 2066 `define-specifier-tag'. You shouldn't ever need to call this. |
3659 | 2067 */ |
2068 (UNUSED(charset), stage)) | |
2069 { | |
2070 return EQ(stage, Qinitial) ? Qt : Qnil; | |
2071 } | |
2072 | |
4187 | 2073 DEFUN ("specifier-tag-encode-as-utf-8-p", |
2074 Fspecifier_tag_encode_as_utf_8_p, | |
3659 | 2075 2, 2, 0, /* |
2076 Return t if and only if (charset-property CHARSET 'encode-as-utf-8)). | |
2077 | |
2078 Used by the X11 platform font code; see `define-specifier-tag'. You | |
2079 shouldn't ever need to call this. | |
2080 */ | |
2081 (charset, UNUSED(stage))) | |
2082 { | |
2083 /* Used to check that the stage was initial too. */ | |
2084 CHECK_CHARSET(charset); | |
2085 return XCHARSET_ENCODE_AS_UTF_8(charset) ? Qt : Qnil; | |
2086 } | |
2087 | |
2088 #endif /* MULE */ | |
2089 | |
428 | 2090 |
2091 void | |
2092 syms_of_faces (void) | |
2093 { | |
442 | 2094 INIT_LRECORD_IMPLEMENTATION (face); |
2095 | |
440 | 2096 /* Qdefault, Qwidget, Qleft_margin, Qright_margin defined in general.c */ |
563 | 2097 DEFSYMBOL (Qmodeline); |
2098 DEFSYMBOL (Qgui_element); | |
2099 DEFSYMBOL (Qtext_cursor); | |
2100 DEFSYMBOL (Qvertical_divider); | |
428 | 2101 |
2102 DEFSUBR (Ffacep); | |
2103 DEFSUBR (Ffind_face); | |
2104 DEFSUBR (Fget_face); | |
2105 DEFSUBR (Fface_name); | |
2106 DEFSUBR (Fbuilt_in_face_specifiers); | |
2107 DEFSUBR (Fface_list); | |
2108 DEFSUBR (Fmake_face); | |
2109 DEFSUBR (Fcopy_face); | |
2110 | |
3659 | 2111 #ifdef MULE |
2112 DEFSYMBOL (Qone_dimensional); | |
2113 DEFSYMBOL (Qtwo_dimensional); | |
3918 | 2114 DEFSYMBOL (Qx_coverage_instantiator); |
2115 | |
3659 | 2116 /* I would much prefer these were in Lisp. */ |
2117 DEFSUBR (Fspecifier_tag_one_dimensional_p); | |
2118 DEFSUBR (Fspecifier_tag_two_dimensional_p); | |
2119 DEFSUBR (Fspecifier_tag_initial_stage_p); | |
2120 DEFSUBR (Fspecifier_tag_final_stage_p); | |
2121 DEFSUBR (Fspecifier_tag_encode_as_utf_8_p); | |
2122 #endif /* MULE */ | |
2123 | |
563 | 2124 DEFSYMBOL (Qfacep); |
2125 DEFSYMBOL (Qforeground); | |
2126 DEFSYMBOL (Qbackground); | |
428 | 2127 /* Qfont defined in general.c */ |
563 | 2128 DEFSYMBOL (Qdisplay_table); |
2129 DEFSYMBOL (Qbackground_pixmap); | |
2130 DEFSYMBOL (Qunderline); | |
2131 DEFSYMBOL (Qstrikethru); | |
428 | 2132 /* Qhighlight, Qreverse defined in general.c */ |
563 | 2133 DEFSYMBOL (Qdim); |
2134 DEFSYMBOL (Qblinking); | |
428 | 2135 |
2865 | 2136 DEFSYMBOL (Qface_alias); |
2867 | 2137 DEFERROR_STANDARD (Qcyclic_face_alias, Qinvalid_state); |
2865 | 2138 |
563 | 2139 DEFSYMBOL (Qinit_face_from_resources); |
2140 DEFSYMBOL (Qinit_global_faces); | |
2141 DEFSYMBOL (Qinit_device_faces); | |
2142 DEFSYMBOL (Qinit_frame_faces); | |
428 | 2143 } |
2144 | |
2145 void | |
2146 structure_type_create_faces (void) | |
2147 { | |
2148 struct structure_type *st; | |
2149 | |
2150 st = define_structure_type (Qface, face_validate, face_instantiate); | |
2151 | |
2152 define_structure_type_keyword (st, Qname, face_name_validate); | |
2153 } | |
2154 | |
2155 void | |
2156 vars_of_faces (void) | |
2157 { | |
2158 staticpro (&Vpermanent_faces_cache); | |
771 | 2159 Vpermanent_faces_cache = |
2160 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
428 | 2161 staticpro (&Vtemporary_faces_cache); |
771 | 2162 Vtemporary_faces_cache = |
2163 make_lisp_hash_table (0, HASH_TABLE_WEAK, HASH_TABLE_EQ); | |
428 | 2164 |
2165 staticpro (&Vdefault_face); | |
2166 Vdefault_face = Qnil; | |
2167 staticpro (&Vgui_element_face); | |
2168 Vgui_element_face = Qnil; | |
2169 staticpro (&Vwidget_face); | |
2170 Vwidget_face = Qnil; | |
2171 staticpro (&Vmodeline_face); | |
2172 Vmodeline_face = Qnil; | |
2173 staticpro (&Vtoolbar_face); | |
2174 Vtoolbar_face = Qnil; | |
2175 | |
2176 staticpro (&Vvertical_divider_face); | |
2177 Vvertical_divider_face = Qnil; | |
2178 staticpro (&Vleft_margin_face); | |
2179 Vleft_margin_face = Qnil; | |
2180 staticpro (&Vright_margin_face); | |
2181 Vright_margin_face = Qnil; | |
2182 staticpro (&Vtext_cursor_face); | |
2183 Vtext_cursor_face = Qnil; | |
2184 staticpro (&Vpointer_face); | |
2185 Vpointer_face = Qnil; | |
2186 | |
3659 | 2187 #ifdef DEBUG_XEMACS |
2188 DEFVAR_INT ("debug-x-faces", &debug_x_faces /* | |
2189 If non-zero, display debug information about X faces | |
2190 */ ); | |
2191 debug_x_faces = 0; | |
2192 #endif | |
2193 | |
428 | 2194 { |
2195 Lisp_Object syms[20]; | |
2196 int n = 0; | |
2197 | |
2198 syms[n++] = Qforeground; | |
2199 syms[n++] = Qbackground; | |
2200 syms[n++] = Qfont; | |
2201 syms[n++] = Qdisplay_table; | |
2202 syms[n++] = Qbackground_pixmap; | |
2203 syms[n++] = Qunderline; | |
2204 syms[n++] = Qstrikethru; | |
2205 syms[n++] = Qhighlight; | |
2206 syms[n++] = Qdim; | |
2207 syms[n++] = Qblinking; | |
2208 syms[n++] = Qreverse; | |
2209 | |
2210 Vbuilt_in_face_specifiers = Flist (n, syms); | |
2211 staticpro (&Vbuilt_in_face_specifiers); | |
2212 } | |
2213 } | |
2214 | |
2215 void | |
2216 complex_vars_of_faces (void) | |
2217 { | |
2218 /* Create the default face now so we know what it is immediately. */ | |
2219 | |
2220 Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus | |
2221 default value */ | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2222 Vdefault_face = Fmake_face (Qdefault, build_defer_string ("default face"), |
428 | 2223 Qnil); |
2224 | |
2225 /* Provide some last-resort fallbacks to avoid utter fuckage if | |
2226 someone provides invalid values for the global specifications. */ | |
2227 | |
2228 { | |
2229 Lisp_Object fg_fb = Qnil, bg_fb = Qnil; | |
2230 | |
462 | 2231 #ifdef HAVE_GTK |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2232 fg_fb = acons (list1 (Qgtk), build_ascstring ("black"), fg_fb); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2233 bg_fb = acons (list1 (Qgtk), build_ascstring ("white"), bg_fb); |
462 | 2234 #endif |
428 | 2235 #ifdef HAVE_X_WINDOWS |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2236 fg_fb = acons (list1 (Qx), build_ascstring ("black"), fg_fb); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2237 bg_fb = acons (list1 (Qx), build_ascstring ("gray80"), bg_fb); |
428 | 2238 #endif |
2239 #ifdef HAVE_TTY | |
2240 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); | |
2241 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); | |
2242 #endif | |
2243 #ifdef HAVE_MS_WINDOWS | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2244 fg_fb = acons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2245 bg_fb = acons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2246 fg_fb = acons (list1 (Qmswindows), build_ascstring ("black"), fg_fb); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2247 bg_fb = acons (list1 (Qmswindows), build_ascstring ("white"), bg_fb); |
428 | 2248 #endif |
2249 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb); | |
2250 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb); | |
2251 } | |
2252 | |
2253 { | |
2254 Lisp_Object inst_list = Qnil; | |
462 | 2255 |
872 | 2256 #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK) |
2865 | 2257 |
3659 | 2258 #ifdef HAVE_GTK |
2259 Lisp_Object device_symbol = Qgtk; | |
2260 #else | |
2261 Lisp_Object device_symbol = Qx; | |
2262 #endif | |
2263 | |
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2264 #if defined (HAVE_XFT) || defined (MULE) |
3802 | 2265 const Ascbyte **fontptr; |
3659 | 2266 |
2367 | 2267 const Ascbyte *fonts[] = |
428 | 2268 { |
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2269 #ifdef HAVE_XFT |
3094 | 2270 /************** Xft fonts *************/ |
2271 | |
2272 /* Note that fontconfig can search for several font families in one | |
2273 call. We should use this facility. */ | |
3659 | 2274 "Monospace-12", |
3094 | 2275 /* do we need to worry about non-Latin characters for monospace? |
4187 | 2276 No, at least in Debian's implementation of Xft. |
3094 | 2277 We should recommend that "gothic" and "mincho" aliases be created? */ |
3659 | 2278 "Sazanami Mincho-12", |
2279 /* Japanese #### add encoding info? */ | |
4187 | 2280 /* Arphic for Chinese? */ |
2281 /* Korean */ | |
3094 | 2282 #else |
3659 | 2283 /* The default Japanese fonts installed with XFree86 4.0 use this |
2284 point size, and the -misc-fixed fonts (which look really bad with | |
2285 Han characters) don't. We need to prefer the former. */ | |
2286 "-*-*-medium-r-*-*-*-150-*-*-c-*-*-*", | |
2287 /* And the Chinese ones, maddeningly, use this one. (But on 4.0, while | |
2288 XListFonts returns them, XLoadQueryFont on the fully-specified XLFD | |
2289 corresponding to one of them fails!) */ | |
2290 "-*-*-medium-r-*-*-*-160-*-*-c-*-*-*", | |
2291 "-*-*-medium-r-*-*-*-170-*-*-c-*-*-*", | |
3094 | 2292 #endif |
428 | 2293 }; |
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2294 #endif /* defined (HAVE_XFT) || defined (MULE) */ |
3802 | 2295 |
2296 #ifdef MULE | |
428 | 2297 |
3659 | 2298 /* Define some specifier tags for classes of character sets. Combining |
2299 these allows for distinct fallback fonts for distinct dimensions of | |
2300 character sets and stages. */ | |
2301 | |
2302 define_specifier_tag(Qtwo_dimensional, Qnil, | |
2303 intern ("specifier-tag-two-dimensional-p")); | |
2304 | |
2305 define_specifier_tag(Qone_dimensional, Qnil, | |
2306 intern ("specifier-tag-one-dimensional-p")); | |
2307 | |
4187 | 2308 define_specifier_tag(Qinitial, Qnil, |
3659 | 2309 intern ("specifier-tag-initial-stage-p")); |
2310 | |
4187 | 2311 define_specifier_tag(Qfinal, Qnil, |
3659 | 2312 intern ("specifier-tag-final-stage-p")); |
2313 | |
2314 define_specifier_tag (Qencode_as_utf_8, Qnil, | |
2315 intern("specifier-tag-encode-as-utf-8-p")); | |
3918 | 2316 |
2317 /* This tag is used to group those instantiators made available in the | |
2318 fallback for the sake of coverage of obscure characters, notably | |
2319 Markus Kuhn's misc-fixed fonts. They will be copied from the fallback | |
2320 when the default face is determined from X resources at startup. */ | |
2321 define_specifier_tag (Qx_coverage_instantiator, Qnil, Qnil); | |
2322 | |
3659 | 2323 #endif /* MULE */ |
2324 | |
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2325 #ifdef HAVE_XFT |
3747 | 2326 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) |
2327 inst_list = Fcons (Fcons (list1 (device_symbol), | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2328 build_cistring (*fontptr)), |
3747 | 2329 inst_list); |
2330 | |
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2331 #else /* !HAVE_XFT */ |
3659 | 2332 inst_list = |
4187 | 2333 Fcons |
3659 | 2334 (Fcons |
4187 | 2335 (list1 (device_symbol), |
4766
32b358a240b0
Avoid calling Xft if not built in.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4759
diff
changeset
|
2336 /* grrr. This really does need to be "*", not an XLFD. |
32b358a240b0
Avoid calling Xft if not built in.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4759
diff
changeset
|
2337 An unspecified XLFD won't pick up stuff like 10x20. */ |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2338 build_ascstring ("*")), |
3659 | 2339 inst_list); |
4187 | 2340 #ifdef MULE |
3659 | 2341 |
2342 /* For Han characters and Ethiopic, we want the misc-fixed font used to | |
2343 be distinct from that for alphabetic scripts, because the font | |
2344 specified below is distractingly ugly when used for Han characters | |
2345 (this is slightly less so) and because its coverage isn't up to | |
2346 handling them (well, chiefly, it's not up to handling Ethiopic--we do | |
2347 have charset-specific fallbacks for the East Asian charsets.) */ | |
4187 | 2348 inst_list = |
3659 | 2349 Fcons |
2350 (Fcons | |
4187 | 2351 (list4(device_symbol, Qtwo_dimensional, Qfinal, Qx_coverage_instantiator), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2352 build_ascstring |
3659 | 2353 ("-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso10646-1")), |
2354 inst_list); | |
2355 | |
2356 /* Use Markus Kuhn's version of misc-fixed as the font for the font for | |
2357 when a given charset's registries can't be found and redisplay for | |
2358 that charset falls back to iso10646-1. */ | |
428 | 2359 |
4187 | 2360 inst_list = |
3659 | 2361 Fcons |
2362 (Fcons | |
4187 | 2363 (list4(device_symbol, Qone_dimensional, Qfinal, Qx_coverage_instantiator), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2364 build_ascstring |
4187 | 2365 ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")), |
3659 | 2366 inst_list); |
2367 | |
462 | 2368 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) |
4187 | 2369 inst_list = Fcons (Fcons (list3 (device_symbol, |
3659 | 2370 Qtwo_dimensional, Qinitial), |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2371 build_cistring (*fontptr)), |
462 | 2372 inst_list); |
3659 | 2373 |
2374 /* We need to set the font for the JIT-ucs-charsets separately from the | |
2375 final stage, since otherwise it picks up the two-dimensional | |
2376 specification (see specifier-tag-two-dimensional-initial-stage-p | |
2377 above). They also use Markus Kuhn's ISO 10646-1 fixed fonts for | |
2378 redisplay. */ | |
2379 | |
4187 | 2380 inst_list = |
3659 | 2381 Fcons |
2382 (Fcons | |
4187 | 2383 (list4(device_symbol, Qencode_as_utf_8, Qinitial, Qx_coverage_instantiator), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2384 build_ascstring |
4187 | 2385 ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")), |
3659 | 2386 inst_list); |
2387 | |
2388 #endif /* MULE */ | |
2389 | |
2390 /* Needed to make sure that charsets with non-specified fonts don't | |
2391 use bold and oblique first if medium and regular are available. */ | |
2392 inst_list = | |
4187 | 2393 Fcons |
3659 | 2394 (Fcons |
4187 | 2395 (list1 (device_symbol), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2396 build_ascstring ("-*-*-medium-r-*-*-*-120-*-*-c-*-*-*")), |
3659 | 2397 inst_list); |
2398 | |
2399 /* With a Cygwin XFree86 install, this returns the best (clearest, | |
2400 most readable) font I can find when scaling of bitmap fonts is | |
2401 turned on, as it is by default. (WHO IN THE NAME OF CHRIST THOUGHT | |
2402 THAT WAS A GOOD IDEA?!?!) The other fonts that used to be specified | |
2403 here gave horrendous results. */ | |
2404 | |
2405 inst_list = | |
4187 | 2406 Fcons |
3659 | 2407 (Fcons |
4187 | 2408 (list1 (device_symbol), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2409 build_ascstring ("-*-lucidatypewriter-medium-r-*-*-*-120-*-*-*-*-*-*")), |
3659 | 2410 inst_list); |
2411 | |
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2412 #endif /* !HAVE_XFT */ |
3747 | 2413 |
462 | 2414 #endif /* HAVE_X_WINDOWS || HAVE_GTK */ |
2415 | |
428 | 2416 #ifdef HAVE_TTY |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2417 inst_list = Fcons (Fcons (list1 (Qtty), build_ascstring ("normal")), |
428 | 2418 inst_list); |
2419 #endif /* HAVE_TTY */ | |
440 | 2420 |
771 | 2421 #ifdef HAVE_MS_WINDOWS |
2422 { | |
2367 | 2423 const Ascbyte *mswfonts[] = |
4187 | 2424 { |
2425 "Courier New:Regular:10::", | |
2426 "Courier:Regular:10::", | |
2427 ":Regular:10::" | |
2428 }; | |
2367 | 2429 const Ascbyte **mswfontptr; |
2865 | 2430 |
771 | 2431 for (mswfontptr = mswfonts + countof (mswfonts) - 1; |
2432 mswfontptr >= mswfonts; mswfontptr--) | |
4187 | 2433 { |
2434 /* display device */ | |
2435 inst_list = Fcons (Fcons (list1 (Qmswindows), | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2436 build_ascstring (*mswfontptr)), |
4187 | 2437 inst_list); |
2438 /* printer device */ | |
2439 inst_list = Fcons (Fcons (list1 (Qmsprinter), | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2440 build_ascstring (*mswfontptr)), |
4187 | 2441 inst_list); |
2442 } | |
793 | 2443 /* Use Lucida Console rather than Courier New if it exists -- the |
4187 | 2444 line spacing is much less, so many more lines fit with the same |
2445 size font. (And it's specifically designed for screens.) */ | |
2865 | 2446 inst_list = Fcons (Fcons (list1 (Qmswindows), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2447 build_ascstring ("Lucida Console:Regular:10::")), |
793 | 2448 inst_list); |
771 | 2449 } |
428 | 2450 #endif /* HAVE_MS_WINDOWS */ |
771 | 2451 |
428 | 2452 set_specifier_fallback (Fget (Vdefault_face, Qfont, Qnil), inst_list); |
2453 } | |
2454 | |
2455 set_specifier_fallback (Fget (Vdefault_face, Qunderline, Qnil), | |
2456 list1 (Fcons (Qnil, Qnil))); | |
2457 set_specifier_fallback (Fget (Vdefault_face, Qstrikethru, Qnil), | |
2458 list1 (Fcons (Qnil, Qnil))); | |
2459 set_specifier_fallback (Fget (Vdefault_face, Qhighlight, Qnil), | |
2460 list1 (Fcons (Qnil, Qnil))); | |
2461 set_specifier_fallback (Fget (Vdefault_face, Qdim, Qnil), | |
2462 list1 (Fcons (Qnil, Qnil))); | |
2463 set_specifier_fallback (Fget (Vdefault_face, Qblinking, Qnil), | |
2464 list1 (Fcons (Qnil, Qnil))); | |
2465 set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil), | |
2466 list1 (Fcons (Qnil, Qnil))); | |
2467 | |
2468 /* gui-element is the parent face of all gui elements such as | |
2469 modeline, vertical divider and toolbar. */ | |
2470 Vgui_element_face = Fmake_face (Qgui_element, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2471 build_defer_string ("gui element face"), |
428 | 2472 Qnil); |
2473 | |
2474 /* Provide some last-resort fallbacks for gui-element face which | |
2475 mustn't default to default. */ | |
2476 { | |
2477 Lisp_Object fg_fb = Qnil, bg_fb = Qnil; | |
2478 | |
3094 | 2479 /* #### gui-element face doesn't have a font property? |
2480 But it gets referred to later! */ | |
462 | 2481 #ifdef HAVE_GTK |
2482 /* We need to put something in there, or error checking gets | |
2483 #%!@#ed up before the styles are set, which override the | |
2484 fallbacks. */ | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2485 fg_fb = acons (list1 (Qgtk), build_ascstring ("black"), fg_fb); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2486 bg_fb = acons (list1 (Qgtk), build_ascstring ("Gray80"), bg_fb); |
462 | 2487 #endif |
428 | 2488 #ifdef HAVE_X_WINDOWS |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2489 fg_fb = acons (list1 (Qx), build_ascstring ("black"), fg_fb); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2490 bg_fb = acons (list1 (Qx), build_ascstring ("Gray80"), bg_fb); |
428 | 2491 #endif |
2492 #ifdef HAVE_TTY | |
2493 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); | |
2494 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); | |
2495 #endif | |
2496 #ifdef HAVE_MS_WINDOWS | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2497 fg_fb = acons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2498 bg_fb = acons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2499 fg_fb = acons (list1 (Qmswindows), build_ascstring ("black"), fg_fb); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2500 bg_fb = acons (list1 (Qmswindows), build_ascstring ("Gray75"), bg_fb); |
428 | 2501 #endif |
2502 set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb); | |
2503 set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb); | |
2504 } | |
2505 | |
2506 /* Now create the other faces that redisplay needs to refer to | |
2507 directly. We could create them in Lisp but it's simpler this | |
2508 way since we need to get them anyway. */ | |
2509 | |
2510 /* modeline is gui element. */ | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2511 Vmodeline_face = Fmake_face (Qmodeline, build_defer_string ("modeline face"), |
428 | 2512 Qnil); |
2513 | |
2514 set_specifier_fallback (Fget (Vmodeline_face, Qforeground, Qunbound), | |
2515 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
2516 set_specifier_fallback (Fget (Vmodeline_face, Qbackground, Qunbound), | |
2517 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
2518 set_specifier_fallback (Fget (Vmodeline_face, Qbackground_pixmap, Qnil), | |
2519 Fget (Vgui_element_face, Qbackground_pixmap, | |
2520 Qunbound)); | |
2521 | |
2522 /* toolbar is another gui element */ | |
2523 Vtoolbar_face = Fmake_face (Qtoolbar, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2524 build_defer_string ("toolbar face"), |
428 | 2525 Qnil); |
2526 set_specifier_fallback (Fget (Vtoolbar_face, Qforeground, Qunbound), | |
2527 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
2528 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground, Qunbound), | |
2529 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
2530 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_pixmap, Qnil), | |
2531 Fget (Vgui_element_face, Qbackground_pixmap, | |
2532 Qunbound)); | |
2533 | |
2534 /* vertical divider is another gui element */ | |
2535 Vvertical_divider_face = Fmake_face (Qvertical_divider, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2536 build_defer_string ("vertical divider face"), |
428 | 2537 Qnil); |
2538 | |
2539 set_specifier_fallback (Fget (Vvertical_divider_face, Qforeground, Qunbound), | |
2540 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
2541 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground, Qunbound), | |
2542 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
2543 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground_pixmap, | |
2544 Qunbound), | |
2545 Fget (Vgui_element_face, Qbackground_pixmap, | |
2546 Qunbound)); | |
2547 | |
2548 /* widget is another gui element */ | |
2549 Vwidget_face = Fmake_face (Qwidget, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2550 build_defer_string ("widget face"), |
428 | 2551 Qnil); |
3094 | 2552 /* #### weird ... the gui-element face doesn't have its own font yet */ |
442 | 2553 set_specifier_fallback (Fget (Vwidget_face, Qfont, Qunbound), |
2554 Fget (Vgui_element_face, Qfont, Qunbound)); | |
428 | 2555 set_specifier_fallback (Fget (Vwidget_face, Qforeground, Qunbound), |
2556 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
2557 set_specifier_fallback (Fget (Vwidget_face, Qbackground, Qunbound), | |
2558 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
442 | 2559 /* We don't want widgets to have a default background pixmap. */ |
428 | 2560 |
2561 Vleft_margin_face = Fmake_face (Qleft_margin, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2562 build_defer_string ("left margin face"), |
428 | 2563 Qnil); |
2564 Vright_margin_face = Fmake_face (Qright_margin, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2565 build_defer_string ("right margin face"), |
428 | 2566 Qnil); |
2567 Vtext_cursor_face = Fmake_face (Qtext_cursor, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2568 build_defer_string ("face for text cursor"), |
428 | 2569 Qnil); |
2570 Vpointer_face = | |
2571 Fmake_face (Qpointer, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2572 build_defer_string |
428 | 2573 ("face for foreground/background colors of mouse pointer"), |
2574 Qnil); | |
2575 } |