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