Mercurial > hg > xemacs-beta
annotate src/faces.c @ 5015:d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-08 Ben Wing <ben@xemacs.org>
* faces.c:
* faces.c (face_property_matching_instance):
* faces.c (ensure_face_cachel_contains_charset):
* faces.h (FACE_FONT):
* lisp.h:
* lisp.h (enum font_specifier_matchspec_stages):
* objects-msw.c:
* objects-msw.c (mswindows_font_spec_matches_charset):
* objects-msw.c (mswindows_find_charset_font):
* objects-tty.c:
* objects-tty.c (tty_font_spec_matches_charset):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c:
* objects-xlike-inc.c (XFUN):
* objects-xlike-inc.c (xft_find_charset_font):
* objects.c:
* objects.c (font_instantiate):
* objects.c (FROB):
* specifier.c:
* specifier.c (charset_matches_specifier_tag_set_p):
* specifier.c (call_charset_predicate):
* specifier.c (define_specifier_tag):
* specifier.c (Fdefine_specifier_tag):
* specifier.c (setup_charset_initial_specifier_tags):
* specifier.c (specifier_instance_from_inst_list):
* specifier.c (FROB):
* specifier.c (vars_of_specifier):
* specifier.h:
Rename the specifier-font-matching stages in preparation for
eliminating shadowed warnings, some other related fixes from
ben-unicode-internal.
1. Rename raw enums:
initial -> STAGE_INITIAL
final -> STAGE_FINAL
impossible -> NUM_MATCHSPEC_STAGES
2. Move `enum font_specifier_matchspec_stages' from
specifier.h to lisp.h.
3. Whitespace changes to match coding standards.
4. Eliminate unused second argument STAGE in charset predicates
that don't use it -- the code that calls the charset predicates
is now smart enough to supply the right number of arguments
automatically.
5. Add some long(ish) comments and authorial notices, esp. in
objects.c.
6. In specifier.c, change Vcharset_tag_lists from a vector over
leading bytes to a hash table over charsets. This change is
unnecessary currently but doesn't hurt and will be required
when we merge in Unicode-internal.
7. In specifier.c, extract out the code that calls charset predicates
into a function call_charset_predicate().
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 08 Feb 2010 16:51:25 -0600 |
| parents | ae48681c47fa |
| children | d0c14ea98592 b5df3737028a |
| 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 void | |
| 792 default_face_height_and_width_1 (Lisp_Object domain, | |
| 793 int *height, int *width) | |
| 794 { | |
| 795 if (window_system_pixelated_geometry (domain)) | |
| 796 { | |
| 797 if (height) | |
| 798 *height = 1; | |
| 799 if (width) | |
| 800 *width = 1; | |
| 801 } | |
| 802 else | |
| 803 default_face_height_and_width (domain, height, width); | |
| 804 } | |
| 805 | |
| 806 DEFUN ("face-list", Fface_list, 0, 1, 0, /* | |
| 807 Return a list of the names of all defined faces. | |
| 808 If TEMPORARY is nil, only the permanent faces are included. | |
| 809 If it is t, only the temporary faces are included. If it is any | |
| 810 other non-nil value both permanent and temporary are included. | |
| 811 */ | |
| 812 (temporary)) | |
| 813 { | |
| 814 Lisp_Object face_list = Qnil; | |
| 815 | |
| 816 /* Added the permanent faces, if requested. */ | |
| 817 if (NILP (temporary) || !EQ (Qt, temporary)) | |
| 818 face_list = permanent_faces_list (); | |
| 819 | |
| 820 if (!NILP (temporary)) | |
| 821 { | |
| 822 struct gcpro gcpro1; | |
| 823 GCPRO1 (face_list); | |
| 824 face_list = nconc2 (face_list, temporary_faces_list ()); | |
| 825 UNGCPRO; | |
| 826 } | |
| 827 | |
| 828 return face_list; | |
| 829 } | |
| 830 | |
| 831 DEFUN ("make-face", Fmake_face, 1, 3, 0, /* | |
| 444 | 832 Define a new face with name NAME (a symbol), described by DOC-STRING. |
| 833 You can modify the font, color, etc. of a face with the set-face-* functions. | |
| 428 | 834 If the face already exists, it is unmodified. |
| 835 If TEMPORARY is non-nil, this face will cease to exist if not in use. | |
| 836 */ | |
| 837 (name, doc_string, temporary)) | |
| 838 { | |
| 839 /* This function can GC if initialized is non-zero */ | |
| 440 | 840 Lisp_Face *f; |
| 428 | 841 Lisp_Object face; |
| 842 | |
| 843 CHECK_SYMBOL (name); | |
| 844 if (!NILP (doc_string)) | |
| 845 CHECK_STRING (doc_string); | |
| 846 | |
| 847 face = Ffind_face (name); | |
| 848 if (!NILP (face)) | |
| 849 return face; | |
| 850 | |
| 851 f = allocate_face (); | |
| 793 | 852 face = wrap_face (f); |
| 428 | 853 |
| 854 f->name = name; | |
| 855 f->doc_string = doc_string; | |
| 856 f->foreground = Fmake_specifier (Qcolor); | |
| 857 set_color_attached_to (f->foreground, face, Qforeground); | |
| 858 f->background = Fmake_specifier (Qcolor); | |
| 859 set_color_attached_to (f->background, face, Qbackground); | |
| 860 f->font = Fmake_specifier (Qfont); | |
| 861 set_font_attached_to (f->font, face, Qfont); | |
| 862 f->background_pixmap = Fmake_specifier (Qimage); | |
| 863 set_image_attached_to (f->background_pixmap, face, Qbackground_pixmap); | |
| 864 f->display_table = Fmake_specifier (Qdisplay_table); | |
| 865 f->underline = Fmake_specifier (Qface_boolean); | |
| 866 set_face_boolean_attached_to (f->underline, face, Qunderline); | |
| 867 f->strikethru = Fmake_specifier (Qface_boolean); | |
| 868 set_face_boolean_attached_to (f->strikethru, face, Qstrikethru); | |
| 869 f->highlight = Fmake_specifier (Qface_boolean); | |
| 870 set_face_boolean_attached_to (f->highlight, face, Qhighlight); | |
| 871 f->dim = Fmake_specifier (Qface_boolean); | |
| 872 set_face_boolean_attached_to (f->dim, face, Qdim); | |
| 873 f->blinking = Fmake_specifier (Qface_boolean); | |
| 874 set_face_boolean_attached_to (f->blinking, face, Qblinking); | |
| 875 f->reverse = Fmake_specifier (Qface_boolean); | |
| 876 set_face_boolean_attached_to (f->reverse, face, Qreverse); | |
| 877 if (!NILP (Vdefault_face)) | |
| 878 { | |
| 879 /* If the default face has already been created, set it as | |
| 880 the default fallback specifier for all the specifiers we | |
| 881 just created. This implements the standard "all faces | |
| 882 inherit from default" behavior. */ | |
| 883 set_specifier_fallback (f->foreground, | |
| 884 Fget (Vdefault_face, Qforeground, Qunbound)); | |
| 885 set_specifier_fallback (f->background, | |
| 886 Fget (Vdefault_face, Qbackground, Qunbound)); | |
| 887 set_specifier_fallback (f->font, | |
| 888 Fget (Vdefault_face, Qfont, Qunbound)); | |
| 889 set_specifier_fallback (f->background_pixmap, | |
| 890 Fget (Vdefault_face, Qbackground_pixmap, | |
| 891 Qunbound)); | |
| 892 set_specifier_fallback (f->display_table, | |
| 893 Fget (Vdefault_face, Qdisplay_table, Qunbound)); | |
| 894 set_specifier_fallback (f->underline, | |
| 895 Fget (Vdefault_face, Qunderline, Qunbound)); | |
| 896 set_specifier_fallback (f->strikethru, | |
| 897 Fget (Vdefault_face, Qstrikethru, Qunbound)); | |
| 898 set_specifier_fallback (f->highlight, | |
| 899 Fget (Vdefault_face, Qhighlight, Qunbound)); | |
| 900 set_specifier_fallback (f->dim, | |
| 901 Fget (Vdefault_face, Qdim, Qunbound)); | |
| 902 set_specifier_fallback (f->blinking, | |
| 903 Fget (Vdefault_face, Qblinking, Qunbound)); | |
| 904 set_specifier_fallback (f->reverse, | |
| 905 Fget (Vdefault_face, Qreverse, Qunbound)); | |
| 906 } | |
| 907 | |
| 908 /* Add the face to the appropriate list. */ | |
| 909 if (NILP (temporary)) | |
| 910 Fputhash (name, face, Vpermanent_faces_cache); | |
| 911 else | |
| 912 Fputhash (name, face, Vtemporary_faces_cache); | |
| 913 | |
| 914 /* Note that it's OK if we dump faces. | |
| 915 When we start up again when we're not noninteractive, | |
| 916 `init-global-faces' is called and it resources all | |
| 917 existing faces. */ | |
| 918 if (initialized && !noninteractive) | |
| 919 { | |
| 920 struct gcpro gcpro1, gcpro2; | |
| 921 | |
| 922 GCPRO2 (name, face); | |
| 923 call1 (Qinit_face_from_resources, name); | |
| 924 UNGCPRO; | |
| 925 } | |
| 926 | |
| 927 return face; | |
| 928 } | |
| 929 | |
| 930 | |
| 931 /***************************************************************************** | |
| 932 initialization code | |
| 933 ****************************************************************************/ | |
| 934 | |
| 935 void | |
| 936 init_global_faces (struct device *d) | |
| 937 { | |
| 938 /* When making the initial terminal device, there is no Lisp code | |
| 939 loaded, so we can't do this. */ | |
| 940 if (initialized && !noninteractive) | |
| 872 | 941 call_critical_lisp_code (d, Qinit_global_faces, wrap_device (d)); |
| 428 | 942 } |
| 943 | |
| 944 void | |
| 945 init_device_faces (struct device *d) | |
| 946 { | |
| 947 /* This function can call lisp */ | |
| 948 | |
| 949 /* When making the initial terminal device, there is no Lisp code | |
| 950 loaded, so we can't do this. */ | |
| 951 if (initialized) | |
| 872 | 952 call_critical_lisp_code (d, Qinit_device_faces, wrap_device (d)); |
| 428 | 953 } |
| 954 | |
| 955 void | |
| 956 init_frame_faces (struct frame *frm) | |
| 957 { | |
| 958 /* When making the initial terminal device, there is no Lisp code | |
| 959 loaded, so we can't do this. */ | |
| 960 if (initialized) | |
| 961 { | |
| 793 | 962 Lisp_Object tframe = wrap_frame (frm); |
| 963 | |
| 428 | 964 |
| 965 /* DO NOT change the selected frame here. If the debugger goes off | |
| 4187 | 966 it will try and display on the frame being created, but it is not |
| 967 ready for that yet and a horrible death will occur. Any random | |
| 968 code depending on the selected-frame as an implicit arg should be | |
| 969 tracked down and shot. For the benefit of the one known, | |
| 970 xpm-color-symbols, make-frame sets the variable | |
| 971 Vframe_being_created to the frame it is making and sets it to nil | |
| 972 when done. Internal functions that this could trigger which are | |
| 973 currently depending on selected-frame should use this instead. It | |
| 974 is not currently visible at the lisp level. */ | |
| 428 | 975 call_critical_lisp_code (XDEVICE (FRAME_DEVICE (frm)), |
| 976 Qinit_frame_faces, tframe); | |
| 977 } | |
| 978 } | |
| 979 | |
| 980 | |
| 981 /**************************************************************************** | |
| 982 * face cache element functions * | |
| 983 ****************************************************************************/ | |
| 984 | |
| 985 /* | |
| 986 | |
| 987 #### Here is a description of how the face cache elements ought | |
| 988 to be redone. It is *NOT* how they work currently: | |
| 989 | |
| 990 However, when I started to go about implementing this, I realized | |
| 991 that there are all sorts of subtle problems with cache coherency | |
| 992 that are coming up. As it turns out, these problems don't | |
| 993 manifest themselves now due to the brute-force "kill 'em all" | |
| 994 approach to cache invalidation when faces change; but if this | |
| 995 is ever made smarter, these problems are going to come up, and | |
| 996 some of them are very non-obvious. | |
| 997 | |
| 998 I'm thinking of redoing the cache code a bit to avoid these | |
| 999 coherency problems. The bulk of the problems will arise because | |
| 1000 the current display structures have simple indices into the | |
| 1001 face cache, but the cache can be changed at various times, | |
| 1002 which could make the current display structures incorrect. | |
| 1003 I guess the dirty and updated flags are an attempt to fix | |
| 1004 this, but this approach doesn't really work. | |
| 1005 | |
| 1006 Here's an approach that should keep things clean and unconfused: | |
| 1007 | |
| 1008 1) Imagine a "virtual face cache" that can grow arbitrarily | |
| 1009 big and for which the only thing allowed is to add new | |
| 1010 elements. Existing elements cannot be removed or changed. | |
| 1011 This way, any pointers in the existing redisplay structure | |
| 1012 into the cache never get screwed up. (This is important | |
| 1013 because even if a cache element is out of date, if there's | |
| 1014 a pointer to it then its contents still accurately describe | |
| 1015 the way the text currently looks on the screen.) | |
| 1016 2) Each element in the virtual cache either describes exactly | |
| 1017 one face, or describes the merger of a number of faces | |
| 1018 by some process. In order to simplify things, for mergers | |
| 1019 we do not record which faces or ordering was used, but | |
| 1020 simply that this cache element is the result of merging. | |
| 1021 Unlike the current implementation, it's important that a | |
| 1022 single cache element not be used to both describe a | |
| 1023 single face and describe a merger, even if all the property | |
| 1024 values are the same. | |
| 1025 3) Each cache element can be clean or dirty. "Dirty" means | |
| 1026 that the face that the element points to has been changed; | |
| 1027 this gets set at the time the face is changed. This | |
| 1028 way, when looking up a value in the cache, you can determine | |
| 1029 whether it's out of date or not. For merged faces it | |
| 1030 does not matter -- we don't record the faces or priority | |
| 1031 used to create the merger, so it's impossible to look up | |
| 1032 one of these faces. We have to recompute it each time. | |
| 1033 Luckily, this is fine -- doing the merge is much | |
| 1034 less expensive than recomputing the properties of a | |
| 1035 single face. | |
| 1036 4) For each cache element, we keep a hash value. (In order | |
| 1037 to hash the boolean properties, we convert each of them | |
| 1038 into a different large prime number so that the hashing works | |
| 1039 well.) This allows us, when comparing runes, to properly | |
| 1040 determine whether the face for that rune has changed. | |
| 1041 This will be especially important for TTY's, where there | |
| 1042 aren't that many faces and minimizing redraw is very | |
| 1043 important. | |
| 1044 5) We can't actually keep an infinite cache, but that doesn't | |
| 1045 really matter that much. The only elements we care about | |
| 1046 are those that are used by either the current or desired | |
| 1047 display structs. Therefore, we keep a per-window | |
| 1048 redisplay iteration number, and mark each element with | |
| 1049 that number as we use it. Just after outputting the | |
| 1050 window and synching the redisplay structs, we go through | |
| 1051 the cache and invalidate all elements that are not clean | |
| 1052 elements referring to a particular face and that do not | |
| 1053 have an iteration number equal to the current one. We | |
| 1054 keep them in a chain, and use them to allocate new | |
| 1055 elements when possible instead of increasing the Dynarr. | |
| 1056 | |
| 872 | 1057 --ben (?? At least I think I wrote this!) |
| 428 | 1058 */ |
| 1059 | |
| 1060 /* mark for GC a dynarr of face cachels. */ | |
| 1061 | |
| 1062 void | |
| 1063 mark_face_cachels (face_cachel_dynarr *elements) | |
| 1064 { | |
| 1065 int elt; | |
| 1066 | |
| 1067 if (!elements) | |
| 1068 return; | |
| 1069 | |
| 1070 for (elt = 0; elt < Dynarr_length (elements); elt++) | |
| 1071 { | |
| 1072 struct face_cachel *cachel = Dynarr_atp (elements, elt); | |
| 1073 | |
| 1074 { | |
| 1075 int i; | |
| 1076 | |
| 1077 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1078 if (!NILP (cachel->font[i]) && !UNBOUNDP (cachel->font[i])) | |
| 1079 mark_object (cachel->font[i]); | |
| 1080 } | |
| 1081 mark_object (cachel->face); | |
| 1082 mark_object (cachel->foreground); | |
| 1083 mark_object (cachel->background); | |
| 1084 mark_object (cachel->display_table); | |
| 1085 mark_object (cachel->background_pixmap); | |
| 1086 } | |
| 1087 } | |
| 1088 | |
| 1089 /* ensure that the given cachel contains an updated font value for | |
| 3094 | 1090 the given charset. Return the updated font value (which can be |
| 1091 Qunbound, so this value must not be passed unchecked to Lisp). | |
| 1092 | |
| 1093 #### Xft: This function will need to be updated for new font model. */ | |
| 428 | 1094 |
| 1095 Lisp_Object | |
| 1096 ensure_face_cachel_contains_charset (struct face_cachel *cachel, | |
| 1097 Lisp_Object domain, Lisp_Object charset) | |
| 1098 { | |
| 1099 Lisp_Object new_val; | |
| 1100 Lisp_Object face = cachel->face; | |
| 3659 | 1101 int bound = 1, final_stage = 0; |
| 428 | 1102 int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; |
| 1103 | |
| 4187 | 1104 if (!UNBOUNDP (cachel->font[offs]) && |
| 3659 | 1105 bit_vector_bit(FACE_CACHEL_FONT_UPDATED (cachel), offs)) |
| 428 | 1106 return cachel->font[offs]; |
| 1107 | |
| 1108 if (UNBOUNDP (face)) | |
| 1109 { | |
| 1110 /* a merged face. */ | |
| 1111 int i; | |
| 1112 struct window *w = XWINDOW (domain); | |
| 1113 | |
| 1114 new_val = Qunbound; | |
| 3659 | 1115 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 0); |
| 1116 | |
| 428 | 1117 for (i = 0; i < cachel->nfaces; i++) |
| 1118 { | |
| 1119 struct face_cachel *oth; | |
| 1120 | |
| 1121 oth = Dynarr_atp (w->face_cachels, | |
| 1122 FACE_CACHEL_FINDEX_UNSAFE (cachel, i)); | |
| 1123 /* Tout le monde aime la recursion */ | |
| 1124 ensure_face_cachel_contains_charset (oth, domain, charset); | |
| 1125 | |
| 3659 | 1126 if (bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(oth), offs)) |
| 428 | 1127 { |
| 1128 new_val = oth->font[offs]; | |
| 3659 | 1129 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1); |
| 1130 set_bit_vector_bit | |
| 4187 | 1131 (FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs, |
| 3659 | 1132 bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(oth), offs)); |
| 428 | 1133 break; |
| 1134 } | |
| 1135 } | |
| 1136 | |
| 3659 | 1137 if (!bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs)) |
| 428 | 1138 /* need to do the default face. */ |
| 1139 { | |
| 1140 struct face_cachel *oth = | |
| 1141 Dynarr_atp (w->face_cachels, DEFAULT_INDEX); | |
| 1142 ensure_face_cachel_contains_charset (oth, domain, charset); | |
| 1143 | |
| 1144 new_val = oth->font[offs]; | |
| 1145 } | |
| 1146 | |
| 4187 | 1147 if (!UNBOUNDP (cachel->font[offs]) && |
| 3659 | 1148 !EQ (cachel->font[offs], new_val)) |
| 428 | 1149 cachel->dirty = 1; |
| 3659 | 1150 set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1); |
| 428 | 1151 cachel->font[offs] = new_val; |
| 3659 | 1152 DEBUG_FACES("just recursed on the unbound face, returning " |
| 1153 "something %s\n", UNBOUNDP(new_val) ? "not bound" | |
| 1154 : "bound"); | |
| 428 | 1155 return new_val; |
| 1156 } | |
| 1157 | |
| 3659 | 1158 do { |
| 1159 | |
| 1160 /* Lookup the face, specifying the initial stage and that fallbacks | |
| 1161 shouldn't happen. */ | |
| 1162 new_val = face_property_matching_instance (face, Qfont, charset, domain, | |
| 1163 /* ERROR_ME_DEBUG_WARN is | |
| 1164 fine here. */ | |
| 1165 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
|
1166 STAGE_INITIAL); |
| 3659 | 1167 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " |
| 4187 | 1168 "result was something %s\n", |
| 1169 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), | |
| 3659 | 1170 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), |
| 1171 UNBOUNDP(new_val) ? "not bound" : "bound"); | |
| 1172 | |
| 1173 if (!UNBOUNDP (new_val)) break; | |
| 1174 | |
| 1175 bound = 0; | |
| 1176 /* Lookup the face again, this time allowing the fallback. If this | |
| 1177 succeeds, it'll give a font intended for the script in question, | |
| 1178 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
|
1179 fixed-width fallback. |
|
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1180 |
|
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1181 #### 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
|
1182 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
|
1183 unlikely to have specified them herself, a common complaint. */ |
| 3659 | 1184 new_val = face_property_matching_instance (face, Qfont, |
| 1185 charset, domain, | |
| 1186 ERROR_ME_DEBUG_WARN, 0, | |
| 4187 | 1187 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
|
1188 STAGE_INITIAL); |
| 3659 | 1189 |
|
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
|
1190 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
|
1191 "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
|
1192 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
|
1193 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
|
1194 UNBOUNDP (new_val) ? "not bound" : "bound"); |
| 3659 | 1195 |
|
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
|
1196 if (!UNBOUNDP (new_val)) |
| 3659 | 1197 { |
| 1198 break; | |
| 1199 } | |
| 1200 | |
| 1201 bound = 1; | |
| 1202 /* Try the face itself with the final-stage specifiers. */ | |
| 1203 new_val = face_property_matching_instance (face, Qfont, | |
| 1204 charset, domain, | |
| 1205 ERROR_ME_DEBUG_WARN, 1, | |
| 4187 | 1206 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
|
1207 STAGE_FINAL); |
| 3659 | 1208 |
| 1209 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, final, " | |
| 4187 | 1210 "result was something %s\n", |
| 1211 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), | |
| 3659 | 1212 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), |
| 1213 UNBOUNDP(new_val) ? "not bound" : "bound"); | |
| 1214 /* 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
|
1215 if (!UNBOUNDP (new_val)) |
| 3659 | 1216 { |
| 1217 final_stage = 1; | |
| 1218 break; | |
| 1219 } | |
| 1220 | |
| 1221 bound = 0; | |
| 1222 | |
| 1223 /* Lookup the face again, this time both allowing the fallback and | |
| 1224 allowing its final stage to be used. */ | |
| 1225 new_val = face_property_matching_instance (face, Qfont, | |
| 1226 charset, domain, | |
| 1227 ERROR_ME_DEBUG_WARN, 0, | |
| 4187 | 1228 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
|
1229 STAGE_FINAL); |
| 3659 | 1230 |
|
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
|
1231 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
|
1232 "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
|
1233 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
|
1234 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
|
1235 UNBOUNDP (new_val) ? "not bound" : "bound"); |
| 3659 | 1236 if (!UNBOUNDP(new_val)) |
| 1237 { | |
| 1238 /* Tell X11 redisplay that it should translate to iso10646-1. */ | |
| 1239 final_stage = 1; | |
| 1240 break; | |
| 1241 } | |
| 1242 } while (0); | |
| 1243 | |
| 428 | 1244 if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs])) |
| 1245 cachel->dirty = 1; | |
| 3659 | 1246 |
| 1247 set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1); | |
| 1248 set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs, | |
| 1249 final_stage); | |
| 4187 | 1250 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, |
| 3659 | 1251 (bound || EQ (face, Vdefault_face))); |
| 428 | 1252 cachel->font[offs] = new_val; |
| 1253 return new_val; | |
| 1254 } | |
| 1255 | |
| 1256 /* Ensure that the given cachel contains updated fonts for all | |
| 1257 the charsets specified. */ | |
| 1258 | |
| 1259 void | |
| 1260 ensure_face_cachel_complete (struct face_cachel *cachel, | |
| 1261 Lisp_Object domain, unsigned char *charsets) | |
| 1262 { | |
| 1263 int i; | |
| 1264 | |
| 1265 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1266 if (charsets[i]) | |
| 1267 { | |
| 826 | 1268 Lisp_Object charset = charset_by_leading_byte (i + MIN_LEADING_BYTE); |
| 428 | 1269 assert (CHARSETP (charset)); |
| 1270 ensure_face_cachel_contains_charset (cachel, domain, charset); | |
| 1271 } | |
| 1272 } | |
| 1273 | |
| 1274 void | |
| 1275 face_cachel_charset_font_metric_info (struct face_cachel *cachel, | |
| 1276 unsigned char *charsets, | |
| 1277 struct font_metric_info *fm) | |
| 1278 { | |
| 1279 int i; | |
| 1280 | |
| 1281 fm->width = 1; | |
| 1282 fm->height = fm->ascent = 1; | |
| 1283 fm->descent = 0; | |
| 1284 fm->proportional_p = 0; | |
| 1285 | |
| 1286 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1287 { | |
| 1288 if (charsets[i]) | |
| 1289 { | |
| 826 | 1290 Lisp_Object charset = charset_by_leading_byte (i + MIN_LEADING_BYTE); |
| 428 | 1291 Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset); |
| 440 | 1292 Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance); |
| 428 | 1293 |
| 1294 assert (CHARSETP (charset)); | |
| 1295 assert (FONT_INSTANCEP (font_instance)); | |
| 1296 | |
| 1297 if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent; | |
| 1298 if (fm->descent < (int) fi->descent) fm->descent = (int) fi->descent; | |
| 1299 fm->height = fm->ascent + fm->descent; | |
| 1300 if (fi->proportional_p) | |
| 1301 fm->proportional_p = 1; | |
| 1302 if (EQ (charset, Vcharset_ascii)) | |
| 1303 fm->width = fi->width; | |
| 1304 } | |
| 1305 } | |
| 1306 } | |
| 1307 | |
| 1308 #define FROB(field) \ | |
| 1309 do { \ | |
| 1310 Lisp_Object new_val = \ | |
| 1311 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \ | |
| 1312 int bound = 1; \ | |
| 1313 if (UNBOUNDP (new_val)) \ | |
| 1314 { \ | |
| 1315 bound = 0; \ | |
| 1316 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \ | |
| 1317 } \ | |
| 1318 if (!EQ (new_val, cachel->field)) \ | |
| 1319 { \ | |
| 1320 cachel->field = new_val; \ | |
| 1321 cachel->dirty = 1; \ | |
| 1322 } \ | |
| 1323 cachel->field##_specified = (bound || default_face); \ | |
| 1324 } while (0) | |
| 1325 | |
| 446 | 1326 /* |
| 1327 * A face's background pixmap will override the face's | |
| 1328 * background color. But the background pixmap of the | |
| 1329 * default face should not override the background color of | |
| 1330 * a face if the background color has been specified or | |
| 1331 * inherited. | |
| 1332 * | |
| 1333 * To accomplish this we remove the background pixmap of the | |
| 1334 * cachel and mark it as having been specified so that cachel | |
| 1335 * merging won't override it later. | |
| 1336 */ | |
| 1337 #define MAYBE_UNFROB_BACKGROUND_PIXMAP \ | |
| 1338 do \ | |
| 1339 { \ | |
| 1340 if (! default_face \ | |
| 1341 && cachel->background_specified \ | |
| 1342 && ! cachel->background_pixmap_specified) \ | |
| 1343 { \ | |
| 1344 cachel->background_pixmap = Qunbound; \ | |
| 1345 cachel->background_pixmap_specified = 1; \ | |
| 1346 } \ | |
| 1347 } while (0) | |
| 1348 | |
| 1349 | |
| 1350 /* Add a cachel for the given face to the given window's cache. */ | |
| 1351 | |
| 1352 static void | |
| 1353 add_face_cachel (struct window *w, Lisp_Object face) | |
| 1354 { | |
| 1355 int must_finish_frobbing = ! WINDOW_FACE_CACHEL (w, DEFAULT_INDEX); | |
| 1356 struct face_cachel new_cachel; | |
| 1357 Lisp_Object domain; | |
| 1358 | |
| 1359 reset_face_cachel (&new_cachel); | |
| 793 | 1360 domain = wrap_window (w); |
| 446 | 1361 update_face_cachel_data (&new_cachel, domain, face); |
| 1362 Dynarr_add (w->face_cachels, new_cachel); | |
| 1363 | |
| 1364 /* 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
|
1365 in update_face_cachel_data), so we have to do it now */ |
| 446 | 1366 if (must_finish_frobbing) |
| 1367 { | |
| 1368 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
|
1369 struct face_cachel *cachel = Dynarr_lastp (w->face_cachels); |
| 446 | 1370 |
| 1371 FROB (background_pixmap); | |
| 1372 MAYBE_UNFROB_BACKGROUND_PIXMAP; | |
| 1373 } | |
| 1374 } | |
| 1375 | |
| 1376 /* Called when the updated flag has been cleared on a cachel. | |
| 1377 This function returns 1 if the caller must finish the update (see comment | |
| 1378 below), 0 otherwise. | |
| 1379 */ | |
| 1380 | |
| 1381 void | |
| 1382 update_face_cachel_data (struct face_cachel *cachel, | |
| 1383 Lisp_Object domain, | |
| 1384 Lisp_Object face) | |
| 1385 { | |
| 1386 if (XFACE (face)->dirty || UNBOUNDP (cachel->face)) | |
| 1387 { | |
| 1388 int default_face = EQ (face, Vdefault_face); | |
| 1389 cachel->face = face; | |
| 1390 | |
| 1391 /* We normally only set the _specified flags if the value was | |
| 4187 | 1392 actually bound. The exception is for the default face where |
| 1393 we always set it since it is the ultimate fallback. */ | |
| 446 | 1394 |
| 428 | 1395 FROB (foreground); |
| 1396 FROB (background); | |
| 1397 FROB (display_table); | |
| 446 | 1398 |
| 1399 /* #### WARNING: the background pixmap property of faces is currently | |
| 1400 the only one dealing with images. The problem we have here is that | |
| 1401 frobbing the background pixmap might lead to image instantiation | |
| 1402 which in turn might require that the cache we're building be up to | |
| 1403 date, hence a crash. Here's a typical scenario of this: | |
| 1404 | |
|
4667
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1405 - a new window is created and its face cache elements are |
| 446 | 1406 initialized through a call to reset_face_cachels[1]. At that point, |
| 1407 the cache for the default and modeline faces (normaly taken care of | |
| 1408 by redisplay itself) are null. | |
| 1409 - the default face has a background pixmap which needs to be | |
| 1410 instantiated right here, as a consequence of cache initialization. | |
| 1411 - the background pixmap image happens to be instantiated as a string | |
| 1412 (this happens on tty's for instance). | |
| 1413 - In order to do this, we need to compute the string geometry. | |
| 1414 - In order to do this, we might have to access the window's default | |
| 1415 face cache. But this is the cache we're building right now, it is | |
| 1416 null. | |
| 1417 - BARF !!!!! | |
| 428 | 1418 |
| 446 | 1419 To sum up, this means that it is in general unsafe to instantiate |
| 1420 images before face cache updating is complete (appart from image | |
| 1421 related face attributes). The solution we use below is to actually | |
| 1422 detect whether we're building the window's face_cachels for the first | |
| 1423 time, and simply NOT frob the background pixmap in that case. If | |
| 1424 other image-related face attributes are ever implemented, they should | |
| 1425 be protected the same way right here. | |
| 1426 | |
| 1427 One note: | |
| 1428 * See comment in `default_face_font_info' in face.c. Who wrote it ? | |
| 1429 Maybe we have the begining of an answer here ? | |
| 1430 | |
| 1431 Footnotes: | |
| 1432 [1] See comment at the top of `allocate_window' in window.c. | |
| 1433 | |
| 1434 -- didier | |
| 1435 */ | |
| 1436 if (! WINDOWP (domain) | |
| 1437 || WINDOW_FACE_CACHEL (DOMAIN_XWINDOW (domain), DEFAULT_INDEX)) | |
| 428 | 1438 { |
| 446 | 1439 FROB (background_pixmap); |
| 1440 MAYBE_UNFROB_BACKGROUND_PIXMAP; | |
| 428 | 1441 } |
| 1442 #undef FROB | |
| 446 | 1443 #undef MAYBE_UNFROB_BACKGROUND_PIXMAP |
| 428 | 1444 |
| 1445 ensure_face_cachel_contains_charset (cachel, domain, Vcharset_ascii); | |
| 1446 | |
| 1447 #define FROB(field) \ | |
| 1448 do { \ | |
| 1449 Lisp_Object new_val = \ | |
| 1450 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \ | |
| 1451 int bound = 1; \ | |
| 1452 unsigned int new_val_int; \ | |
| 1453 if (UNBOUNDP (new_val)) \ | |
| 1454 { \ | |
| 1455 bound = 0; \ | |
| 1456 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \ | |
| 1457 } \ | |
| 1458 new_val_int = EQ (new_val, Qt); \ | |
| 1459 if (cachel->field != new_val_int) \ | |
| 1460 { \ | |
| 1461 cachel->field = new_val_int; \ | |
| 1462 cachel->dirty = 1; \ | |
| 1463 } \ | |
| 1464 cachel->field##_specified = bound; \ | |
| 1465 } while (0) | |
| 1466 | |
| 1467 FROB (underline); | |
| 1468 FROB (strikethru); | |
| 1469 FROB (highlight); | |
| 1470 FROB (dim); | |
| 1471 FROB (reverse); | |
| 1472 FROB (blinking); | |
| 1473 #undef FROB | |
| 1474 } | |
| 1475 | |
| 1476 cachel->updated = 1; | |
| 1477 } | |
| 1478 | |
| 1479 /* Merge the cachel identified by FINDEX in window W into the given | |
| 1480 cachel. */ | |
| 1481 | |
| 1482 static void | |
| 1483 merge_face_cachel_data (struct window *w, face_index findex, | |
| 1484 struct face_cachel *cachel) | |
| 1485 { | |
| 3659 | 1486 int offs; |
| 1487 | |
| 428 | 1488 #define FINDEX_FIELD(field) \ |
| 1489 Dynarr_atp (w->face_cachels, findex)->field | |
| 1490 | |
| 1491 #define FROB(field) \ | |
| 1492 do { \ | |
| 1493 if (!cachel->field##_specified && FINDEX_FIELD (field##_specified)) \ | |
| 1494 { \ | |
| 1495 cachel->field = FINDEX_FIELD (field); \ | |
| 1496 cachel->field##_specified = 1; \ | |
| 1497 cachel->dirty = 1; \ | |
| 1498 } \ | |
| 1499 } while (0) | |
| 1500 | |
| 1501 FROB (foreground); | |
| 1502 FROB (background); | |
| 1503 FROB (display_table); | |
| 1504 FROB (background_pixmap); | |
| 1505 FROB (underline); | |
| 1506 FROB (strikethru); | |
| 1507 FROB (highlight); | |
| 1508 FROB (dim); | |
| 1509 FROB (reverse); | |
| 1510 FROB (blinking); | |
| 1511 | |
| 3659 | 1512 for (offs = 0; offs < NUM_LEADING_BYTES; ++offs) |
| 1513 { | |
| 1514 if (!(bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs)) | |
| 1515 && bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED | |
| 1516 (Dynarr_atp(w->face_cachels, findex)), offs)) | |
| 1517 { | |
| 1518 cachel->font[offs] = FINDEX_FIELD (font[offs]); | |
| 1519 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1); | |
| 1520 /* Also propagate whether we're translating to Unicode for the | |
| 1521 given face. */ | |
| 4187 | 1522 set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs, |
| 3659 | 1523 bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE |
| 1524 (Dynarr_atp(w->face_cachels, | |
| 1525 findex)), offs)); | |
| 1526 cachel->dirty = 1; | |
| 1527 } | |
| 1528 } | |
| 428 | 1529 #undef FROB |
| 1530 #undef FINDEX_FIELD | |
| 1531 | |
| 1532 cachel->updated = 1; | |
| 1533 } | |
| 1534 | |
| 1535 /* Initialize a cachel. */ | |
| 3094 | 1536 /* #### Xft: this function will need to be changed for new font model. */ |
| 428 | 1537 |
| 1538 void | |
| 1539 reset_face_cachel (struct face_cachel *cachel) | |
| 1540 { | |
| 1541 xzero (*cachel); | |
| 1542 cachel->face = Qunbound; | |
| 1543 cachel->nfaces = 0; | |
| 1544 cachel->merged_faces = 0; | |
| 1545 cachel->foreground = Qunbound; | |
| 1546 cachel->background = Qunbound; | |
| 1547 { | |
| 1548 int i; | |
| 1549 | |
| 1550 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1551 cachel->font[i] = Qunbound; | |
| 1552 } | |
| 1553 cachel->display_table = Qunbound; | |
| 1554 cachel->background_pixmap = Qunbound; | |
| 3659 | 1555 FACE_CACHEL_FONT_SPECIFIED (cachel)->size = sizeof(cachel->font_specified); |
| 1556 FACE_CACHEL_FONT_UPDATED (cachel)->size = sizeof(cachel->font_updated); | |
| 428 | 1557 } |
| 1558 | |
| 1559 /* Retrieve the index to a cachel for window W that corresponds to | |
| 1560 the specified face. If necessary, add a new element to the | |
| 1561 cache. */ | |
| 1562 | |
| 1563 face_index | |
| 1564 get_builtin_face_cache_index (struct window *w, Lisp_Object face) | |
| 1565 { | |
| 1566 int elt; | |
| 1567 | |
| 1568 if (noninteractive) | |
| 1569 return 0; | |
| 1570 | |
| 1571 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) | |
| 1572 { | |
| 1573 struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt); | |
| 1574 | |
| 1575 if (EQ (cachel->face, face)) | |
| 1576 { | |
| 793 | 1577 Lisp_Object window = wrap_window (w); |
| 1578 | |
| 428 | 1579 if (!cachel->updated) |
| 1580 update_face_cachel_data (cachel, window, face); | |
| 1581 return elt; | |
| 1582 } | |
| 1583 } | |
| 1584 | |
| 1585 /* If we didn't find the face, add it and then return its index. */ | |
| 1586 add_face_cachel (w, face); | |
| 1587 return elt; | |
| 1588 } | |
| 1589 | |
| 1590 void | |
| 1591 reset_face_cachels (struct window *w) | |
| 1592 { | |
| 1593 /* #### Not initialized in batch mode for the stream device. */ | |
| 1594 if (w->face_cachels) | |
| 1595 { | |
| 1596 int i; | |
| 4208 | 1597 face_index fi; |
| 428 | 1598 |
| 1599 for (i = 0; i < Dynarr_length (w->face_cachels); i++) | |
| 1600 { | |
| 1601 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, i); | |
| 1602 if (cachel->merged_faces) | |
| 1603 Dynarr_free (cachel->merged_faces); | |
| 1604 } | |
| 1605 Dynarr_reset (w->face_cachels); | |
| 4187 | 1606 /* #### NOTE: be careful with the order ! |
| 1607 The cpp macros DEFAULT_INDEX and MODELINE_INDEX defined in | |
| 4208 | 1608 redisplay.h depend on the code below. Please make sure to assert the |
| 1609 correct values if you ever add new built-in faces here. | |
| 4187 | 1610 -- dvl */ |
| 4208 | 1611 fi = get_builtin_face_cache_index (w, Vdefault_face); |
| 4210 | 1612 assert (noninteractive || fi == DEFAULT_INDEX); |
| 4208 | 1613 fi = get_builtin_face_cache_index (w, Vmodeline_face); |
| 4210 | 1614 assert (noninteractive || fi == MODELINE_INDEX); |
| 428 | 1615 XFRAME (w->frame)->window_face_cache_reset = 1; |
| 1616 } | |
| 1617 } | |
| 1618 | |
| 1619 void | |
| 1620 mark_face_cachels_as_clean (struct window *w) | |
| 1621 { | |
| 1622 int elt; | |
| 1623 | |
| 1624 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) | |
| 1625 Dynarr_atp (w->face_cachels, elt)->dirty = 0; | |
| 1626 } | |
| 1627 | |
| 3094 | 1628 /* #### Xft: this function will need to be changed for new font model. */ |
| 428 | 1629 void |
| 1630 mark_face_cachels_as_not_updated (struct window *w) | |
| 1631 { | |
| 1632 int elt; | |
| 1633 | |
| 1634 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) | |
| 1635 { | |
| 1636 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt); | |
| 1637 | |
| 1638 cachel->updated = 0; | |
| 4187 | 1639 memset(FACE_CACHEL_FONT_UPDATED(cachel)->bits, 0, |
| 3659 | 1640 BIT_VECTOR_LONG_STORAGE (NUM_LEADING_BYTES)); |
| 428 | 1641 } |
| 1642 } | |
| 1643 | |
| 1644 #ifdef MEMORY_USAGE_STATS | |
| 1645 | |
| 1646 int | |
| 1647 compute_face_cachel_usage (face_cachel_dynarr *face_cachels, | |
| 1648 struct overhead_stats *ovstats) | |
| 1649 { | |
| 1650 int total = 0; | |
| 1651 | |
| 1652 if (face_cachels) | |
| 1653 { | |
| 1654 int i; | |
| 1655 | |
| 1656 total += Dynarr_memory_usage (face_cachels, ovstats); | |
| 1657 for (i = 0; i < Dynarr_length (face_cachels); i++) | |
| 1658 { | |
| 1659 int_dynarr *merged = Dynarr_at (face_cachels, i).merged_faces; | |
| 1660 if (merged) | |
| 1661 total += Dynarr_memory_usage (merged, ovstats); | |
| 1662 } | |
| 1663 } | |
| 1664 | |
| 1665 return total; | |
| 1666 } | |
| 1667 | |
| 1668 #endif /* MEMORY_USAGE_STATS */ | |
| 1669 | |
| 1670 | |
| 1671 /***************************************************************************** | |
| 1672 * merged face functions * | |
| 1673 *****************************************************************************/ | |
| 1674 | |
| 1675 /* Compare two merged face cachels to determine whether we have to add | |
| 1676 a new entry to the face cache. | |
| 1677 | |
| 1678 Note that we do not compare the attributes, but just the faces the | |
| 1679 cachels are based on. If they are the same, then the cachels certainly | |
| 1680 ought to have the same attributes, except in the case where fonts | |
| 1681 for different charsets have been determined in the two -- and in that | |
| 1682 case this difference is fine. */ | |
| 1683 | |
| 1684 static int | |
| 1685 compare_merged_face_cachels (struct face_cachel *cachel1, | |
| 1686 struct face_cachel *cachel2) | |
| 1687 { | |
| 1688 int i; | |
| 1689 | |
| 1690 if (!EQ (cachel1->face, cachel2->face) | |
| 1691 || cachel1->nfaces != cachel2->nfaces) | |
| 1692 return 0; | |
| 1693 | |
| 1694 for (i = 0; i < cachel1->nfaces; i++) | |
| 1695 if (FACE_CACHEL_FINDEX_UNSAFE (cachel1, i) | |
| 1696 != FACE_CACHEL_FINDEX_UNSAFE (cachel2, i)) | |
| 1697 return 0; | |
| 1698 | |
| 1699 return 1; | |
| 1700 } | |
| 1701 | |
| 1702 /* Retrieve the index to a cachel for window W that corresponds to | |
| 1703 the specified cachel. If necessary, add a new element to the | |
| 1704 cache. This is similar to get_builtin_face_cache_index() but | |
| 1705 is intended for merged cachels rather than for cachels representing | |
| 1706 just a face. | |
| 1707 | |
| 1708 Note that a merged cachel for just one face is not the same as | |
| 1709 the simple cachel for that face, because it is also merged with | |
| 1710 the default face. */ | |
| 1711 | |
| 1712 static face_index | |
| 1713 get_merged_face_cache_index (struct window *w, | |
| 1714 struct face_cachel *merged_cachel) | |
| 1715 { | |
| 1716 int elt; | |
| 1717 int cache_size = Dynarr_length (w->face_cachels); | |
| 1718 | |
| 1719 for (elt = 0; elt < cache_size; elt++) | |
| 1720 { | |
| 1721 struct face_cachel *cachel = | |
| 1722 Dynarr_atp (w->face_cachels, elt); | |
| 1723 | |
| 1724 if (compare_merged_face_cachels (cachel, merged_cachel)) | |
| 1725 return elt; | |
| 1726 } | |
| 1727 | |
| 1728 /* We didn't find it so add this instance to the cache. */ | |
| 1729 merged_cachel->updated = 1; | |
| 1730 merged_cachel->dirty = 1; | |
| 1731 Dynarr_add (w->face_cachels, *merged_cachel); | |
| 1732 return cache_size; | |
| 1733 } | |
| 1734 | |
| 1735 face_index | |
| 1736 get_extent_fragment_face_cache_index (struct window *w, | |
| 1737 struct extent_fragment *ef) | |
| 1738 { | |
| 1739 struct face_cachel cachel; | |
| 1740 int len = Dynarr_length (ef->extents); | |
| 1741 face_index findex = 0; | |
| 1742 | |
| 1743 /* Optimize the default case. */ | |
| 1744 if (len == 0) | |
| 1745 return DEFAULT_INDEX; | |
| 1746 else | |
| 1747 { | |
| 1748 int i; | |
| 1749 | |
| 1750 /* Merge the faces of the extents together in order. */ | |
| 1751 | |
| 1752 reset_face_cachel (&cachel); | |
| 1753 | |
| 1754 for (i = len - 1; i >= 0; i--) | |
| 1755 { | |
| 1756 EXTENT current = Dynarr_at (ef->extents, i); | |
| 1757 int has_findex = 0; | |
| 1758 Lisp_Object face = extent_face (current); | |
| 1759 | |
| 1760 if (FACEP (face)) | |
| 1761 { | |
| 1762 findex = get_builtin_face_cache_index (w, face); | |
| 1763 has_findex = 1; | |
| 1764 merge_face_cachel_data (w, findex, &cachel); | |
| 1765 } | |
| 1766 /* remember, we're called from within redisplay | |
| 1767 so we can't error. */ | |
| 1768 else while (CONSP (face)) | |
| 1769 { | |
| 1770 Lisp_Object one_face = XCAR (face); | |
| 1771 if (FACEP (one_face)) | |
| 1772 { | |
| 1773 findex = get_builtin_face_cache_index (w, one_face); | |
| 1774 merge_face_cachel_data (w, findex, &cachel); | |
| 1775 | |
| 1776 /* code duplication here but there's no clean | |
| 1777 way to avoid it. */ | |
| 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 face = XCDR (face); | |
| 1789 } | |
| 1790 | |
| 1791 if (has_findex) | |
| 1792 { | |
| 1793 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES) | |
| 1794 { | |
| 1795 if (!cachel.merged_faces) | |
| 1796 cachel.merged_faces = Dynarr_new (int); | |
| 1797 Dynarr_add (cachel.merged_faces, findex); | |
| 1798 } | |
| 1799 else | |
| 1800 cachel.merged_faces_static[cachel.nfaces] = findex; | |
| 1801 cachel.nfaces++; | |
| 1802 } | |
| 1803 } | |
| 1804 | |
| 1805 /* Now finally merge in the default face. */ | |
| 1806 findex = get_builtin_face_cache_index (w, Vdefault_face); | |
| 1807 merge_face_cachel_data (w, findex, &cachel); | |
| 1808 | |
| 444 | 1809 findex = get_merged_face_cache_index (w, &cachel); |
| 1810 if (cachel.merged_faces && | |
| 1811 /* merged_faces did not get stored and available via return value */ | |
| 1812 Dynarr_at (w->face_cachels, findex).merged_faces != | |
| 1813 cachel.merged_faces) | |
| 1814 { | |
| 1815 Dynarr_free (cachel.merged_faces); | |
| 1816 cachel.merged_faces = 0; | |
| 1817 } | |
| 1818 return findex; | |
| 428 | 1819 } |
| 1820 } | |
| 1821 | |
| 3094 | 1822 /* Return a cache index for window W from merging the faces in FACE_LIST. |
| 1823 COUNT is the number of faces in the list. | |
| 1824 | |
| 1825 The default face should not be included in the list, as it is always | |
| 1826 implicitly merged into the cachel. | |
| 1827 | |
| 1828 WARNING: this interface may change. */ | |
| 1829 | |
| 1830 face_index | |
| 1831 merge_face_list_to_cache_index (struct window *w, | |
| 1832 Lisp_Object *face_list, int count) | |
| 1833 { | |
| 1834 int i; | |
| 1835 face_index findex = 0; | |
| 1836 struct face_cachel cachel; | |
| 1837 | |
| 1838 reset_face_cachel (&cachel); | |
| 1839 | |
| 1840 for (i = 0; i < count; i++) | |
| 1841 { | |
| 1842 Lisp_Object face = face_list[i]; | |
| 1843 | |
| 1844 if (!NILP (face)) | |
| 1845 { | |
| 1846 CHECK_FACE(face); /* #### presumably unnecessary */ | |
| 1847 findex = get_builtin_face_cache_index (w, face); | |
| 1848 merge_face_cachel_data (w, findex, &cachel); | |
| 1849 } | |
| 1850 } | |
| 1851 | |
| 1852 /* Now finally merge in the default face. */ | |
| 1853 findex = get_builtin_face_cache_index (w, Vdefault_face); | |
| 1854 merge_face_cachel_data (w, findex, &cachel); | |
| 1855 | |
| 1856 return get_merged_face_cache_index (w, &cachel); | |
| 1857 } | |
| 1858 | |
| 428 | 1859 |
| 1860 /***************************************************************************** | |
| 1861 interface functions | |
| 1862 ****************************************************************************/ | |
| 1863 | |
| 1864 static void | |
| 1865 update_EmacsFrame (Lisp_Object frame, Lisp_Object name) | |
| 1866 { | |
| 1867 struct frame *frm = XFRAME (frame); | |
| 1868 | |
| 3676 | 1869 if (!FRAME_LIVE_P(frm)) |
| 1870 return; | |
| 1871 | |
| 428 | 1872 if (EQ (name, Qfont)) |
| 1873 MARK_FRAME_SIZE_SLIPPED (frm); | |
| 1874 | |
| 1875 MAYBE_FRAMEMETH (frm, update_frame_external_traits, (frm, name)); | |
| 1876 } | |
| 1877 | |
| 1878 static void | |
| 1879 update_EmacsFrames (Lisp_Object locale, Lisp_Object name) | |
| 1880 { | |
| 1881 if (FRAMEP (locale)) | |
| 1882 { | |
| 1883 update_EmacsFrame (locale, name); | |
| 1884 } | |
| 1885 else if (DEVICEP (locale)) | |
| 1886 { | |
| 1887 Lisp_Object frmcons; | |
| 1888 | |
| 1889 DEVICE_FRAME_LOOP (frmcons, XDEVICE (locale)) | |
| 1890 update_EmacsFrame (XCAR (frmcons), name); | |
| 1891 } | |
| 1892 else if (EQ (locale, Qglobal) || EQ (locale, Qfallback)) | |
| 1893 { | |
| 1894 Lisp_Object frmcons, devcons, concons; | |
| 1895 | |
| 1896 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) | |
| 1897 update_EmacsFrame (XCAR (frmcons), name); | |
| 1898 } | |
| 1899 } | |
| 1900 | |
| 1901 void | |
| 1902 update_frame_face_values (struct frame *f) | |
| 1903 { | |
| 793 | 1904 Lisp_Object frm = wrap_frame (f); |
| 428 | 1905 |
| 1906 update_EmacsFrame (frm, Qforeground); | |
| 1907 update_EmacsFrame (frm, Qbackground); | |
| 1908 update_EmacsFrame (frm, Qfont); | |
| 1909 } | |
| 1910 | |
| 1911 void | |
| 1912 face_property_was_changed (Lisp_Object face, Lisp_Object property, | |
| 1913 Lisp_Object locale) | |
| 1914 { | |
| 1915 int default_face = EQ (face, Vdefault_face); | |
| 1916 | |
| 1917 /* If the locale could affect the frame value, then call | |
| 1918 update_EmacsFrames just in case. */ | |
| 1919 if (default_face && | |
| 1920 (EQ (property, Qforeground) || | |
| 1921 EQ (property, Qbackground) || | |
| 1922 EQ (property, Qfont))) | |
| 1923 update_EmacsFrames (locale, property); | |
| 1924 | |
| 1925 if (WINDOWP (locale)) | |
| 1926 { | |
| 1927 MARK_FRAME_FACES_CHANGED (XFRAME (XWINDOW (locale)->frame)); | |
| 1928 } | |
| 1929 else if (FRAMEP (locale)) | |
| 1930 { | |
| 1931 MARK_FRAME_FACES_CHANGED (XFRAME (locale)); | |
| 1932 } | |
| 1933 else if (DEVICEP (locale)) | |
| 1934 { | |
| 1935 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (locale)); | |
| 1936 } | |
| 1937 else | |
| 1938 { | |
| 1939 Lisp_Object devcons, concons; | |
| 1940 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 1941 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (XCAR (devcons))); | |
| 1942 } | |
| 1943 | |
| 1944 /* | |
| 1945 * This call to update_faces_inheritance isn't needed and makes | |
| 1946 * creating and modifying faces _very_ slow. The point of | |
| 1947 * update_face_inheritances is to find all faces that inherit | |
| 1948 * directly from this face property and set the specifier "dirty" | |
| 1949 * flag on the corresponding specifier. This forces recaching of | |
| 1950 * cached specifier values in frame and window struct slots. But | |
| 1951 * currently no face properties are cached in frame and window | |
| 1952 * struct slots, so calling this function does nothing useful! | |
| 1953 * | |
| 1954 * Further, since update_faces_inheritance maps over the whole | |
| 1955 * face table every time it is called, it gets terribly slow when | |
| 1956 * there are many faces. Creating 500 faces on a 50Mhz 486 took | |
| 1957 * 433 seconds when update_faces_inheritance was called. With the | |
| 1958 * call commented out, creating those same 500 faces took 0.72 | |
| 1959 * seconds. | |
| 1960 */ | |
| 1961 /* update_faces_inheritance (face, property);*/ | |
| 1962 XFACE (face)->dirty = 1; | |
| 1963 } | |
| 1964 | |
| 1965 DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /* | |
| 1966 Define and return a new face which is a copy of an existing one, | |
| 1967 or makes an already-existing face be exactly like another. | |
| 1968 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'. | |
| 1969 */ | |
| 1970 (old_face, new_name, locale, tag_set, exact_p, how_to_add)) | |
| 1971 { | |
| 440 | 1972 Lisp_Face *fold, *fnew; |
| 428 | 1973 Lisp_Object new_face = Qnil; |
| 1974 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 1975 | |
| 1976 old_face = Fget_face (old_face); | |
| 1977 | |
| 1978 /* We GCPRO old_face because it might be temporary, and GCing could | |
| 1979 occur in various places below. */ | |
| 1980 GCPRO4 (tag_set, locale, old_face, new_face); | |
| 1981 /* check validity of how_to_add now. */ | |
| 1982 decode_how_to_add_specification (how_to_add); | |
| 1983 /* and of tag_set. */ | |
| 1984 tag_set = decode_specifier_tag_set (tag_set); | |
| 1985 /* and of locale. */ | |
| 1986 locale = decode_locale_list (locale); | |
| 1987 | |
| 1988 new_face = Ffind_face (new_name); | |
| 1989 if (NILP (new_face)) | |
| 1990 { | |
| 1991 Lisp_Object temp; | |
| 1992 | |
| 1993 CHECK_SYMBOL (new_name); | |
| 1994 | |
| 1995 /* Create the new face with the same status as the old face. */ | |
| 1996 temp = (NILP (Fgethash (old_face, Vtemporary_faces_cache, Qnil)) | |
| 1997 ? Qnil | |
| 1998 : Qt); | |
| 1999 | |
| 2000 new_face = Fmake_face (new_name, Qnil, temp); | |
| 2001 } | |
| 2002 | |
| 2003 fold = XFACE (old_face); | |
| 2004 fnew = XFACE (new_face); | |
| 2005 | |
| 2006 #define COPY_PROPERTY(property) \ | |
| 2007 Fcopy_specifier (fold->property, fnew->property, \ | |
| 4187 | 2008 locale, tag_set, exact_p, how_to_add); |
| 428 | 2009 |
| 2010 COPY_PROPERTY (foreground); | |
| 2011 COPY_PROPERTY (background); | |
| 2012 COPY_PROPERTY (font); | |
| 2013 COPY_PROPERTY (display_table); | |
| 2014 COPY_PROPERTY (background_pixmap); | |
| 2015 COPY_PROPERTY (underline); | |
| 2016 COPY_PROPERTY (strikethru); | |
| 2017 COPY_PROPERTY (highlight); | |
| 2018 COPY_PROPERTY (dim); | |
| 2019 COPY_PROPERTY (blinking); | |
| 2020 COPY_PROPERTY (reverse); | |
| 2021 #undef COPY_PROPERTY | |
| 2022 /* #### should it copy the individual specifiers, if they exist? */ | |
| 2023 fnew->plist = Fcopy_sequence (fold->plist); | |
| 2024 | |
| 2025 UNGCPRO; | |
| 2026 | |
| 2027 return new_name; | |
| 2028 } | |
| 2029 | |
| 3659 | 2030 #ifdef MULE |
| 2031 | |
| 3918 | 2032 Lisp_Object Qone_dimensional, Qtwo_dimensional, Qx_coverage_instantiator; |
| 3659 | 2033 |
| 4187 | 2034 DEFUN ("specifier-tag-one-dimensional-p", |
| 2035 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
|
2036 1, 1, 0, /* |
| 3659 | 2037 Return non-nil if (charset-dimension CHARSET) is 1. |
| 2038 | |
| 2039 Used by the X11 platform font code; see `define-specifier-tag'. You | |
| 2040 shouldn't ever need to call this yourself. | |
| 2041 */ | |
|
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
|
2042 (charset)) |
| 3659 | 2043 { |
|
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
|
2044 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
|
2045 return (1 == XCHARSET_DIMENSION (charset)) ? Qt : Qnil; |
| 3659 | 2046 } |
| 2047 | |
| 4187 | 2048 DEFUN ("specifier-tag-two-dimensional-p", |
| 2049 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
|
2050 1, 1, 0, /* |
| 3659 | 2051 Return non-nil if (charset-dimension CHARSET) is 2. |
| 2052 | |
| 2053 Used by the X11 platform font code; see `define-specifier-tag'. You | |
| 2054 shouldn't ever need to call this yourself. | |
| 2055 */ | |
|
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
|
2056 (charset)) |
| 3659 | 2057 { |
|
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
|
2058 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
|
2059 return (2 == XCHARSET_DIMENSION (charset)) ? Qt : Qnil; |
| 3659 | 2060 } |
| 2061 | |
| 4187 | 2062 DEFUN ("specifier-tag-final-stage-p", |
| 2063 Fspecifier_tag_final_stage_p, | |
| 3659 | 2064 2, 2, 0, /* |
| 2065 Return non-nil if STAGE is 'final. | |
| 2066 | |
| 2067 Used by the X11 platform font code for giving fallbacks; see | |
| 4187 | 2068 `define-specifier-tag'. You shouldn't ever need to call this. |
| 3659 | 2069 */ |
|
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
|
2070 (UNUSED (charset), stage)) |
| 3659 | 2071 { |
|
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
|
2072 return EQ (stage, Qfinal) ? Qt : Qnil; |
| 3659 | 2073 } |
| 2074 | |
| 4187 | 2075 DEFUN ("specifier-tag-initial-stage-p", |
| 2076 Fspecifier_tag_initial_stage_p, | |
| 3659 | 2077 2, 2, 0, /* |
| 2078 Return non-nil if STAGE is 'initial. | |
| 2079 | |
| 2080 Used by the X11 platform font code for giving fallbacks; see | |
| 4187 | 2081 `define-specifier-tag'. You shouldn't ever need to call this. |
| 3659 | 2082 */ |
| 2083 (UNUSED(charset), stage)) | |
| 2084 { | |
| 2085 return EQ(stage, Qinitial) ? Qt : Qnil; | |
| 2086 } | |
| 2087 | |
| 4187 | 2088 DEFUN ("specifier-tag-encode-as-utf-8-p", |
| 2089 Fspecifier_tag_encode_as_utf_8_p, | |
| 3659 | 2090 2, 2, 0, /* |
| 2091 Return t if and only if (charset-property CHARSET 'encode-as-utf-8)). | |
| 2092 | |
| 2093 Used by the X11 platform font code; see `define-specifier-tag'. You | |
| 2094 shouldn't ever need to call this. | |
| 2095 */ | |
| 2096 (charset, UNUSED(stage))) | |
| 2097 { | |
| 2098 /* Used to check that the stage was initial too. */ | |
| 2099 CHECK_CHARSET(charset); | |
| 2100 return XCHARSET_ENCODE_AS_UTF_8(charset) ? Qt : Qnil; | |
| 2101 } | |
| 2102 | |
| 2103 #endif /* MULE */ | |
| 2104 | |
| 428 | 2105 |
| 2106 void | |
| 2107 syms_of_faces (void) | |
| 2108 { | |
| 442 | 2109 INIT_LRECORD_IMPLEMENTATION (face); |
| 2110 | |
| 440 | 2111 /* Qdefault, Qwidget, Qleft_margin, Qright_margin defined in general.c */ |
| 563 | 2112 DEFSYMBOL (Qmodeline); |
| 2113 DEFSYMBOL (Qgui_element); | |
| 2114 DEFSYMBOL (Qtext_cursor); | |
| 2115 DEFSYMBOL (Qvertical_divider); | |
| 428 | 2116 |
| 2117 DEFSUBR (Ffacep); | |
| 2118 DEFSUBR (Ffind_face); | |
| 2119 DEFSUBR (Fget_face); | |
| 2120 DEFSUBR (Fface_name); | |
| 2121 DEFSUBR (Fbuilt_in_face_specifiers); | |
| 2122 DEFSUBR (Fface_list); | |
| 2123 DEFSUBR (Fmake_face); | |
| 2124 DEFSUBR (Fcopy_face); | |
| 2125 | |
| 3659 | 2126 #ifdef MULE |
| 2127 DEFSYMBOL (Qone_dimensional); | |
| 2128 DEFSYMBOL (Qtwo_dimensional); | |
| 3918 | 2129 DEFSYMBOL (Qx_coverage_instantiator); |
| 2130 | |
| 3659 | 2131 /* I would much prefer these were in Lisp. */ |
| 2132 DEFSUBR (Fspecifier_tag_one_dimensional_p); | |
| 2133 DEFSUBR (Fspecifier_tag_two_dimensional_p); | |
| 2134 DEFSUBR (Fspecifier_tag_initial_stage_p); | |
| 2135 DEFSUBR (Fspecifier_tag_final_stage_p); | |
| 2136 DEFSUBR (Fspecifier_tag_encode_as_utf_8_p); | |
| 2137 #endif /* MULE */ | |
| 2138 | |
| 563 | 2139 DEFSYMBOL (Qfacep); |
| 2140 DEFSYMBOL (Qforeground); | |
| 2141 DEFSYMBOL (Qbackground); | |
| 428 | 2142 /* Qfont defined in general.c */ |
| 563 | 2143 DEFSYMBOL (Qdisplay_table); |
| 2144 DEFSYMBOL (Qbackground_pixmap); | |
| 2145 DEFSYMBOL (Qunderline); | |
| 2146 DEFSYMBOL (Qstrikethru); | |
| 428 | 2147 /* Qhighlight, Qreverse defined in general.c */ |
| 563 | 2148 DEFSYMBOL (Qdim); |
| 2149 DEFSYMBOL (Qblinking); | |
| 428 | 2150 |
| 2865 | 2151 DEFSYMBOL (Qface_alias); |
| 2867 | 2152 DEFERROR_STANDARD (Qcyclic_face_alias, Qinvalid_state); |
| 2865 | 2153 |
| 563 | 2154 DEFSYMBOL (Qinit_face_from_resources); |
| 2155 DEFSYMBOL (Qinit_global_faces); | |
| 2156 DEFSYMBOL (Qinit_device_faces); | |
| 2157 DEFSYMBOL (Qinit_frame_faces); | |
| 428 | 2158 } |
| 2159 | |
| 2160 void | |
| 2161 structure_type_create_faces (void) | |
| 2162 { | |
| 2163 struct structure_type *st; | |
| 2164 | |
| 2165 st = define_structure_type (Qface, face_validate, face_instantiate); | |
| 2166 | |
| 2167 define_structure_type_keyword (st, Qname, face_name_validate); | |
| 2168 } | |
| 2169 | |
| 2170 void | |
| 2171 vars_of_faces (void) | |
| 2172 { | |
| 2173 staticpro (&Vpermanent_faces_cache); | |
| 771 | 2174 Vpermanent_faces_cache = |
| 2175 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 428 | 2176 staticpro (&Vtemporary_faces_cache); |
| 771 | 2177 Vtemporary_faces_cache = |
| 2178 make_lisp_hash_table (0, HASH_TABLE_WEAK, HASH_TABLE_EQ); | |
| 428 | 2179 |
| 2180 staticpro (&Vdefault_face); | |
| 2181 Vdefault_face = Qnil; | |
| 2182 staticpro (&Vgui_element_face); | |
| 2183 Vgui_element_face = Qnil; | |
| 2184 staticpro (&Vwidget_face); | |
| 2185 Vwidget_face = Qnil; | |
| 2186 staticpro (&Vmodeline_face); | |
| 2187 Vmodeline_face = Qnil; | |
| 2188 staticpro (&Vtoolbar_face); | |
| 2189 Vtoolbar_face = Qnil; | |
| 2190 | |
| 2191 staticpro (&Vvertical_divider_face); | |
| 2192 Vvertical_divider_face = Qnil; | |
| 2193 staticpro (&Vleft_margin_face); | |
| 2194 Vleft_margin_face = Qnil; | |
| 2195 staticpro (&Vright_margin_face); | |
| 2196 Vright_margin_face = Qnil; | |
| 2197 staticpro (&Vtext_cursor_face); | |
| 2198 Vtext_cursor_face = Qnil; | |
| 2199 staticpro (&Vpointer_face); | |
| 2200 Vpointer_face = Qnil; | |
| 2201 | |
| 3659 | 2202 #ifdef DEBUG_XEMACS |
| 2203 DEFVAR_INT ("debug-x-faces", &debug_x_faces /* | |
| 2204 If non-zero, display debug information about X faces | |
| 2205 */ ); | |
| 2206 debug_x_faces = 0; | |
| 2207 #endif | |
| 2208 | |
| 428 | 2209 { |
| 2210 Lisp_Object syms[20]; | |
| 2211 int n = 0; | |
| 2212 | |
| 2213 syms[n++] = Qforeground; | |
| 2214 syms[n++] = Qbackground; | |
| 2215 syms[n++] = Qfont; | |
| 2216 syms[n++] = Qdisplay_table; | |
| 2217 syms[n++] = Qbackground_pixmap; | |
| 2218 syms[n++] = Qunderline; | |
| 2219 syms[n++] = Qstrikethru; | |
| 2220 syms[n++] = Qhighlight; | |
| 2221 syms[n++] = Qdim; | |
| 2222 syms[n++] = Qblinking; | |
| 2223 syms[n++] = Qreverse; | |
| 2224 | |
| 2225 Vbuilt_in_face_specifiers = Flist (n, syms); | |
| 2226 staticpro (&Vbuilt_in_face_specifiers); | |
| 2227 } | |
| 2228 } | |
| 2229 | |
| 2230 void | |
| 2231 complex_vars_of_faces (void) | |
| 2232 { | |
| 2233 /* Create the default face now so we know what it is immediately. */ | |
| 2234 | |
| 2235 Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus | |
| 2236 default value */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2237 Vdefault_face = Fmake_face (Qdefault, build_defer_string ("default face"), |
| 428 | 2238 Qnil); |
| 2239 | |
| 2240 /* Provide some last-resort fallbacks to avoid utter fuckage if | |
| 2241 someone provides invalid values for the global specifications. */ | |
| 2242 | |
| 2243 { | |
| 2244 Lisp_Object fg_fb = Qnil, bg_fb = Qnil; | |
| 2245 | |
| 462 | 2246 #ifdef HAVE_GTK |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2247 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
|
2248 bg_fb = acons (list1 (Qgtk), build_ascstring ("white"), bg_fb); |
| 462 | 2249 #endif |
| 428 | 2250 #ifdef HAVE_X_WINDOWS |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2251 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
|
2252 bg_fb = acons (list1 (Qx), build_ascstring ("gray80"), bg_fb); |
| 428 | 2253 #endif |
| 2254 #ifdef HAVE_TTY | |
| 2255 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); | |
| 2256 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); | |
| 2257 #endif | |
| 2258 #ifdef HAVE_MS_WINDOWS | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2259 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
|
2260 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
|
2261 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
|
2262 bg_fb = acons (list1 (Qmswindows), build_ascstring ("white"), bg_fb); |
| 428 | 2263 #endif |
| 2264 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb); | |
| 2265 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb); | |
| 2266 } | |
| 2267 | |
| 2268 { | |
| 2269 Lisp_Object inst_list = Qnil; | |
| 462 | 2270 |
| 872 | 2271 #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK) |
| 2865 | 2272 |
| 3659 | 2273 #ifdef HAVE_GTK |
| 2274 Lisp_Object device_symbol = Qgtk; | |
| 2275 #else | |
| 2276 Lisp_Object device_symbol = Qx; | |
| 2277 #endif | |
| 2278 | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2279 #if defined (HAVE_XFT) || defined (MULE) |
| 3802 | 2280 const Ascbyte **fontptr; |
| 3659 | 2281 |
| 2367 | 2282 const Ascbyte *fonts[] = |
| 428 | 2283 { |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2284 #ifdef HAVE_XFT |
| 3094 | 2285 /************** Xft fonts *************/ |
| 2286 | |
| 2287 /* Note that fontconfig can search for several font families in one | |
| 2288 call. We should use this facility. */ | |
| 3659 | 2289 "Monospace-12", |
| 3094 | 2290 /* do we need to worry about non-Latin characters for monospace? |
| 4187 | 2291 No, at least in Debian's implementation of Xft. |
| 3094 | 2292 We should recommend that "gothic" and "mincho" aliases be created? */ |
| 3659 | 2293 "Sazanami Mincho-12", |
| 2294 /* Japanese #### add encoding info? */ | |
| 4187 | 2295 /* Arphic for Chinese? */ |
| 2296 /* Korean */ | |
| 3094 | 2297 #else |
| 3659 | 2298 /* The default Japanese fonts installed with XFree86 4.0 use this |
| 2299 point size, and the -misc-fixed fonts (which look really bad with | |
| 2300 Han characters) don't. We need to prefer the former. */ | |
| 2301 "-*-*-medium-r-*-*-*-150-*-*-c-*-*-*", | |
| 2302 /* And the Chinese ones, maddeningly, use this one. (But on 4.0, while | |
| 2303 XListFonts returns them, XLoadQueryFont on the fully-specified XLFD | |
| 2304 corresponding to one of them fails!) */ | |
| 2305 "-*-*-medium-r-*-*-*-160-*-*-c-*-*-*", | |
| 2306 "-*-*-medium-r-*-*-*-170-*-*-c-*-*-*", | |
| 3094 | 2307 #endif |
| 428 | 2308 }; |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2309 #endif /* defined (HAVE_XFT) || defined (MULE) */ |
| 3802 | 2310 |
| 2311 #ifdef MULE | |
| 428 | 2312 |
| 3659 | 2313 /* Define some specifier tags for classes of character sets. Combining |
| 2314 these allows for distinct fallback fonts for distinct dimensions of | |
| 2315 character sets and stages. */ | |
| 2316 | |
| 2317 define_specifier_tag(Qtwo_dimensional, Qnil, | |
| 2318 intern ("specifier-tag-two-dimensional-p")); | |
| 2319 | |
| 2320 define_specifier_tag(Qone_dimensional, Qnil, | |
| 2321 intern ("specifier-tag-one-dimensional-p")); | |
| 2322 | |
| 4187 | 2323 define_specifier_tag(Qinitial, Qnil, |
| 3659 | 2324 intern ("specifier-tag-initial-stage-p")); |
| 2325 | |
| 4187 | 2326 define_specifier_tag(Qfinal, Qnil, |
| 3659 | 2327 intern ("specifier-tag-final-stage-p")); |
| 2328 | |
| 2329 define_specifier_tag (Qencode_as_utf_8, Qnil, | |
| 2330 intern("specifier-tag-encode-as-utf-8-p")); | |
| 3918 | 2331 |
| 2332 /* This tag is used to group those instantiators made available in the | |
| 2333 fallback for the sake of coverage of obscure characters, notably | |
| 2334 Markus Kuhn's misc-fixed fonts. They will be copied from the fallback | |
| 2335 when the default face is determined from X resources at startup. */ | |
| 2336 define_specifier_tag (Qx_coverage_instantiator, Qnil, Qnil); | |
| 2337 | |
| 3659 | 2338 #endif /* MULE */ |
| 2339 | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2340 #ifdef HAVE_XFT |
| 3747 | 2341 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) |
| 2342 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
|
2343 build_cistring (*fontptr)), |
| 3747 | 2344 inst_list); |
| 2345 | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2346 #else /* !HAVE_XFT */ |
| 3659 | 2347 inst_list = |
| 4187 | 2348 Fcons |
| 3659 | 2349 (Fcons |
| 4187 | 2350 (list1 (device_symbol), |
|
4766
32b358a240b0
Avoid calling Xft if not built in.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4759
diff
changeset
|
2351 /* 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
|
2352 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
|
2353 build_ascstring ("*")), |
| 3659 | 2354 inst_list); |
| 4187 | 2355 #ifdef MULE |
| 3659 | 2356 |
| 2357 /* For Han characters and Ethiopic, we want the misc-fixed font used to | |
| 2358 be distinct from that for alphabetic scripts, because the font | |
| 2359 specified below is distractingly ugly when used for Han characters | |
| 2360 (this is slightly less so) and because its coverage isn't up to | |
| 2361 handling them (well, chiefly, it's not up to handling Ethiopic--we do | |
| 2362 have charset-specific fallbacks for the East Asian charsets.) */ | |
| 4187 | 2363 inst_list = |
| 3659 | 2364 Fcons |
| 2365 (Fcons | |
| 4187 | 2366 (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
|
2367 build_ascstring |
| 3659 | 2368 ("-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso10646-1")), |
| 2369 inst_list); | |
| 2370 | |
| 2371 /* Use Markus Kuhn's version of misc-fixed as the font for the font for | |
| 2372 when a given charset's registries can't be found and redisplay for | |
| 2373 that charset falls back to iso10646-1. */ | |
| 428 | 2374 |
| 4187 | 2375 inst_list = |
| 3659 | 2376 Fcons |
| 2377 (Fcons | |
| 4187 | 2378 (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
|
2379 build_ascstring |
| 4187 | 2380 ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")), |
| 3659 | 2381 inst_list); |
| 2382 | |
| 462 | 2383 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) |
| 4187 | 2384 inst_list = Fcons (Fcons (list3 (device_symbol, |
| 3659 | 2385 Qtwo_dimensional, Qinitial), |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2386 build_cistring (*fontptr)), |
| 462 | 2387 inst_list); |
| 3659 | 2388 |
| 2389 /* We need to set the font for the JIT-ucs-charsets separately from the | |
| 2390 final stage, since otherwise it picks up the two-dimensional | |
| 2391 specification (see specifier-tag-two-dimensional-initial-stage-p | |
| 2392 above). They also use Markus Kuhn's ISO 10646-1 fixed fonts for | |
| 2393 redisplay. */ | |
| 2394 | |
| 4187 | 2395 inst_list = |
| 3659 | 2396 Fcons |
| 2397 (Fcons | |
| 4187 | 2398 (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
|
2399 build_ascstring |
| 4187 | 2400 ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")), |
| 3659 | 2401 inst_list); |
| 2402 | |
| 2403 #endif /* MULE */ | |
| 2404 | |
| 2405 /* Needed to make sure that charsets with non-specified fonts don't | |
| 2406 use bold and oblique first if medium and regular are available. */ | |
| 2407 inst_list = | |
| 4187 | 2408 Fcons |
| 3659 | 2409 (Fcons |
| 4187 | 2410 (list1 (device_symbol), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2411 build_ascstring ("-*-*-medium-r-*-*-*-120-*-*-c-*-*-*")), |
| 3659 | 2412 inst_list); |
| 2413 | |
| 2414 /* With a Cygwin XFree86 install, this returns the best (clearest, | |
| 2415 most readable) font I can find when scaling of bitmap fonts is | |
| 2416 turned on, as it is by default. (WHO IN THE NAME OF CHRIST THOUGHT | |
| 2417 THAT WAS A GOOD IDEA?!?!) The other fonts that used to be specified | |
| 2418 here gave horrendous results. */ | |
| 2419 | |
| 2420 inst_list = | |
| 4187 | 2421 Fcons |
| 3659 | 2422 (Fcons |
| 4187 | 2423 (list1 (device_symbol), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2424 build_ascstring ("-*-lucidatypewriter-medium-r-*-*-*-120-*-*-*-*-*-*")), |
| 3659 | 2425 inst_list); |
| 2426 | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2427 #endif /* !HAVE_XFT */ |
| 3747 | 2428 |
| 462 | 2429 #endif /* HAVE_X_WINDOWS || HAVE_GTK */ |
| 2430 | |
| 428 | 2431 #ifdef HAVE_TTY |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2432 inst_list = Fcons (Fcons (list1 (Qtty), build_ascstring ("normal")), |
| 428 | 2433 inst_list); |
| 2434 #endif /* HAVE_TTY */ | |
| 440 | 2435 |
| 771 | 2436 #ifdef HAVE_MS_WINDOWS |
| 2437 { | |
| 2367 | 2438 const Ascbyte *mswfonts[] = |
| 4187 | 2439 { |
| 2440 "Courier New:Regular:10::", | |
| 2441 "Courier:Regular:10::", | |
| 2442 ":Regular:10::" | |
| 2443 }; | |
| 2367 | 2444 const Ascbyte **mswfontptr; |
| 2865 | 2445 |
| 771 | 2446 for (mswfontptr = mswfonts + countof (mswfonts) - 1; |
| 2447 mswfontptr >= mswfonts; mswfontptr--) | |
| 4187 | 2448 { |
| 2449 /* display device */ | |
| 2450 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
|
2451 build_ascstring (*mswfontptr)), |
| 4187 | 2452 inst_list); |
| 2453 /* printer device */ | |
| 2454 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
|
2455 build_ascstring (*mswfontptr)), |
| 4187 | 2456 inst_list); |
| 2457 } | |
| 793 | 2458 /* Use Lucida Console rather than Courier New if it exists -- the |
| 4187 | 2459 line spacing is much less, so many more lines fit with the same |
| 2460 size font. (And it's specifically designed for screens.) */ | |
| 2865 | 2461 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
|
2462 build_ascstring ("Lucida Console:Regular:10::")), |
| 793 | 2463 inst_list); |
| 771 | 2464 } |
| 428 | 2465 #endif /* HAVE_MS_WINDOWS */ |
| 771 | 2466 |
| 428 | 2467 set_specifier_fallback (Fget (Vdefault_face, Qfont, Qnil), inst_list); |
| 2468 } | |
| 2469 | |
| 2470 set_specifier_fallback (Fget (Vdefault_face, Qunderline, Qnil), | |
| 2471 list1 (Fcons (Qnil, Qnil))); | |
| 2472 set_specifier_fallback (Fget (Vdefault_face, Qstrikethru, Qnil), | |
| 2473 list1 (Fcons (Qnil, Qnil))); | |
| 2474 set_specifier_fallback (Fget (Vdefault_face, Qhighlight, Qnil), | |
| 2475 list1 (Fcons (Qnil, Qnil))); | |
| 2476 set_specifier_fallback (Fget (Vdefault_face, Qdim, Qnil), | |
| 2477 list1 (Fcons (Qnil, Qnil))); | |
| 2478 set_specifier_fallback (Fget (Vdefault_face, Qblinking, Qnil), | |
| 2479 list1 (Fcons (Qnil, Qnil))); | |
| 2480 set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil), | |
| 2481 list1 (Fcons (Qnil, Qnil))); | |
| 2482 | |
| 2483 /* gui-element is the parent face of all gui elements such as | |
| 2484 modeline, vertical divider and toolbar. */ | |
| 2485 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
|
2486 build_defer_string ("gui element face"), |
| 428 | 2487 Qnil); |
| 2488 | |
| 2489 /* Provide some last-resort fallbacks for gui-element face which | |
| 2490 mustn't default to default. */ | |
| 2491 { | |
| 2492 Lisp_Object fg_fb = Qnil, bg_fb = Qnil; | |
| 2493 | |
| 3094 | 2494 /* #### gui-element face doesn't have a font property? |
| 2495 But it gets referred to later! */ | |
| 462 | 2496 #ifdef HAVE_GTK |
| 2497 /* We need to put something in there, or error checking gets | |
| 2498 #%!@#ed up before the styles are set, which override the | |
| 2499 fallbacks. */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2500 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
|
2501 bg_fb = acons (list1 (Qgtk), build_ascstring ("Gray80"), bg_fb); |
| 462 | 2502 #endif |
| 428 | 2503 #ifdef HAVE_X_WINDOWS |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2504 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
|
2505 bg_fb = acons (list1 (Qx), build_ascstring ("Gray80"), bg_fb); |
| 428 | 2506 #endif |
| 2507 #ifdef HAVE_TTY | |
| 2508 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); | |
| 2509 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); | |
| 2510 #endif | |
| 2511 #ifdef HAVE_MS_WINDOWS | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2512 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
|
2513 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
|
2514 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
|
2515 bg_fb = acons (list1 (Qmswindows), build_ascstring ("Gray75"), bg_fb); |
| 428 | 2516 #endif |
| 2517 set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb); | |
| 2518 set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb); | |
| 2519 } | |
| 2520 | |
| 2521 /* Now create the other faces that redisplay needs to refer to | |
| 2522 directly. We could create them in Lisp but it's simpler this | |
| 2523 way since we need to get them anyway. */ | |
| 2524 | |
| 2525 /* modeline is gui element. */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2526 Vmodeline_face = Fmake_face (Qmodeline, build_defer_string ("modeline face"), |
| 428 | 2527 Qnil); |
| 2528 | |
| 2529 set_specifier_fallback (Fget (Vmodeline_face, Qforeground, Qunbound), | |
| 2530 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
| 2531 set_specifier_fallback (Fget (Vmodeline_face, Qbackground, Qunbound), | |
| 2532 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
| 2533 set_specifier_fallback (Fget (Vmodeline_face, Qbackground_pixmap, Qnil), | |
| 2534 Fget (Vgui_element_face, Qbackground_pixmap, | |
| 2535 Qunbound)); | |
| 2536 | |
| 2537 /* toolbar is another gui element */ | |
| 2538 Vtoolbar_face = Fmake_face (Qtoolbar, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2539 build_defer_string ("toolbar face"), |
| 428 | 2540 Qnil); |
| 2541 set_specifier_fallback (Fget (Vtoolbar_face, Qforeground, Qunbound), | |
| 2542 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
| 2543 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground, Qunbound), | |
| 2544 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
| 2545 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_pixmap, Qnil), | |
| 2546 Fget (Vgui_element_face, Qbackground_pixmap, | |
| 2547 Qunbound)); | |
| 2548 | |
| 2549 /* vertical divider is another gui element */ | |
| 2550 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
|
2551 build_defer_string ("vertical divider face"), |
| 428 | 2552 Qnil); |
| 2553 | |
| 2554 set_specifier_fallback (Fget (Vvertical_divider_face, Qforeground, Qunbound), | |
| 2555 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
| 2556 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground, Qunbound), | |
| 2557 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
| 2558 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground_pixmap, | |
| 2559 Qunbound), | |
| 2560 Fget (Vgui_element_face, Qbackground_pixmap, | |
| 2561 Qunbound)); | |
| 2562 | |
| 2563 /* widget is another gui element */ | |
| 2564 Vwidget_face = Fmake_face (Qwidget, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2565 build_defer_string ("widget face"), |
| 428 | 2566 Qnil); |
| 3094 | 2567 /* #### weird ... the gui-element face doesn't have its own font yet */ |
| 442 | 2568 set_specifier_fallback (Fget (Vwidget_face, Qfont, Qunbound), |
| 2569 Fget (Vgui_element_face, Qfont, Qunbound)); | |
| 428 | 2570 set_specifier_fallback (Fget (Vwidget_face, Qforeground, Qunbound), |
| 2571 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
| 2572 set_specifier_fallback (Fget (Vwidget_face, Qbackground, Qunbound), | |
| 2573 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
| 442 | 2574 /* We don't want widgets to have a default background pixmap. */ |
| 428 | 2575 |
| 2576 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
|
2577 build_defer_string ("left margin face"), |
| 428 | 2578 Qnil); |
| 2579 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
|
2580 build_defer_string ("right margin face"), |
| 428 | 2581 Qnil); |
| 2582 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
|
2583 build_defer_string ("face for text cursor"), |
| 428 | 2584 Qnil); |
| 2585 Vpointer_face = | |
| 2586 Fmake_face (Qpointer, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2587 build_defer_string |
| 428 | 2588 ("face for foreground/background colors of mouse pointer"), |
| 2589 Qnil); | |
| 2590 } |