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