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