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