aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorGerd Moellmann1999-07-21 21:43:52 +0000
committerGerd Moellmann1999-07-21 21:43:52 +0000
commit82641697d8bfc72295cd5d1b06f482a206e590ad (patch)
tree69f336029576b1348757b3c9ff08e71cb9424b75 /src
parent333b20bbc2c9a559a4cb429d5f3a9106d28b76f2 (diff)
downloademacs-82641697d8bfc72295cd5d1b06f482a206e590ad.tar.gz
emacs-82641697d8bfc72295cd5d1b06f482a206e590ad.zip
Implemented from scratch.
Diffstat (limited to 'src')
-rw-r--r--src/xfaces.c6569
1 files changed, 5706 insertions, 863 deletions
diff --git a/src/xfaces.c b/src/xfaces.c
index 9b7c3a0dcd7..f81f1ea4cee 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1,5 +1,5 @@
1/* "Face" primitives. 1/* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994 Free Software Foundation. 2 Copyright (C) 1993, 1994, 1998, 1999 Free Software Foundation.
3 3
4This file is part of GNU Emacs. 4This file is part of GNU Emacs.
5 5
@@ -18,30 +18,181 @@ along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */ 19Boston, MA 02111-1307, USA. */
20 20
21/* This is derived from work by Lucid (some parts very loosely so). */ 21/* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
22
23/* Faces.
24
25 When using Emacs with X, the display style of characters can be
26 changed by defining `faces'. Each face can specify the following
27 display attributes:
28
29 1. Font family or fontset alias name.
30
31 2. Relative proportionate width, aka character set width or set
32 width (swidth), e.g. `semi-compressed'.
33
34 3. Font height in 1/10pt
35
36 4. Font weight, e.g. `bold'.
37
38 5. Font slant, e.g. `italic'.
39
40 6. Foreground color.
41
42 7. Background color.
43
44 8. Whether or not characters should be underlined, and in what color.
45
46 9. Whether or not characters should be displayed in inverse video.
47
48 10. A background stipple, a bitmap.
49
50 11. Whether or not characters should be overlined, and in what color.
51
52 12. Whether or not characters should be strike-through, and in what
53 color.
54
55 13. Whether or not a box should be drawn around characters, the box
56 type, and, for simple boxes, in what color.
57
58 Faces are frame-local by nature because Emacs allows to define the
59 same named face (face names are symbols) differently for different
60 frames. Each frame has an alist of face definitions for all named
61 faces. The value of a named face in such an alist is a Lisp vector
62 with the symbol `face' in slot 0, and a slot for each each of the
63 face attributes mentioned above.
64
65 There is also a global face alist `Vface_new_frame_defaults'. Face
66 definitions from this list are used to initialize faces of newly
67 created frames.
68
69 A face doesn't have to specify all attributes. Those not specified
70 have a value of `unspecified'. Faces specifying all attributes are
71 called `fully-specified'.
72
73
74 Face merging.
75
76 The display style of a given character in the text is determined by
77 combining several faces. This process is called `face merging'.
78 Any aspect of the display style that isn't specified by overlays or
79 text properties is taken from the `default' face. Since it is made
80 sure that the default face is always fully-specified, face merging
81 always results in a fully-specified face.
82
83
84 Face realization.
85
86 After all face attributes for a character have been determined by
87 merging faces of that character, that face is `realized'. The
88 realization process maps face attributes to what is physically
89 available on the system where Emacs runs. The result is a
90 `realized face' in form of a struct face which is stored in the
91 face cache of the frame on which it was realized.
92
93 Face realization is done in the context of the charset of the
94 character to display because different fonts and encodings are used
95 for different charsets. In other words, for characters of
96 different charsets, different realized faces are needed to display
97 them.
98
99 Except for composite characters (CHARSET_COMPOSITION), faces are
100 always realized for a specific character set and contain a specific
101 font, even if the face being realized specifies a fontset (see
102 `font selection' below). The reason is that the result of the new
103 font selection stage is better than what can be done with
104 statically defined font name patterns in fontsets.
105
106
107 Unibyte text.
108
109 In unibyte text, Emacs' charsets aren't applicable; function
110 `char-charset' reports CHARSET_ASCII for all characters, including
111 those > 0x7f. The X registry and encoding of fonts to use is
112 determined from the variable `x-unibyte-registry-and-encoding' in
113 this case. The variable is initialized at Emacs startup time from
114 the font the user specified for Emacs.
115
116 Currently all unibyte text, i.e. all buffers with
117 enable_multibyte_characters nil are displayed with fonts of the
118 same registry and encoding `x-unibyte-registry-and-encoding'. This
119 is consistent with the fact that languages can also be set
120 globally, only.
121
122
123 Font selection.
124
125 Font selection tries to find the best available matching font for a
126 given (charset, face) combination. This is done slightly
127 differently for faces specifying a fontset, or a font family name.
128
129 If the face specifies a fontset alias name, that fontset determines
130 a pattern for fonts of the given charset. If the face specifies a
131 font family, a font pattern is constructed. Charset symbols have a
132 property `x-charset-registry' for that purpose that maps a charset
133 to an XLFD registry and encoding in the font pattern constructed.
134
135 Available fonts on the system on which Emacs runs are then matched
136 against the font pattern. The result of font selection is the best
137 match for the given face attributes in this font list.
138
139 Font selection can be influenced by the user.
140
141 1. The user can specify the relative importance he gives the face
142 attributes width, height, weight, and slant by setting
143 face-font-selection-order (faces.el) to a list of face attribute
144 names. The default is '(:width :height :weight :slant), and means
145 that font selection first tries to find a good match for the font
146 width specified by a face, then---within fonts with that
147 width---tries to find a best match for the specified font height,
148 etc.
149
150 2. Setting face-alternative-font-family-alist allows the user to
151 specify alternative font families to try if a family specified by a
152 face doesn't exist.
153
154
155 Composite characters.
156
157 Realized faces for composite characters are the only ones having a
158 fontset id >= 0. When a composite character is encoded into a
159 sequence of non-composite characters (in xterm.c), a suitable font
160 for the non-composite characters is then selected and realized,
161 i.e. the realization process is delayed but in principle the same.
162
163
164 Initialization of basic faces.
165
166 The faces `default', `modeline' are considered `basic faces'.
167 When redisplay happens the first time for a newly created frame,
168 basic faces are realized for CHARSET_ASCII. Frame parameters are
169 used to fill in unspecified attributes of the default face. */
170
171/* Define SCALABLE_FONTS to a non-zero value to enable scalable
172 font use. Define it to zero to disable scalable font use.
173
174 Use of too many or too large scalable fonts can crash XFree86
175 servers. That's why I've put the code dealing with scalable fonts
176 in #if's. */
177
178#define SCALABLE_FONTS 1
22 179
23#include <sys/types.h> 180#include <sys/types.h>
24#include <sys/stat.h> 181#include <sys/stat.h>
25
26#include <config.h> 182#include <config.h>
27#include "lisp.h" 183#include "lisp.h"
28
29#include "charset.h" 184#include "charset.h"
30
31#include "frame.h" 185#include "frame.h"
32 186
33/* The number of face-id's in use (same for all frames). */
34static int next_face_id;
35
36#ifdef HAVE_FACES
37
38#ifdef HAVE_X_WINDOWS 187#ifdef HAVE_X_WINDOWS
39#include "xterm.h" 188#include "xterm.h"
40#include "fontset.h" 189#include "fontset.h"
41#endif 190#endif
191
42#ifdef MSDOS 192#ifdef MSDOS
43#include "dosfns.h" 193#include "dosfns.h"
44#endif 194#endif
195
45#include "buffer.h" 196#include "buffer.h"
46#include "dispextern.h" 197#include "dispextern.h"
47#include "blockinput.h" 198#include "blockinput.h"
@@ -49,400 +200,674 @@ static int next_face_id;
49#include "intervals.h" 200#include "intervals.h"
50 201
51#ifdef HAVE_X_WINDOWS 202#ifdef HAVE_X_WINDOWS
52/* Compensate for bug in Xos.h on some systems, on which it requires 203
204/* Compensate for a bug in Xos.h on some systems, on which it requires
53 time.h. On some such systems, Xos.h tries to redefine struct 205 time.h. On some such systems, Xos.h tries to redefine struct
54 timeval and struct timezone if USG is #defined while it is 206 timeval and struct timezone if USG is #defined while it is
55 #included. */ 207 #included. */
56#ifdef XOS_NEEDS_TIME_H
57 208
209#ifdef XOS_NEEDS_TIME_H
58#include <time.h> 210#include <time.h>
59#undef USG 211#undef USG
60#include <X11/Xos.h> 212#include <X11/Xos.h>
61#define USG 213#define USG
62#define __TIMEVAL__ 214#define __TIMEVAL__
215#else /* not XOS_NEEDS_TIME_H */
216#include <X11/Xos.h>
217#endif /* not XOS_NEEDS_TIME_H */
63 218
64#else 219#endif /* HAVE_X_WINDOWS */
65 220
66#include <X11/Xos.h> 221#include <stdio.h>
222#include <stdlib.h>
223#include <ctype.h>
224#include "keyboard.h"
67 225
226#ifndef max
227#define max(A, B) ((A) > (B) ? (A) : (B))
228#define min(A, B) ((A) < (B) ? (A) : (B))
229#define abs(X) ((X) < 0 ? -(X) : (X))
68#endif 230#endif
69#endif /* HAVE_X_WINDOWS */
70
71/* An explanation of the face data structures. */
72
73/* ========================= Face Data Structures =========================
74
75 Let FACE-NAME be a symbol naming a face.
76
77 Let FACE-VECTOR be (assq FACE-NAME (frame-face-alist FRAME))
78 FACE-VECTOR is either nil, or a vector of the form
79 [face NAME ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE-P]
80 where
81 face is the symbol `face',
82 NAME is the symbol with which this vector is associated (a backpointer),
83 ID is the face ID, an integer used internally by the C code to identify
84 the face,
85 FONT, FOREGROUND, and BACKGROUND are strings naming the fonts and colors
86 to use with the face, FONT may name fontsets,
87 BACKGROUND-PIXMAP is the name of an x bitmap filename, which we don't
88 use right now, and
89 UNDERLINE-P is non-nil if the face should be underlined.
90 If any of these elements are nil, that parameter is considered
91 unspecified; parameters from faces specified by lower-priority
92 overlays or text properties, or the parameters of the frame itself,
93 can show through. (lisp/faces.el maintains these lists.)
94
95 (assq FACE-NAME global-face-data) returns a vector describing the
96 global parameters for that face.
97
98 Let PARAM-FACE be FRAME->output_data.x->param_faces[Faref (FACE-VECTOR, 2)].
99 PARAM_FACE is a struct face whose members are the Xlib analogues of
100 the parameters in FACE-VECTOR. If an element of FACE-VECTOR is
101 nil, then the corresponding member of PARAM_FACE is FACE_DEFAULT.
102 These faces are called "parameter faces", because they're the ones
103 lisp manipulates to control what gets displayed. Elements 0 and 1
104 of FRAME->output_data.x->param_faces are special - they describe the
105 default and mode line faces. None of the faces in param_faces have
106 GC's. (See src/dispextern.h for the definition of struct face.
107 lisp/faces.el maintains the isomorphism between face_alist and
108 param_faces.)
109
110 The functions compute_char_face and compute_glyph_face find and
111 combine the parameter faces associated with overlays and text
112 properties. The resulting faces are called "computed faces"; none
113 of their members are FACE_DEFAULT; they are completely specified.
114 They then call intern_compute_face to search
115 FRAME->output_data.x->computed_faces for a matching face, add one if
116 none is found, and return the index into
117 FRAME->output_data.x->computed_faces. FRAME's glyph matrices use these
118 indices to record the faces of the matrix characters, and the X
119 display hooks consult compute_faces to decide how to display these
120 characters. Elements 0 and 1 of computed_faces always describe the
121 default and mode-line faces.
122
123 Each computed face belongs to a particular frame.
124
125 Computed faces have graphics contexts some of the time.
126 intern_face builds a GC for a specified computed face
127 if it doesn't have one already.
128 clear_face_cache clears out the GCs of all computed faces.
129 This is done from time to time so that we don't hold on to
130 lots of GCs that are no longer needed.
131
132 If a computed face has 0 as its font,
133 it is unused, and can be reused by new_computed_face.
134
135 Constraints:
136
137 Symbols naming faces must have associations on all frames; for any
138 FRAME, for all FACE-NAME, if (assq FACE-NAME (frame-face-alist
139 FRAME)) is non-nil, it must be non-nil for all frames.
140
141 Analogously, indices into param_faces must be valid on all frames;
142 if param_faces[i] is a non-zero face pointer on one frame, then it
143 must be filled in on all frames. Code assumes that face ID's can
144 be used on any frame.
145
146 Some subtleties:
147
148 Why do we keep param_faces and computed_faces separate?
149 computed_faces contains an element for every combination of facial
150 parameters we have ever displayed. indices into param_faces have
151 to be valid on all frames. If they were the same array, then that
152 array would grow very large on all frames, because any facial
153 combination displayed on any frame would need to be a valid entry
154 on all frames. */
155
156/* Definitions and declarations. */
157 231
158/* The number of the face to use to indicate the region. */ 232/* Non-zero if face attribute ATTR is unspecified. */
159static int region_face;
160 233
161/* This is what appears in a slot in a face to signify that the face 234#define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
162 does not specify that display aspect. */ 235
163#define FACE_DEFAULT (~0) 236/* Value is the number of elements of VECTOR. */
237
238#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
239
240/* Make a copy of string S on the stack using alloca. Value is a pointer
241 to the copy. */
242
243#define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
244
245/* Make a copy of the contents of Lisp string S on the stack using
246 alloca. Value is a pointer to the copy. */
247
248#define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
249
250/* Size of hash table of realized faces in face caches (should be a
251 prime number). */
252
253#define FACE_CACHE_BUCKETS_SIZE 1001
254
255/* Keyword symbols used for face attribute names. */
256
257Lisp_Object QCfamily, QCheight, QCweight, QCslant, QCunderline;
258Lisp_Object QCinverse_video, QCforeground, QCbackground, QCstipple;
259Lisp_Object QCwidth, QCfont, QCbold, QCitalic;
260Lisp_Object QCreverse_video;
261Lisp_Object QCoverline, QCstrike_through, QCbox;
262
263/* Symbols used for attribute values. */
264
265Lisp_Object Qnormal, Qbold, Qultra_light, Qextra_light, Qlight;
266Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
267Lisp_Object Qoblique, Qitalic, Qreverse_oblique, Qreverse_italic;
268Lisp_Object Qultra_condensed, Qextra_condensed, Qcondensed;
269Lisp_Object Qsemi_condensed, Qsemi_expanded, Qexpanded, Qextra_expanded;
270Lisp_Object Qultra_expanded;
271Lisp_Object Qreleased_button, Qpressed_button;
272Lisp_Object QCstyle, QCcolor, QCline_width;
273Lisp_Object Qunspecified;
274
275/* The symbol `x-charset-registry'. This property of charsets defines
276 the X registry and encoding that fonts should have that are used to
277 display characters of that charset. */
278
279Lisp_Object Qx_charset_registry;
280
281/* Names of basic faces. */
282
283Lisp_Object Qdefault, Qmodeline, Qtoolbar, Qregion, Qbitmap_area;
284Lisp_Object Qtop_line;
285
286/* Default stipple pattern used on monochrome displays. This stipple
287 pattern is used on monochrome displays instead of shades of gray
288 for a face background color. See `set-face-stipple' for possible
289 values for this variable. */
290
291Lisp_Object Vface_default_stipple;
292
293/* Default registry and encoding to use for charsets whose charset
294 symbols don't specify one. */
295
296Lisp_Object Vface_default_registry;
297
298/* Alist of alternative font families. Each element is of the form
299 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
300 try FAMILY1, then FAMILY2, ... */
301
302Lisp_Object Vface_alternative_font_family_alist;
303
304/* Allowed scalable fonts. A value of nil means don't allow any
305 scalable fonts. A value of t means allow the use of any scalable
306 font. Otherwise, value must be a list of regular expressions. A
307 font may be scaled if its name matches a regular expression in the
308 list. */
309
310#if SCALABLE_FONTS
311Lisp_Object Vscalable_fonts_allowed;
312#endif
313
314/* The symbols `foreground-color' and `background-color' which can be
315 used as part of a `face' property. This is for compatibility with
316 Emacs 20.2. */
317
318Lisp_Object Qforeground_color, Qbackground_color;
319
320/* The symbols `face' and `mouse-face' used as text properties. */
164 321
165Lisp_Object Qface; 322Lisp_Object Qface;
323extern Lisp_Object Qmouse_face;
324
325/* Error symbol for wrong_type_argument in load_pixmap. */
326
166Lisp_Object Qpixmap_spec_p; 327Lisp_Object Qpixmap_spec_p;
167 328
168int face_name_id_number ( /* FRAME_PTR, Lisp_Object name */ ); 329/* Alist of global face definitions. Each element is of the form
330 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
331 is a Lisp vector of face attributes. These faces are used
332 to initialize faces for new frames. */
169 333
170struct face *intern_face ( /* FRAME_PTR, struct face * */ ); 334Lisp_Object Vface_new_frame_defaults;
171static int new_computed_face ( /* FRAME_PTR, struct face * */ );
172static int intern_computed_face ( /* FRAME_PTR, struct face * */ );
173static void ensure_face_ready ( /* FRAME_PTR, int id */ );
174void recompute_basic_faces ( /* FRAME_PTR f */ );
175static void merge_face_list ( /* FRAME_PTR, struct face *, Lisp_Object */ );
176 335
177extern Lisp_Object Qforeground_color, Qbackground_color, Qmouse_face; 336/* The next ID to assign to Lisp faces. */
178
179/* Allocating, copying, and comparing struct faces. */
180 337
181/* Allocate a new face */ 338static int next_lface_id;
182static struct face *
183allocate_face ()
184{
185 struct face *result = (struct face *) xmalloc (sizeof (struct face));
186 bzero (result, sizeof (struct face));
187 result->font = (XFontStruct *) FACE_DEFAULT;
188 result->fontset = -1;
189 result->foreground = FACE_DEFAULT;
190 result->background = FACE_DEFAULT;
191 result->stipple = FACE_DEFAULT;
192 return result;
193}
194 339
195/* Make a new face that's a copy of an existing one. */ 340/* A vector mapping Lisp face Id's to face names. */
196static struct face *
197copy_face (face)
198 struct face *face;
199{
200 struct face *result = allocate_face ();
201 341
202 result->font = face->font; 342static Lisp_Object *lface_id_to_name;
203 result->fontset = face->fontset; 343static int lface_id_to_name_size;
204 result->foreground = face->foreground;
205 result->background = face->background;
206 result->stipple = face->stipple;
207 result->underline = face->underline;
208 result->pixmap_h = face->pixmap_h;
209 result->pixmap_w = face->pixmap_w;
210 344
211 return result; 345/* An alist of elements (COLOR-NAME . INDEX) mapping color names
212} 346 to color indices for tty frames. */
347
348Lisp_Object Vface_tty_color_alist;
349
350/* Counter for calls to clear_face_cache. If this counter reaches
351 CLEAR_FONT_TABLE_COUNT, and a frame has more than
352 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
353
354static int clear_font_table_count;
355#define CLEAR_FONT_TABLE_COUNT 100
356#define CLEAR_FONT_TABLE_NFONTS 10
357
358/* Non-zero means face attributes have been changed since the last
359 redisplay. Used in redisplay_internal. */
360
361int face_change_count;
362
363/* The total number of colors currently allocated. */
364
365#if GLYPH_DEBUG
366static int ncolors_allocated;
367static int npixmaps_allocated;
368static int ngcs;
369#endif
370
371
372
373/* Function prototypes. */
374
375struct font_name;
376struct table_entry;
377
378static int may_use_scalable_font_p P_ ((struct font_name *, char *));
379static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
380static int better_font_p P_ ((int *, struct font_name *, struct font_name *,
381 int));
382static int first_font_matching P_ ((struct frame *f, char *,
383 struct font_name *));
384static int x_face_list_fonts P_ ((struct frame *, char *,
385 struct font_name *, int, int, int));
386static int font_scalable_p P_ ((struct font_name *));
387static Lisp_Object deduce_unibyte_registry P_ ((struct frame *, char *));
388static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int));
389static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
390static char *xstrdup P_ ((char *));
391static unsigned char *xstrlwr P_ ((unsigned char *));
392static void signal_error P_ ((char *, Lisp_Object));
393static void display_message P_ ((struct frame *, char *, Lisp_Object, Lisp_Object));
394static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
395static void load_face_font_or_fontset P_ ((struct frame *, struct face *, char *, int));
396static unsigned long load_color P_ ((struct frame *,
397 struct face *,
398 Lisp_Object,
399 enum lface_attribute_index));
400static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *));
401static void free_face_colors P_ ((struct frame *, struct face *));
402static int face_color_gray_p P_ ((struct frame *, char *));
403static char *build_font_name P_ ((struct font_name *));
404static void free_font_names P_ ((struct font_name *, int));
405static int sorted_font_list P_ ((struct frame *, char *,
406 int (*cmpfn) P_ ((const void *, const void *)),
407 struct font_name **));
408static int font_list P_ ((struct frame *, char *, char *, char *, struct font_name **));
409static int try_font_list P_ ((struct frame *, Lisp_Object *, char *, char *, char *,
410 struct font_name **));
411static int cmp_font_names P_ ((const void *, const void *));
412static struct face *realize_face P_ ((struct face_cache *,
413 Lisp_Object *, int));
414static struct face *realize_x_face P_ ((struct face_cache *,
415 Lisp_Object *, int));
416static struct face *realize_tty_face P_ ((struct face_cache *,
417 Lisp_Object *, int));
418static int realize_basic_faces P_ ((struct frame *));
419static int realize_default_face P_ ((struct frame *));
420static void realize_named_face P_ ((struct frame *, Lisp_Object, int));
421static int lface_fully_specified_p P_ ((Lisp_Object *));
422static int lface_equal_p P_ ((Lisp_Object *, Lisp_Object *));
423static unsigned hash_string_case_insensitive P_ ((Lisp_Object));
424static unsigned lface_hash P_ ((Lisp_Object *));
425static int lface_same_font_attributes_p P_ ((Lisp_Object *, Lisp_Object *));
426static struct face_cache *make_face_cache P_ ((struct frame *));
427static void free_realized_face P_ ((struct frame *, struct face *));
428static void clear_face_gcs P_ ((struct face_cache *));
429static void free_face_cache P_ ((struct face_cache *));
430static int face_numeric_weight P_ ((Lisp_Object));
431static int face_numeric_slant P_ ((Lisp_Object));
432static int face_numeric_swidth P_ ((Lisp_Object));
433static int face_fontset P_ ((struct frame *, Lisp_Object *));
434static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int,
435 Lisp_Object));
436static char *choose_face_fontset_font P_ ((struct frame *, Lisp_Object *,
437 int, int));
438static void merge_face_vectors P_ ((Lisp_Object *from, Lisp_Object *));
439static void merge_face_vector_with_property P_ ((struct frame *, Lisp_Object *,
440 Lisp_Object));
441static int set_lface_from_font_name P_ ((struct frame *, Lisp_Object, char *,
442 int));
443static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int));
444static struct face *make_realized_face P_ ((Lisp_Object *, int, Lisp_Object));
445static void free_realized_faces P_ ((struct face_cache *));
446static char *best_matching_font P_ ((struct frame *, Lisp_Object *,
447 struct font_name *, int));
448static void cache_face P_ ((struct face_cache *, struct face *, unsigned));
449static void uncache_face P_ ((struct face_cache *, struct face *));
450static int xlfd_numeric_slant P_ ((struct font_name *));
451static int xlfd_numeric_weight P_ ((struct font_name *));
452static int xlfd_numeric_swidth P_ ((struct font_name *));
453static Lisp_Object xlfd_symbolic_slant P_ ((struct font_name *));
454static Lisp_Object xlfd_symbolic_weight P_ ((struct font_name *));
455static Lisp_Object xlfd_symbolic_swidth P_ ((struct font_name *));
456static int xlfd_fixed_p P_ ((struct font_name *));
457static int xlfd_numeric_value P_ ((struct table_entry *, int, struct font_name *,
458 int, int));
459static Lisp_Object xlfd_symbolic_value P_ ((struct table_entry *, int,
460 struct font_name *, int, int));
461static struct table_entry *xlfd_lookup_field_contents P_ ((struct table_entry *, int,
462 struct font_name *, int));
463
464#ifdef HAVE_X_WINDOWS
465
466static int split_font_name P_ ((struct frame *, struct font_name *, int));
467static int xlfd_point_size P_ ((struct frame *, struct font_name *));
468static void sort_fonts P_ ((struct frame *, struct font_name *, int,
469 int (*cmpfn) P_ ((const void *, const void *))));
470static GC x_create_gc P_ ((struct frame *, unsigned long, XGCValues *));
471static void x_free_gc P_ ((struct frame *, GC));
472static void clear_font_table P_ ((struct frame *));
473
474#endif /* HAVE_X_WINDOWS */
213 475
214static int
215face_eql (face1, face2)
216 struct face *face1, *face2;
217{
218 return ( face1->font == face2->font
219 && face1->fontset == face2->fontset
220 && face1->foreground == face2->foreground
221 && face1->background == face2->background
222 && face1->stipple == face2->stipple
223 && face1->underline == face2->underline);
224}
225 476
226/* Managing graphics contexts of faces. */ 477/***********************************************************************
478 Utilities
479 ***********************************************************************/
227 480
228#ifdef HAVE_X_WINDOWS 481#ifdef HAVE_X_WINDOWS
229/* Given a computed face, construct its graphics context if necessary. */
230 482
231struct face * 483/* Create and return a GC for use on frame F. GC values and mask
232intern_face (f, face) 484 are given by XGCV and MASK. */
485
486static INLINE GC
487x_create_gc (f, mask, xgcv)
233 struct frame *f; 488 struct frame *f;
234 struct face *face; 489 unsigned long mask;
490 XGCValues *xgcv;
235{ 491{
236 GC gc; 492 GC gc;
237 XGCValues xgcv; 493 BLOCK_INPUT;
238 unsigned long mask; 494 gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), mask, xgcv);
495 UNBLOCK_INPUT;
496 IF_DEBUG (++ngcs);
497 return gc;
498}
499
239 500
240 if (face->gc) 501/* Free GC which was used on frame F. */
241 return face;
242 502
503static INLINE void
504x_free_gc (f, gc)
505 struct frame *f;
506 GC gc;
507{
243 BLOCK_INPUT; 508 BLOCK_INPUT;
509 xassert (--ngcs >= 0);
510 XFreeGC (FRAME_X_DISPLAY (f), gc);
511 UNBLOCK_INPUT;
512}
244 513
245 if (face->foreground != FACE_DEFAULT) 514#endif /* HAVE_X_WINDOWS */
246 xgcv.foreground = face->foreground;
247 else
248 xgcv.foreground = f->output_data.x->foreground_pixel;
249 515
250 if (face->background != FACE_DEFAULT)
251 xgcv.background = face->background;
252 else
253 xgcv.background = f->output_data.x->background_pixel;
254 516
255 if (face->font && face->font != (XFontStruct *) FACE_DEFAULT) 517/* Like strdup, but uses xmalloc. */
256 xgcv.font = face->font->fid; 518
257 else 519static char *
258 xgcv.font = f->output_data.x->font->fid; 520xstrdup (s)
521 char *s;
522{
523 int len = strlen (s) + 1;
524 char *p = (char *) xmalloc (len);
525 bcopy (s, p, len);
526 return p;
527}
259 528
260 xgcv.graphics_exposures = 0;
261 529
262 mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures; 530/* Like stricmp. Used to compare parts of font names which are in
263 if (face->stipple && face->stipple != FACE_DEFAULT) 531 ISO8859-1. */
532
533int
534xstricmp (s1, s2)
535 unsigned char *s1, *s2;
536{
537 while (*s1 && *s2)
264 { 538 {
265 xgcv.fill_style = FillStippled; 539 unsigned char c1 = tolower (*s1);
266 xgcv.stipple = x_bitmap_pixmap (f, face->stipple); 540 unsigned char c2 = tolower (*s2);
267 mask |= GCFillStyle | GCStipple; 541 if (c1 != c2)
542 return c1 < c2 ? -1 : 1;
543 ++s1, ++s2;
268 } 544 }
269 545
270 gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 546 if (*s1 == 0)
271 mask, &xgcv); 547 return *s2 == 0 ? 0 : -1;
548 return 1;
549}
550
272 551
273 face->gc = gc; 552/* Like strlwr, which might not always be available. */
274 /* We used the following GC for all non-ASCII characters by changing
275 only GCfont each time. */
276 face->non_ascii_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
277 mask, &xgcv);
278 553
279 UNBLOCK_INPUT; 554static unsigned char *
555xstrlwr (s)
556 unsigned char *s;
557{
558 unsigned char *p = s;
280 559
281 return face; 560 for (p = s; *p; ++p)
561 *p = tolower (*p);
562
563 return s;
282} 564}
283 565
284/* Clear out all graphics contexts for all computed faces
285 except for the default and mode line faces.
286 This should be done from time to time just to avoid
287 keeping too many graphics contexts that are no longer needed. */
288 566
289void 567/* Signal `error' with message S, and additional argument ARG. */
290clear_face_cache () 568
569static void
570signal_error (s, arg)
571 char *s;
572 Lisp_Object arg;
291{ 573{
292 Lisp_Object tail, frame; 574 Fsignal (Qerror, Fcons (build_string (s), Fcons (arg, Qnil)));
575}
293 576
294 BLOCK_INPUT; 577
295 FOR_EACH_FRAME (tail, frame) 578/* Display a message with format string FORMAT and arguments ARG1 and
579 ARG2 on frame F. Used to display errors if fonts, bitmaps, colors
580 etc. for a realized face on frame F cannot be loaded. (If we would
581 signal an error in these cases, we would end up in an infinite
582 recursion because this would stop realization, and the redisplay
583 triggered by the signal would try to realize that same face again.)
584
585 If basic faces of F are not realized, just add the message to the
586 messages buffer "*Messages*". Because Fmessage calls
587 echo_area_display which tries to realize basic faces again, we would
588 otherwise also end in an infinite recursion. */
589
590static void
591display_message (f, format, arg1, arg2)
592 struct frame *f;
593 char *format;
594 Lisp_Object arg1, arg2;
595{
596 Lisp_Object args[3];
597 Lisp_Object nargs;
598 extern int waiting_for_input;
599
600 /* Function note_mouse_highlight calls face_at_buffer_position which
601 may realize a face. If some attribute of that face is invalid,
602 say an invalid color, don't display an error to avoid calling
603 Lisp from XTread_socket. */
604 if (waiting_for_input)
605 return;
606
607 nargs = make_number (DIM (args));
608 args[0] = build_string (format);
609 args[1] = arg1;
610 args[2] = arg2;
611
612 if (f->face_cache->used >= BASIC_FACE_ID_SENTINEL)
613 Fmessage (nargs, args);
614 else
296 { 615 {
297 FRAME_PTR f = XFRAME (frame); 616 Lisp_Object msg = Fformat (nargs, args);
298 if (FRAME_X_P (f)) 617 char *buffer = LSTRDUPA (msg);
299 { 618 message_dolog (buffer, strlen (buffer), 1, 0);
300 int i; 619 }
301 Display *dpy = FRAME_X_DISPLAY (f); 620}
302 621
303 for (i = 2; i < FRAME_N_COMPUTED_FACES (f); i++) 622
304 { 623/* If FRAME is nil, return selected_frame. Otherwise, check that
305 struct face *face = FRAME_COMPUTED_FACES (f) [i]; 624 FRAME is a live frame, and return a pointer to it. NPARAM
306 if (face->gc) 625 is the parameter number of FRAME, for CHECK_LIVE_FRAME. This is
307 { 626 here because it's a frequent pattern in Lisp function definitions. */
308 XFreeGC (dpy, face->gc); 627
309 XFreeGC (dpy, face->non_ascii_gc); 628static INLINE struct frame *
310 } 629frame_or_selected_frame (frame, nparam)
311 face->gc = 0; 630 Lisp_Object frame;
312 } 631 int nparam;
313 } 632{
633 struct frame *f;
634
635 if (NILP (frame))
636 f = selected_frame;
637 else
638 {
639 CHECK_LIVE_FRAME (frame, nparam);
640 f = XFRAME (frame);
314 } 641 }
315 642
316 UNBLOCK_INPUT; 643 return f;
317} 644}
645
318 646
319/* Allocating, freeing, and duplicating fonts, colors, and pixmaps. 647/***********************************************************************
648 Frames and faces
649 ***********************************************************************/
320 650
321 These functions operate on param faces only. 651/* Initialize face cache and basic faces for frame F. */
322 Computed faces get their fonts, colors and pixmaps
323 by merging param faces. */
324 652
325static XFontStruct * 653void
326load_font (f, name) 654init_frame_faces (f)
327 struct frame *f; 655 struct frame *f;
328 Lisp_Object name;
329{ 656{
330 XFontStruct *font; 657 /* Make a face cache, if F doesn't have one. */
658 if (FRAME_FACE_CACHE (f) == NULL)
659 FRAME_FACE_CACHE (f) = make_face_cache (f);
660
661#ifdef HAVE_X_WINDOWS
662 /* Make the image cache. */
663 if (FRAME_X_P (f))
664 {
665 if (FRAME_X_IMAGE_CACHE (f) == NULL)
666 FRAME_X_IMAGE_CACHE (f) = make_image_cache ();
667 ++FRAME_X_IMAGE_CACHE (f)->refcount;
668 }
669#endif /* HAVE_X_WINDOWS */
331 670
332 if (NILP (name)) 671 /* Realize basic faces. Must have enough information in frame
333 return (XFontStruct *) FACE_DEFAULT; 672 parameters to realize basic faces at this point. */
673#ifdef HAVE_X_WINDOWS
674 if (!FRAME_X_P (f) || FRAME_X_WINDOW (f))
675#endif
676 if (!realize_basic_faces (f))
677 abort ();
678}
334 679
335 CHECK_STRING (name, 0);
336 BLOCK_INPUT;
337 font = XLoadQueryFont (FRAME_X_DISPLAY (f), (char *) XSTRING (name)->data);
338 UNBLOCK_INPUT;
339 680
340 if (! font) 681/* Free face cache of frame F. Called from Fdelete_frame. */
341 Fsignal (Qerror, Fcons (build_string ("undefined font"),
342 Fcons (name, Qnil)));
343 return font;
344}
345 682
346static void 683void
347unload_font (f, font) 684free_frame_faces (f)
348 struct frame *f; 685 struct frame *f;
349 XFontStruct *font;
350{ 686{
351 int len = FRAME_N_COMPUTED_FACES (f); 687 struct face_cache *face_cache = FRAME_FACE_CACHE (f);
352 int i; 688
353 689 if (face_cache)
354 if (!font || font == ((XFontStruct *) FACE_DEFAULT)) 690 {
355 return; 691 free_face_cache (face_cache);
692 FRAME_FACE_CACHE (f) = NULL;
693 }
356 694
357 BLOCK_INPUT; 695#ifdef HAVE_X_WINDOWS
358 /* Invalidate any computed faces which use this font, 696 if (FRAME_X_P (f))
359 and free their GC's if they have any. */
360 for (i = 2; i < len; i++)
361 { 697 {
362 struct face *face = FRAME_COMPUTED_FACES (f)[i]; 698 struct image_cache *image_cache = FRAME_X_IMAGE_CACHE (f);
363 if (face->font == font) 699 if (image_cache)
364 { 700 {
365 Display *dpy = FRAME_X_DISPLAY (f); 701 --image_cache->refcount;
366 if (face->gc) 702 if (image_cache->refcount == 0)
367 XFreeGC (dpy, face->gc); 703 free_image_cache (f);
368 face->gc = 0;
369 /* This marks the computed face as available to reuse. */
370 face->font = 0;
371 } 704 }
372 } 705 }
373 706#endif /* HAVE_X_WINDOWS */
374 XFreeFont (FRAME_X_DISPLAY (f), font);
375 UNBLOCK_INPUT;
376} 707}
377 708
378static unsigned long 709
379load_color (f, name) 710/* Recompute basic faces for frame F. Call this after changing frame
711 parameters on which those faces depend, or when realized faces have
712 been freed due to changing attributes of named faces. */
713
714void
715recompute_basic_faces (f)
380 struct frame *f; 716 struct frame *f;
381 Lisp_Object name;
382{ 717{
383 XColor color; 718 if (FRAME_FACE_CACHE (f))
384 int result; 719 {
720 int realized_p = realize_basic_faces (f);
721 xassert (realized_p);
722 }
723}
385 724
386 if (NILP (name))
387 return FACE_DEFAULT;
388 725
389 CHECK_STRING (name, 0); 726/* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
390 /* if the colormap is full, defined_color will return a best match 727 try to free unused fonts, too. */
391 to the values in an an existing cell. */
392 result = defined_color (f, (char *) XSTRING (name)->data, &color, 1);
393 if (! result)
394 Fsignal (Qerror, Fcons (build_string ("undefined color"),
395 Fcons (name, Qnil)));
396 return (unsigned long) color.pixel;
397}
398 728
399void 729void
400unload_color (f, pixel) 730clear_face_cache (clear_fonts_p)
401 struct frame *f; 731 int clear_fonts_p;
402 unsigned long pixel;
403{ 732{
404 Colormap cmap; 733#ifdef HAVE_X_WINDOWS
405 Display *dpy = FRAME_X_DISPLAY (f); 734 Lisp_Object tail, frame;
406 int class = FRAME_X_DISPLAY_INFO (f)->visual->class; 735 struct frame *f;
407 736
408 if (pixel == FACE_DEFAULT 737 if (clear_fonts_p
409 || pixel == BLACK_PIX_DEFAULT (f) 738 || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
410 || pixel == WHITE_PIX_DEFAULT (f))
411 return;
412 cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (dpy));
413
414 /* If display has an immutable color map, freeing colors is not
415 necessary and some servers don't allow it. So don't do it. */
416 if (! (class == StaticColor || class == StaticGray || class == TrueColor))
417 { 739 {
418 int len = FRAME_N_COMPUTED_FACES (f); 740 /* From time to time see if we can unload some fonts. This also
419 int i; 741 frees all realized faces on all frames. Fonts needed by
742 faces will be loaded again when faces are realized again. */
743 clear_font_table_count = 0;
420 744
421 BLOCK_INPUT; 745 FOR_EACH_FRAME (tail, frame)
422 /* Invalidate any computed faces which use this color,
423 and free their GC's if they have any. */
424 for (i = 2; i < len; i++)
425 { 746 {
426 struct face *face = FRAME_COMPUTED_FACES (f)[i]; 747 f = XFRAME (frame);
427 if (face->foreground == pixel 748 if (FRAME_X_P (f)
428 || face->background == pixel) 749 && FRAME_X_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS)
429 { 750 {
430 Display *dpy = FRAME_X_DISPLAY (f); 751 free_all_realized_faces (frame);
431 if (face->gc) 752 clear_font_table (f);
432 XFreeGC (dpy, face->gc); 753 }
433 face->gc = 0; 754 }
434 /* This marks the computed face as available to reuse. */ 755 }
435 face->font = 0; 756 else
757 {
758 /* Clear GCs of realized faces. */
759 FOR_EACH_FRAME (tail, frame)
760 {
761 f = XFRAME (frame);
762 if (FRAME_X_P (f))
763 {
764 clear_face_gcs (FRAME_FACE_CACHE (f));
765 clear_image_cache (f, 0);
436 } 766 }
437 } 767 }
438
439 XFreeColors (dpy, cmap, &pixel, 1, (unsigned long)0);
440 UNBLOCK_INPUT;
441 } 768 }
769#endif /* HAVE_X_WINDOWS */
770}
771
772
773DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
774 "Clear face caches on all frames.\n\
775Optional THOROUGHLY non-nil means try to free unused fonts, too.")
776 (thorougly)
777 Lisp_Object thorougly;
778{
779 clear_face_cache (!NILP (thorougly));
780 return Qnil;
781}
782
783
784
785#ifdef HAVE_X_WINDOWS
786
787
788/* Remove those fonts from the font table of frame F that are not used
789 by fontsets. Called from clear_face_cache from time to time. */
790
791static void
792clear_font_table (f)
793 struct frame *f;
794{
795 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
796 char *used;
797 Lisp_Object rest, frame;
798 int i;
799
800 xassert (FRAME_X_P (f));
801
802 used = (char *) alloca (dpyinfo->n_fonts * sizeof *used);
803 bzero (used, dpyinfo->n_fonts * sizeof *used);
804
805 /* For all frames with the same x_display_info as F, record
806 in `used' those fonts that are in use by fontsets. */
807 FOR_EACH_FRAME (rest, frame)
808 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
809 {
810 struct frame *f = XFRAME (frame);
811 struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f);
812
813 for (i = 0; i < fontset_data->n_fontsets; ++i)
814 {
815 struct fontset_info *info = fontset_data->fontset_table[i];
816 int j;
817
818 for (j = 0; j <= MAX_CHARSET; ++j)
819 {
820 int idx = info->font_indexes[j];
821 if (idx >= 0)
822 used[idx] = 1;
823 }
824 }
825 }
826
827 /* Free those fonts that are not used by fontsets. */
828 for (i = 0; i < dpyinfo->n_fonts; ++i)
829 if (used[i] == 0 && dpyinfo->font_table[i].name)
830 {
831 struct font_info *font_info = dpyinfo->font_table + i;
832
833 /* Free names. In xfns.c there is a comment that full_name
834 should never be freed because it is always shared with
835 something else. I don't think this is true anymore---see
836 x_load_font. It's either equal to font_info->name or
837 allocated via xmalloc, and there seems to be no place in
838 the source files where full_name is transferred to another
839 data structure. */
840 if (font_info->full_name != font_info->name)
841 xfree (font_info->full_name);
842 xfree (font_info->name);
843
844 /* Free the font. */
845 BLOCK_INPUT;
846 XFreeFont (dpyinfo->display, font_info->font);
847 UNBLOCK_INPUT;
848
849 /* Mark font table slot free. */
850 font_info->font = NULL;
851 font_info->name = font_info->full_name = NULL;
852 }
442} 853}
443 854
855
856#endif /* HAVE_X_WINDOWS */
857
858
859
860/***********************************************************************
861 X Pixmaps
862 ***********************************************************************/
863
864#ifdef HAVE_X_WINDOWS
865
444DEFUN ("pixmap-spec-p", Fpixmap_spec_p, Spixmap_spec_p, 1, 1, 0, 866DEFUN ("pixmap-spec-p", Fpixmap_spec_p, Spixmap_spec_p, 1, 1, 0,
445 "Return t if OBJECT is a valid pixmap specification.") 867 "Non-nil if OBJECT is a valid pixmap specification.\n\
868A pixmap specification is either a string, or a list (WIDTH HEIGHT DATA)\n\
869where WIDTH is the pixel width of the pixmap, HEIGHT is its height,\n\
870and DATA contains the bits of the pixmap.")
446 (object) 871 (object)
447 Lisp_Object object; 872 Lisp_Object object;
448{ 873{
@@ -454,7 +879,8 @@ DEFUN ("pixmap-spec-p", Fpixmap_spec_p, Spixmap_spec_p, 1, 1, 0,
454 && CONSP (XCONS (XCONS (object)->cdr)->cdr) 879 && CONSP (XCONS (XCONS (object)->cdr)->cdr)
455 && NILP (XCONS (XCONS (XCONS (object)->cdr)->cdr)->cdr) 880 && NILP (XCONS (XCONS (XCONS (object)->cdr)->cdr)->cdr)
456 && (width = XCONS (object)->car, INTEGERP (width)) 881 && (width = XCONS (object)->car, INTEGERP (width))
457 && (height = XCONS (XCONS (object)->cdr)->car, INTEGERP (height)) 882 && (height = XCONS (XCONS (object)->cdr)->car,
883 INTEGERP (height))
458 && STRINGP (XCONS (XCONS (XCONS (object)->cdr)->cdr)->car) 884 && STRINGP (XCONS (XCONS (XCONS (object)->cdr)->cdr)->car)
459 && XINT (width) > 0 885 && XINT (width) > 0
460 && XINT (height) > 0 886 && XINT (height) > 0
@@ -465,13 +891,15 @@ DEFUN ("pixmap-spec-p", Fpixmap_spec_p, Spixmap_spec_p, 1, 1, 0,
465 ? Qt : Qnil); 891 ? Qt : Qnil);
466} 892}
467 893
468/* Load a bitmap according to NAME (which is either a file name
469 or a pixmap spec). Return the bitmap_id (see xfns.c)
470 or get an error if NAME is invalid.
471 894
472 Store the bitmap width in *W_PTR and height in *H_PTR. */ 895/* Load a bitmap according to NAME (which is either a file name or a
896 pixmap spec) for use on frame F. Value is the bitmap_id (see
897 xfns.c). If NAME is nil, return with a bitmap id of zero. If
898 bitmap cannot be loaded, display a message saying so, and return
899 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
900 if these pointers are not null. */
473 901
474static long 902static int
475load_pixmap (f, name, w_ptr, h_ptr) 903load_pixmap (f, name, w_ptr, h_ptr)
476 FRAME_PTR f; 904 FRAME_PTR f;
477 Lisp_Object name; 905 Lisp_Object name;
@@ -481,14 +909,13 @@ load_pixmap (f, name, w_ptr, h_ptr)
481 Lisp_Object tem; 909 Lisp_Object tem;
482 910
483 if (NILP (name)) 911 if (NILP (name))
484 return FACE_DEFAULT; 912 return 0;
485 913
486 tem = Fpixmap_spec_p (name); 914 tem = Fpixmap_spec_p (name);
487 if (NILP (tem)) 915 if (NILP (tem))
488 wrong_type_argument (Qpixmap_spec_p, name); 916 wrong_type_argument (Qpixmap_spec_p, name);
489 917
490 BLOCK_INPUT; 918 BLOCK_INPUT;
491
492 if (CONSP (name)) 919 if (CONSP (name))
493 { 920 {
494 /* Decode a bitmap spec into a bitmap. */ 921 /* Decode a bitmap spec into a bitmap. */
@@ -511,824 +938,5240 @@ load_pixmap (f, name, w_ptr, h_ptr)
511 UNBLOCK_INPUT; 938 UNBLOCK_INPUT;
512 939
513 if (bitmap_id < 0) 940 if (bitmap_id < 0)
514 Fsignal (Qerror, Fcons (build_string ("invalid or undefined bitmap"), 941 {
515 Fcons (name, Qnil))); 942 display_message (f, "Invalid or undefined bitmap %s", name, Qnil);
943 bitmap_id = 0;
944
945 if (w_ptr)
946 *w_ptr = 0;
947 if (h_ptr)
948 *h_ptr = 0;
949 }
950 else
951 {
952#if GLYPH_DEBUG
953 ++npixmaps_allocated;
954#endif
955 if (w_ptr)
956 *w_ptr = x_bitmap_width (f, bitmap_id);
516 957
517 *w_ptr = x_bitmap_width (f, bitmap_id); 958 if (h_ptr)
518 *h_ptr = x_bitmap_height (f, bitmap_id); 959 *h_ptr = x_bitmap_height (f, bitmap_id);
960 }
519 961
520 return bitmap_id; 962 return bitmap_id;
521} 963}
522 964
523#else /* !HAVE_X_WINDOWS */ 965#endif /* HAVE_X_WINDOWS */
966
967
968
969/***********************************************************************
970 Minimum font bounds
971 ***********************************************************************/
524 972
525/* Stubs for MSDOS when not under X. */ 973#ifdef HAVE_X_WINDOWS
526 974
527struct face * 975/* Update the line_height of frame F according to the biggest font in
528intern_face (f, face) 976 any face. Return non-zero if line height changes. */
977
978int
979frame_update_line_height (f)
529 struct frame *f; 980 struct frame *f;
530 struct face *face;
531{ 981{
532 return face; 982 int i;
983 int fontset = f->output_data.x->fontset;
984 int biggest = (fontset > 0
985 ? FRAME_FONTSET_DATA (f)->fontset_table[fontset]->height
986 : FONT_HEIGHT (f->output_data.x->font));
987 struct face_cache *c = FRAME_FACE_CACHE (f);
988 int changed_p;
989
990 for (i = 0; i < c->used; ++i)
991 {
992 struct face *face = c->faces_by_id[i];
993 if (face)
994 {
995 int height
996 = (face->fontset >= 0
997 ? FRAME_FONTSET_DATA (f)->fontset_table[face->fontset]->height
998 : FONT_HEIGHT (face->font));
999 biggest = max (height, biggest);
1000 }
1001 }
1002
1003 changed_p = biggest != f->output_data.x->line_height;
1004 f->output_data.x->line_height = biggest;
1005 return changed_p;
533} 1006}
534 1007
535void 1008#endif /* HAVE_X_WINDOWS */
536clear_face_cache () 1009
1010
1011/***********************************************************************
1012 Fonts
1013 ***********************************************************************/
1014
1015#ifdef HAVE_X_WINDOWS
1016
1017/* Load font or fontset of face FACE which is used on frame F.
1018 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1019 fontset. FONT_NAME is the name of the font to load, if no fontset
1020 is used. It is null if no suitable font name could be determined
1021 for the face. */
1022
1023static void
1024load_face_font_or_fontset (f, face, font_name, fontset)
1025 struct frame *f;
1026 struct face *face;
1027 char *font_name;
1028 int fontset;
537{ 1029{
538 /* No action. */ 1030 struct font_info *font_info = NULL;
1031
1032 face->font_info_id = -1;
1033 face->fontset = fontset;
1034 face->font = NULL;
1035
1036 BLOCK_INPUT;
1037 if (fontset >= 0)
1038 font_info = FS_LOAD_FONT (f, FRAME_X_FONT_TABLE (f), CHARSET_ASCII,
1039 NULL, fontset);
1040 else if (font_name)
1041 font_info = FS_LOAD_FONT (f, FRAME_X_FONT_TABLE (f), face->charset,
1042 font_name, -1);
1043 UNBLOCK_INPUT;
1044
1045 if (font_info)
1046 {
1047 char *s;
1048 int i;
1049
1050 face->font_info_id = FONT_INFO_ID (f, font_info);
1051 face->font = font_info->font;
1052 face->font_name = font_info->full_name;
1053
1054 /* Make the registry part of the font name readily accessible.
1055 The registry is used to find suitable faces for unibyte text. */
1056 s = font_info->full_name + strlen (font_info->full_name);
1057 i = 0;
1058 while (i < 2 && --s >= font_info->full_name)
1059 if (*s == '-')
1060 ++i;
1061
1062 if (!STRINGP (face->registry)
1063 || xstricmp (XSTRING (face->registry)->data, s + 1) != 0)
1064 {
1065 if (STRINGP (Vface_default_registry)
1066 && !xstricmp (XSTRING (Vface_default_registry)->data, s + 1))
1067 face->registry = Vface_default_registry;
1068 else
1069 face->registry = build_string (s + 1);
1070 }
1071 }
1072 else if (fontset >= 0)
1073 display_message (f, "Unable to load ASCII font of fontset %d",
1074 make_number (fontset), Qnil);
1075 else if (font_name)
1076 display_message (f, "Unable to load font %s",
1077 build_string (font_name), Qnil);
539} 1078}
540 1079
541#ifdef MSDOS 1080#endif /* HAVE_X_WINDOWS */
542unsigned long
543load_color (f, name)
544 FRAME_PTR f;
545 Lisp_Object name;
546{
547 Lisp_Object result;
548 1081
549 if (NILP (name))
550 return FACE_DEFAULT;
551 1082
552 CHECK_STRING (name, 0); 1083
553 result = call1 (Qmsdos_color_translate, name); 1084/***********************************************************************
554 if (INTEGERP (result)) 1085 X Colors
555 return XINT (result); 1086 ***********************************************************************/
1087
1088#ifdef HAVE_X_WINDOWS
1089
1090/* Return non-zero if COLOR_NAME is a shade of gray (or white or
1091 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1092
1093static int
1094face_color_gray_p (f, color_name)
1095 struct frame *f;
1096 char *color_name;
1097{
1098 XColor color;
1099 int gray_p;
1100
1101 if (defined_color (f, color_name, &color, 0))
1102 gray_p = ((abs (color.red - color.green)
1103 < max (color.red, color.green) / 20)
1104 && (abs (color.green - color.blue)
1105 < max (color.green, color.blue) / 20)
1106 && (abs (color.blue - color.red)
1107 < max (color.blue, color.red) / 20));
556 else 1108 else
557 Fsignal (Qerror, Fcons (build_string ("undefined color"), 1109 gray_p = 0;
558 Fcons (name, Qnil))); 1110
1111 return gray_p;
559} 1112}
560#endif
561#endif /* !HAVE_X_WINDOWS */
562 1113
563
564/* Managing parameter face arrays for frames. */
565 1114
566void 1115/* Return non-zero if color COLOR_NAME can be displayed on frame F.
567init_frame_faces (f) 1116 BACKGROUND_P non-zero means the color will be used as background
568 FRAME_PTR f; 1117 color. */
1118
1119static int
1120face_color_supported_p (f, color_name, background_p)
1121 struct frame *f;
1122 char *color_name;
1123 int background_p;
569{ 1124{
570 ensure_face_ready (f, 0); 1125 Lisp_Object frame;
571 ensure_face_ready (f, 1);
572 1126
573 FRAME_N_COMPUTED_FACES (f) = 0; 1127 XSETFRAME (frame, f);
574 FRAME_SIZE_COMPUTED_FACES (f) = 0; 1128 return (!NILP (Vwindow_system)
1129 && (!NILP (Fx_display_color_p (frame))
1130 || xstricmp (color_name, "black") == 0
1131 || xstricmp (color_name, "white") == 0
1132 || (background_p
1133 && face_color_gray_p (f, color_name))
1134 || (!NILP (Fx_display_grayscale_p (frame))
1135 && face_color_gray_p (f, color_name))));
1136}
1137
1138
1139DEFUN ("face-color-gray-p", Fface_color_gray_p, Sface_color_gray_p, 1, 2, 0,
1140 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1141FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1142If FRAME is nil or omitted, use the selected frame.")
1143 (color, frame)
1144 Lisp_Object color, frame;
1145{
1146 struct frame *f = check_x_frame (frame);
1147 CHECK_STRING (color, 0);
1148 return face_color_gray_p (f, XSTRING (color)->data) ? Qt : Qnil;
1149}
575 1150
576 new_computed_face (f, FRAME_PARAM_FACES (f)[0]);
577 new_computed_face (f, FRAME_PARAM_FACES (f)[1]);
578 recompute_basic_faces (f);
579 1151
580 /* Find another X frame. */ 1152DEFUN ("face-color-supported-p", Fface_color_supported_p,
581 { 1153 Sface_color_supported_p, 2, 3, 0,
582 Lisp_Object tail, frame, result; 1154 "Return non-nil if COLOR can be displayed on FRAME.\n\
583 1155BACKGROUND-P non-nil means COLOR is used as a background.\n\
584 result = Qnil; 1156If FRAME is nil or omitted, use the selected frame.\n\
585 FOR_EACH_FRAME (tail, frame) 1157COLOR must be a valid color name.")
586 if ((FRAME_MSDOS_P (XFRAME (frame)) || FRAME_X_P (XFRAME (frame))) 1158 (frame, color, background_p)
587 && XFRAME (frame) != f) 1159 Lisp_Object frame, color, background_p;
1160{
1161 struct frame *f = check_x_frame (frame);
1162 CHECK_STRING (color, 0);
1163 if (face_color_supported_p (f, XSTRING (color)->data, !NILP (background_p)))
1164 return Qt;
1165 return Qnil;
1166}
1167
1168/* Load color with name NAME for use by face FACE on frame F.
1169 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1170 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1171 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1172 pixel color. If color cannot be loaded, display a message, and
1173 return the foreground, background or underline color of F, but
1174 record that fact in flags of the face so that we don't try to free
1175 these colors. */
1176
1177static unsigned long
1178load_color (f, face, name, target_index)
1179 struct frame *f;
1180 struct face *face;
1181 Lisp_Object name;
1182 enum lface_attribute_index target_index;
1183{
1184 XColor color;
1185
1186 xassert (STRINGP (name));
1187 xassert (target_index == LFACE_FOREGROUND_INDEX
1188 || target_index == LFACE_BACKGROUND_INDEX
1189 || target_index == LFACE_UNDERLINE_INDEX
1190 || target_index == LFACE_OVERLINE_INDEX
1191 || target_index == LFACE_STRIKE_THROUGH_INDEX
1192 || target_index == LFACE_BOX_INDEX);
1193
1194 /* if the color map is full, defined_color will return a best match
1195 to the values in an existing cell. */
1196 if (!defined_color (f, XSTRING (name)->data, &color, 1))
1197 {
1198 display_message (f, "Unable to load color %s", name, Qnil);
1199
1200 switch (target_index)
588 { 1201 {
589 result = frame; 1202 case LFACE_FOREGROUND_INDEX:
1203 face->foreground_defaulted_p = 1;
1204 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1205 break;
1206
1207 case LFACE_BACKGROUND_INDEX:
1208 face->background_defaulted_p = 1;
1209 color.pixel = FRAME_BACKGROUND_PIXEL (f);
590 break; 1210 break;
1211
1212 case LFACE_UNDERLINE_INDEX:
1213 face->underline_defaulted_p = 1;
1214 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1215 break;
1216
1217 case LFACE_OVERLINE_INDEX:
1218 face->overline_color_defaulted_p = 1;
1219 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1220 break;
1221
1222 case LFACE_STRIKE_THROUGH_INDEX:
1223 face->strike_through_color_defaulted_p = 1;
1224 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1225 break;
1226
1227 case LFACE_BOX_INDEX:
1228 face->box_color_defaulted_p = 1;
1229 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1230 break;
1231
1232 default:
1233 abort ();
591 } 1234 }
1235 }
1236#if GLYPH_DEBUG
1237 else
1238 ++ncolors_allocated;
1239#endif
1240
1241 return color.pixel;
1242}
592 1243
593 /* If we didn't find any X frames other than f, then we don't need
594 any faces other than 0 and 1, so we're okay. Otherwise, make
595 sure that all faces valid on the selected frame are also valid
596 on this new frame. */
597 if (FRAMEP (result))
598 {
599 int i;
600 int n_faces = FRAME_N_PARAM_FACES (XFRAME (result));
601 struct face **faces = FRAME_PARAM_FACES (XFRAME (result));
602 1244
603 for (i = 2; i < n_faces; i++) 1245/* Load colors for face FACE which is used on frame F. Colors are
604 if (faces[i]) 1246 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
605 ensure_face_ready (f, i); 1247 of ATTRS. If the background color specified is not supported on F,
606 } 1248 try to emulate gray colors with a stipple from Vface_default_stipple. */
607 } 1249
1250static void
1251load_face_colors (f, face, attrs)
1252 struct frame *f;
1253 struct face *face;
1254 Lisp_Object *attrs;
1255{
1256 Lisp_Object fg, bg;
1257
1258 bg = attrs[LFACE_BACKGROUND_INDEX];
1259 fg = attrs[LFACE_FOREGROUND_INDEX];
1260
1261 /* Swap colors if face is inverse-video. */
1262 if (EQ (attrs[LFACE_INVERSE_INDEX], Qt))
1263 {
1264 Lisp_Object tmp;
1265 tmp = fg;
1266 fg = bg;
1267 bg = tmp;
1268 }
1269
1270 /* Check for support for foreground, not for background because
1271 face_color_supported_p is smart enough to know that grays are
1272 "supported" as background because we are supposed to use stipple
1273 for them. */
1274 if (!face_color_supported_p (f, XSTRING (bg)->data, 0)
1275 && !NILP (Fpixmap_spec_p (Vface_default_stipple)))
1276 {
1277 x_destroy_bitmap (f, face->stipple);
1278 face->stipple = load_pixmap (f, Vface_default_stipple,
1279 &face->pixmap_w, &face->pixmap_h);
1280 }
1281 else
1282 face->background = load_color (f, face, bg, LFACE_BACKGROUND_INDEX);
1283
1284 face->foreground = load_color (f, face, fg, LFACE_FOREGROUND_INDEX);
608} 1285}
609 1286
610 1287
611/* Called from Fdelete_frame. */ 1288/* Free color PIXEL on frame F. */
612 1289
613void 1290void
614free_frame_faces (f) 1291unload_color (f, pixel)
615 struct frame *f; 1292 struct frame *f;
1293 unsigned long pixel;
616{ 1294{
617 Display *dpy = FRAME_X_DISPLAY (f); 1295 Display *dpy = FRAME_X_DISPLAY (f);
618 int i; 1296 int class = FRAME_X_DISPLAY_INFO (f)->visual->class;
1297
1298 if (pixel == BLACK_PIX_DEFAULT (f)
1299 || pixel == WHITE_PIX_DEFAULT (f))
1300 return;
619 1301
620 BLOCK_INPUT; 1302 BLOCK_INPUT;
1303
1304 /* If display has an immutable color map, freeing colors is not
1305 necessary and some servers don't allow it. So don't do it. */
1306 if (! (class == StaticColor || class == StaticGray || class == TrueColor))
1307 {
1308 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
1309 XFreeColors (dpy, cmap, &pixel, 1, 0);
1310 }
1311
1312 UNBLOCK_INPUT;
1313}
1314
1315
1316/* Free colors allocated for FACE. */
621 1317
622 for (i = 0; i < FRAME_N_PARAM_FACES (f); i++) 1318static void
1319free_face_colors (f, face)
1320 struct frame *f;
1321 struct face *face;
1322{
1323 int class = FRAME_X_DISPLAY_INFO (f)->visual->class;
1324
1325 /* If display has an immutable color map, freeing colors is not
1326 necessary and some servers don't allow it. So don't do it. */
1327 if (class != StaticColor
1328 && class != StaticGray
1329 && class != TrueColor)
623 { 1330 {
624 struct face *face = FRAME_PARAM_FACES (f) [i]; 1331 Display *dpy;
625 if (face) 1332 Colormap cmap;
1333
1334 BLOCK_INPUT;
1335 dpy = FRAME_X_DISPLAY (f);
1336 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
1337
1338 if (face->foreground != BLACK_PIX_DEFAULT (f)
1339 && face->foreground != WHITE_PIX_DEFAULT (f)
1340 && !face->foreground_defaulted_p)
626 { 1341 {
627 if (face->fontset < 0) 1342 XFreeColors (dpy, cmap, &face->foreground, 1, 0);
628 unload_font (f, face->font); 1343 IF_DEBUG (--ncolors_allocated);
629 unload_color (f, face->foreground); 1344 }
630 unload_color (f, face->background); 1345
631 x_destroy_bitmap (f, face->stipple); 1346 if (face->background != BLACK_PIX_DEFAULT (f)
632 xfree (face); 1347 && face->background != WHITE_PIX_DEFAULT (f)
1348 && !face->background_defaulted_p)
1349 {
1350 XFreeColors (dpy, cmap, &face->background, 1, 0);
1351 IF_DEBUG (--ncolors_allocated);
1352 }
1353
1354 if (face->underline_p
1355 && !face->underline_defaulted_p
1356 && face->underline_color != BLACK_PIX_DEFAULT (f)
1357 && face->underline_color != WHITE_PIX_DEFAULT (f))
1358 {
1359 XFreeColors (dpy, cmap, &face->underline_color, 1, 0);
1360 IF_DEBUG (--ncolors_allocated);
1361 }
1362
1363 if (face->overline_p
1364 && !face->overline_color_defaulted_p
1365 && face->overline_color != BLACK_PIX_DEFAULT (f)
1366 && face->overline_color != WHITE_PIX_DEFAULT (f))
1367 {
1368 XFreeColors (dpy, cmap, &face->overline_color, 1, 0);
1369 IF_DEBUG (--ncolors_allocated);
1370 }
1371
1372 if (face->strike_through_p
1373 && !face->strike_through_color_defaulted_p
1374 && face->strike_through_color != BLACK_PIX_DEFAULT (f)
1375 && face->strike_through_color != WHITE_PIX_DEFAULT (f))
1376 {
1377 XFreeColors (dpy, cmap, &face->strike_through_color, 1, 0);
1378 IF_DEBUG (--ncolors_allocated);
1379 }
1380
1381 if (face->box != FACE_NO_BOX
1382 && !face->box_color_defaulted_p
1383 && face->box_color != BLACK_PIX_DEFAULT (f)
1384 && face->box_color != WHITE_PIX_DEFAULT (f))
1385 {
1386 XFreeColors (dpy, cmap, &face->box_color, 1, 0);
1387 IF_DEBUG (--ncolors_allocated);
1388 }
1389
1390 UNBLOCK_INPUT;
1391 }
1392}
1393
1394#endif /* HAVE_X_WINDOWS */
1395
1396
1397
1398/***********************************************************************
1399 XLFD Font Names
1400 ***********************************************************************/
1401
1402/* An enumerator for each field of an XLFD font name. */
1403
1404enum xlfd_field
1405{
1406 XLFD_FOUNDRY,
1407 XLFD_FAMILY,
1408 XLFD_WEIGHT,
1409 XLFD_SLANT,
1410 XLFD_SWIDTH,
1411 XLFD_ADSTYLE,
1412 XLFD_PIXEL_SIZE,
1413 XLFD_POINT_SIZE,
1414 XLFD_RESX,
1415 XLFD_RESY,
1416 XLFD_SPACING,
1417 XLFD_AVGWIDTH,
1418 XLFD_REGISTRY,
1419 XLFD_ENCODING,
1420 XLFD_LAST
1421};
1422
1423/* An enumerator for each possible slant value of a font. Taken from
1424 the XLFD specification. */
1425
1426enum xlfd_slant
1427{
1428 XLFD_SLANT_UNKNOWN,
1429 XLFD_SLANT_ROMAN,
1430 XLFD_SLANT_ITALIC,
1431 XLFD_SLANT_OBLIQUE,
1432 XLFD_SLANT_REVERSE_ITALIC,
1433 XLFD_SLANT_REVERSE_OBLIQUE,
1434 XLFD_SLANT_OTHER
1435};
1436
1437/* Relative font weight according to XLFD documentation. */
1438
1439enum xlfd_weight
1440{
1441 XLFD_WEIGHT_UNKNOWN,
1442 XLFD_WEIGHT_ULTRA_LIGHT, /* 10 */
1443 XLFD_WEIGHT_EXTRA_LIGHT, /* 20 */
1444 XLFD_WEIGHT_LIGHT, /* 30 */
1445 XLFD_WEIGHT_SEMI_LIGHT, /* 40: SemiLight, Book, ... */
1446 XLFD_WEIGHT_MEDIUM, /* 50: Medium, Normal, Regular, ... */
1447 XLFD_WEIGHT_SEMI_BOLD, /* 60: SemiBold, DemiBold, ... */
1448 XLFD_WEIGHT_BOLD, /* 70: Bold, ... */
1449 XLFD_WEIGHT_EXTRA_BOLD, /* 80: ExtraBold, Heavy, ... */
1450 XLFD_WEIGHT_ULTRA_BOLD /* 90: UltraBold, Black, ... */
1451};
1452
1453/* Relative proportionate width. */
1454
1455enum xlfd_swidth
1456{
1457 XLFD_SWIDTH_UNKNOWN,
1458 XLFD_SWIDTH_ULTRA_CONDENSED, /* 10 */
1459 XLFD_SWIDTH_EXTRA_CONDENSED, /* 20 */
1460 XLFD_SWIDTH_CONDENSED, /* 30: Condensed, Narrow, Compressed, ... */
1461 XLFD_SWIDTH_SEMI_CONDENSED, /* 40: semicondensed */
1462 XLFD_SWIDTH_MEDIUM, /* 50: Medium, Normal, Regular, ... */
1463 XLFD_SWIDTH_SEMI_EXPANDED, /* 60: SemiExpanded, DemiExpanded, ... */
1464 XLFD_SWIDTH_EXPANDED, /* 70: Expanded... */
1465 XLFD_SWIDTH_EXTRA_EXPANDED, /* 80: ExtraExpanded, Wide... */
1466 XLFD_SWIDTH_ULTRA_EXPANDED /* 90: UltraExpanded... */
1467};
1468
1469/* Structure used for tables mapping XLFD weight, slant, and width
1470 names to numeric and symbolic values. */
1471
1472struct table_entry
1473{
1474 char *name;
1475 int numeric;
1476 Lisp_Object *symbol;
1477};
1478
1479/* Table of XLFD slant names and their numeric and symbolic
1480 representations. This table must be sorted by slant names in
1481 ascending order. */
1482
1483static struct table_entry slant_table[] =
1484{
1485 {"i", XLFD_SLANT_ITALIC, &Qitalic},
1486 {"o", XLFD_SLANT_OBLIQUE, &Qoblique},
1487 {"ot", XLFD_SLANT_OTHER, &Qitalic},
1488 {"r", XLFD_SLANT_ROMAN, &Qnormal},
1489 {"ri", XLFD_SLANT_REVERSE_ITALIC, &Qreverse_italic},
1490 {"ro", XLFD_SLANT_REVERSE_OBLIQUE, &Qreverse_oblique}
1491};
1492
1493/* Table of XLFD weight names. This table must be sorted by weight
1494 names in ascending order. */
1495
1496static struct table_entry weight_table[] =
1497{
1498 {"black", XLFD_WEIGHT_ULTRA_BOLD, &Qultra_bold},
1499 {"bold", XLFD_WEIGHT_BOLD, &Qbold},
1500 {"book", XLFD_WEIGHT_SEMI_LIGHT, &Qsemi_light},
1501 {"demibold", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
1502 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT, &Qextra_light},
1503 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD, &Qextra_bold},
1504 {"heavy", XLFD_WEIGHT_EXTRA_BOLD, &Qextra_bold},
1505 {"light", XLFD_WEIGHT_LIGHT, &Qlight},
1506 {"medium", XLFD_WEIGHT_MEDIUM, &Qnormal},
1507 {"normal", XLFD_WEIGHT_MEDIUM, &Qnormal},
1508 {"regular", XLFD_WEIGHT_MEDIUM, &Qnormal},
1509 {"semibold", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
1510 {"semilight", XLFD_WEIGHT_SEMI_LIGHT, &Qsemi_light},
1511 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT, &Qultra_light},
1512 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD, &Qultra_bold}
1513};
1514
1515/* Table of XLFD width names. This table must be sorted by width
1516 names in ascending order. */
1517
1518static struct table_entry swidth_table[] =
1519{
1520 {"compressed", XLFD_SWIDTH_CONDENSED, &Qcondensed},
1521 {"condensed", XLFD_SWIDTH_CONDENSED, &Qcondensed},
1522 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED, &Qsemi_expanded},
1523 {"expanded", XLFD_SWIDTH_EXPANDED, &Qexpanded},
1524 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED, &Qextra_condensed},
1525 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED, &Qextra_expanded},
1526 {"medium", XLFD_SWIDTH_MEDIUM, &Qnormal},
1527 {"narrow", XLFD_SWIDTH_CONDENSED, &Qcondensed},
1528 {"normal", XLFD_SWIDTH_MEDIUM, &Qnormal},
1529 {"regular", XLFD_SWIDTH_MEDIUM, &Qnormal},
1530 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED, &Qsemi_condensed},
1531 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED, &Qsemi_expanded},
1532 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED, &Qultra_condensed},
1533 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED, &Qultra_expanded},
1534 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED, &Qextra_expanded}
1535};
1536
1537/* Structure used to hold the result of splitting font names in XLFD
1538 format into their fields. */
1539
1540struct font_name
1541{
1542 /* The original name which is modified destructively by
1543 split_font_name. The pointer is kept here to be able to free it
1544 if it was allocated from the heap. */
1545 char *name;
1546
1547 /* Font name fields. Each vector element points into `name' above.
1548 Fields are NUL-terminated. */
1549 char *fields[XLFD_LAST];
1550
1551 /* Numeric values for those fields that interest us. See
1552 split_font_name for which these are. */
1553 int numeric[XLFD_LAST];
1554};
1555
1556/* The frame in effect when sorting font names. Set temporarily in
1557 sort_fonts so that it is available in font comparison functions. */
1558
1559static struct frame *font_frame;
1560
1561/* Order by which font selection chooses fonts. The default values
1562 mean `first, find a best match for the font width, then for the
1563 font height, then for weight, then for slant.' This variable can be
1564 set via set-face-font-sort-order. */
1565
1566static int font_sort_order[4];
1567
1568
1569/* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1570 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1571 is a pointer to the matching table entry or null if no table entry
1572 matches. */
1573
1574static struct table_entry *
1575xlfd_lookup_field_contents (table, dim, font, field_index)
1576 struct table_entry *table;
1577 int dim;
1578 struct font_name *font;
1579 int field_index;
1580{
1581 /* Function split_font_name converts fields to lower-case, so there
1582 is no need to use xstrlwr or xstricmp here. */
1583 char *s = font->fields[field_index];
1584 int low, mid, high, cmp;
1585
1586 low = 0;
1587 high = dim - 1;
1588
1589 while (low <= high)
1590 {
1591 mid = (low + high) / 2;
1592 cmp = strcmp (table[mid].name, s);
1593
1594 if (cmp < 0)
1595 low = mid + 1;
1596 else if (cmp > 0)
1597 high = mid - 1;
1598 else
1599 return table + mid;
1600 }
1601
1602 return NULL;
1603}
1604
1605
1606/* Return a numeric representation for font name field
1607 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1608 has DIM entries. Value is the numeric value found or DFLT if no
1609 table entry matches. This function is used to translate weight,
1610 slant, and swidth names of XLFD font names to numeric values. */
1611
1612static INLINE int
1613xlfd_numeric_value (table, dim, font, field_index, dflt)
1614 struct table_entry *table;
1615 int dim;
1616 struct font_name *font;
1617 int field_index;
1618 int dflt;
1619{
1620 struct table_entry *p;
1621 p = xlfd_lookup_field_contents (table, dim, font, field_index);
1622 return p ? p->numeric : dflt;
1623}
1624
1625
1626/* Return a symbolic representation for font name field
1627 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1628 has DIM entries. Value is the symbolic value found or DFLT if no
1629 table entry matches. This function is used to translate weight,
1630 slant, and swidth names of XLFD font names to symbols. */
1631
1632static INLINE Lisp_Object
1633xlfd_symbolic_value (table, dim, font, field_index, dflt)
1634 struct table_entry *table;
1635 int dim;
1636 struct font_name *font;
1637 int field_index;
1638 int dflt;
1639{
1640 struct table_entry *p;
1641 p = xlfd_lookup_field_contents (table, dim, font, field_index);
1642 return p ? *p->symbol : dflt;
1643}
1644
1645
1646/* Return a numeric value for the slant of the font given by FONT. */
1647
1648static INLINE int
1649xlfd_numeric_slant (font)
1650 struct font_name *font;
1651{
1652 return xlfd_numeric_value (slant_table, DIM (slant_table),
1653 font, XLFD_SLANT, XLFD_SLANT_ROMAN);
1654}
1655
1656
1657/* Return a symbol representing the weight of the font given by FONT. */
1658
1659static INLINE Lisp_Object
1660xlfd_symbolic_slant (font)
1661 struct font_name *font;
1662{
1663 return xlfd_symbolic_value (slant_table, DIM (slant_table),
1664 font, XLFD_SLANT, Qnormal);
1665}
1666
1667
1668/* Return a numeric value for the weight of the font given by FONT. */
1669
1670static INLINE int
1671xlfd_numeric_weight (font)
1672 struct font_name *font;
1673{
1674 return xlfd_numeric_value (weight_table, DIM (weight_table),
1675 font, XLFD_WEIGHT, XLFD_WEIGHT_MEDIUM);
1676}
1677
1678
1679/* Return a symbol representing the slant of the font given by FONT. */
1680
1681static INLINE Lisp_Object
1682xlfd_symbolic_weight (font)
1683 struct font_name *font;
1684{
1685 return xlfd_symbolic_value (weight_table, DIM (weight_table),
1686 font, XLFD_WEIGHT, Qnormal);
1687}
1688
1689
1690/* Return a numeric value for the swidth of the font whose XLFD font
1691 name fields are found in FONT. */
1692
1693static INLINE int
1694xlfd_numeric_swidth (font)
1695 struct font_name *font;
1696{
1697 return xlfd_numeric_value (swidth_table, DIM (swidth_table),
1698 font, XLFD_SWIDTH, XLFD_SWIDTH_MEDIUM);
1699}
1700
1701
1702/* Return a symbolic value for the swidth of FONT. */
1703
1704static INLINE Lisp_Object
1705xlfd_symbolic_swidth (font)
1706 struct font_name *font;
1707{
1708 return xlfd_symbolic_value (swidth_table, DIM (swidth_table),
1709 font, XLFD_SWIDTH, Qnormal);
1710}
1711
1712
1713/* Look up the entry of SYMBOL in the vector TABLE which has DIM
1714 entries. Value is a pointer to the matching table entry or null if
1715 no element of TABLE contains SYMBOL. */
1716
1717static struct table_entry *
1718face_value (table, dim, symbol)
1719 struct table_entry *table;
1720 int dim;
1721 Lisp_Object symbol;
1722{
1723 int i;
1724
1725 xassert (SYMBOLP (symbol));
1726
1727 for (i = 0; i < dim; ++i)
1728 if (EQ (*table[i].symbol, symbol))
1729 break;
1730
1731 return i < dim ? table + i : NULL;
1732}
1733
1734
1735/* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1736 entries. Value is -1 if SYMBOL is not found in TABLE. */
1737
1738static INLINE int
1739face_numeric_value (table, dim, symbol)
1740 struct table_entry *table;
1741 int dim;
1742 Lisp_Object symbol;
1743{
1744 struct table_entry *p = face_value (table, dim, symbol);
1745 return p ? p->numeric : -1;
1746}
1747
1748
1749/* Return a numeric value representing the weight specified by Lisp
1750 symbol WEIGHT. Value is one of the enumerators of enum
1751 xlfd_weight. */
1752
1753static INLINE int
1754face_numeric_weight (weight)
1755 Lisp_Object weight;
1756{
1757 return face_numeric_value (weight_table, DIM (weight_table), weight);
1758}
1759
1760
1761/* Return a numeric value representing the slant specified by Lisp
1762 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1763
1764static INLINE int
1765face_numeric_slant (slant)
1766 Lisp_Object slant;
1767{
1768 return face_numeric_value (slant_table, DIM (slant_table), slant);
1769}
1770
1771
1772/* Return a numeric value representing the swidth specified by Lisp
1773 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1774
1775static int
1776face_numeric_swidth (width)
1777 Lisp_Object width;
1778{
1779 return face_numeric_value (swidth_table, DIM (swidth_table), width);
1780}
1781
1782
1783#ifdef HAVE_X_WINDOWS
1784
1785/* Return non-zero if FONT is the name of a fixed-pitch font. */
1786
1787static INLINE int
1788xlfd_fixed_p (font)
1789 struct font_name *font;
1790{
1791 /* Function split_font_name converts fields to lower-case, so there
1792 is no need to use tolower here. */
1793 return *font->fields[XLFD_SPACING] != 'p';
1794}
1795
1796
1797/* Return the point size of FONT on frame F, measured in 1/10 pt.
1798
1799 The actual height of the font when displayed on F depends on the
1800 resolution of both the font and frame. For example, a 10pt font
1801 designed for a 100dpi display will display larger than 10pt on a
1802 75dpi display. (It's not unusual to use fonts not designed for the
1803 display one is using. For example, some intlfonts are available in
1804 72dpi versions, only.)
1805
1806 Value is the real point size of FONT on frame F, or 0 if it cannot
1807 be determined. */
1808
1809static INLINE int
1810xlfd_point_size (f, font)
1811 struct frame *f;
1812 struct font_name *font;
1813{
1814 double resy = FRAME_X_DISPLAY_INFO (f)->resy;
1815 double font_resy = atoi (font->fields[XLFD_RESY]);
1816 double font_pt = atoi (font->fields[XLFD_POINT_SIZE]);
1817 int real_pt;
1818
1819 if (font_resy == 0 || font_pt == 0)
1820 real_pt = 0;
1821 else
1822 real_pt = (font_resy / resy) * font_pt + 0.5;
1823
1824 return real_pt;
1825}
1826
1827
1828/* Split XLFD font name FONT->name destructively into NUL-terminated,
1829 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1830 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1831 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1832 zero if the font name doesn't have the format we expect. The
1833 expected format is a font name that starts with a `-' and has
1834 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1835 forms of font names where certain field contents are enclosed in
1836 square brackets. We don't support that, for now. */
1837
1838static int
1839split_font_name (f, font, numeric_p)
1840 struct frame *f;
1841 struct font_name *font;
1842 int numeric_p;
1843{
1844 int i = 0;
1845 int success_p;
1846
1847 if (*font->name == '-')
1848 {
1849 char *p = xstrlwr (font->name) + 1;
1850
1851 while (i < XLFD_LAST)
1852 {
1853 font->fields[i] = p;
1854 ++i;
1855
1856 while (*p && *p != '-')
1857 ++p;
1858
1859 if (*p != '-')
1860 break;
1861
1862 *p++ = 0;
633 } 1863 }
634 } 1864 }
635 xfree (FRAME_PARAM_FACES (f));
636 FRAME_PARAM_FACES (f) = 0;
637 FRAME_N_PARAM_FACES (f) = 0;
638 1865
639 /* All faces in FRAME_COMPUTED_FACES use resources copied from 1866 success_p = i == XLFD_LAST;
640 FRAME_PARAM_FACES; we can free them without fuss. 1867
641 But we do free the GCs and the face objects themselves. */ 1868 /* If requested, and font name was in the expected format,
642 for (i = 0; i < FRAME_N_COMPUTED_FACES (f); i++) 1869 compute numeric values for some fields. */
1870 if (numeric_p && success_p)
643 { 1871 {
644 struct face *face = FRAME_COMPUTED_FACES (f) [i]; 1872 font->numeric[XLFD_POINT_SIZE] = xlfd_point_size (f, font);
645 if (face) 1873 font->numeric[XLFD_RESY] = atoi (font->fields[XLFD_RESY]);
1874 font->numeric[XLFD_SLANT] = xlfd_numeric_slant (font);
1875 font->numeric[XLFD_WEIGHT] = xlfd_numeric_weight (font);
1876 font->numeric[XLFD_SWIDTH] = xlfd_numeric_swidth (font);
1877 }
1878
1879 return success_p;
1880}
1881
1882
1883/* Build an XLFD font name from font name fields in FONT. Value is a
1884 pointer to the font name, which is allocated via xmalloc. */
1885
1886static char *
1887build_font_name (font)
1888 struct font_name *font;
1889{
1890 int i;
1891 int size = 100;
1892 char *font_name = (char *) xmalloc (size);
1893 int total_length = 0;
1894
1895 for (i = 0; i < XLFD_LAST; ++i)
1896 {
1897 /* Add 1 because of the leading `-'. */
1898 int len = strlen (font->fields[i]) + 1;
1899
1900 /* Reallocate font_name if necessary. Add 1 for the final
1901 NUL-byte. */
1902 if (total_length + len + 1 >= size)
646 { 1903 {
647 if (face->gc) 1904 int new_size = max (2 * size, size + len + 1);
1905 int sz = new_size * sizeof *font_name;
1906 font_name = (char *) xrealloc (font_name, sz);
1907 size = new_size;
1908 }
1909
1910 font_name[total_length] = '-';
1911 bcopy (font->fields[i], font_name + total_length + 1, len - 1);
1912 total_length += len;
1913 }
1914
1915 font_name[total_length] = 0;
1916 return font_name;
1917}
1918
1919
1920/* Free an array FONTS of N font_name structures. This frees FONTS
1921 itself and all `name' fields in its elements. */
1922
1923static INLINE void
1924free_font_names (fonts, n)
1925 struct font_name *fonts;
1926 int n;
1927{
1928 while (n)
1929 xfree (fonts[--n].name);
1930 xfree (fonts);
1931}
1932
1933
1934/* Sort vector FONTS of font_name structures which contains NFONTS
1935 elements using qsort and comparison function CMPFN. F is the frame
1936 on which the fonts will be used. The global variable font_frame
1937 is temporarily set to F to make it available in CMPFN. */
1938
1939static INLINE void
1940sort_fonts (f, fonts, nfonts, cmpfn)
1941 struct frame *f;
1942 struct font_name *fonts;
1943 int nfonts;
1944 int (*cmpfn) P_ ((const void *, const void *));
1945{
1946 font_frame = f;
1947 qsort (fonts, nfonts, sizeof *fonts, cmpfn);
1948 font_frame = NULL;
1949}
1950
1951
1952/* Get fonts matching PATTERN on frame F. If F is null, use the first
1953 display in x_display_list. FONTS is a pointer to a vector of
1954 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
1955 alternative patterns from Valternate_fontname_alist if no fonts are
1956 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
1957 scalable fonts.
1958
1959 For all fonts found, set FONTS[i].name to the name of the font,
1960 allocated via xmalloc, and split font names into fields. Ignore
1961 fonts that we can't parse. Value is the number of fonts found.
1962
1963 This is similar to x_list_fonts. The differences are:
1964
1965 1. It avoids consing.
1966 2. It never calls XLoadQueryFont. */
1967
1968static int
1969x_face_list_fonts (f, pattern, fonts, nfonts, try_alternatives_p,
1970 scalable_fonts_p)
1971 struct frame *f;
1972 char *pattern;
1973 struct font_name *fonts;
1974 int nfonts, try_alternatives_p;
1975 int scalable_fonts_p;
1976{
1977 Display *dpy = f ? FRAME_X_DISPLAY (f) : x_display_list->display;
1978 int n, i, j;
1979 char **names;
1980
1981 /* Get the list of fonts matching PATTERN from the X server. */
1982 BLOCK_INPUT;
1983 names = XListFonts (dpy, pattern, nfonts, &n);
1984 UNBLOCK_INPUT;
1985
1986 if (names)
1987 {
1988 /* Make a copy of the font names we got from X, and
1989 split them into fields. */
1990 for (i = j = 0; i < n; ++i)
1991 {
1992 /* Make a copy of the font name. */
1993 fonts[j].name = xstrdup (names[i]);
1994
1995 /* Ignore fonts having a name that we can't parse. */
1996 if (!split_font_name (f, fonts + j, 1))
1997 xfree (fonts[j].name);
1998 else if (font_scalable_p (fonts + j))
648 { 1999 {
649 XFreeGC (dpy, face->gc); 2000#if SCALABLE_FONTS
650 XFreeGC (dpy, face->non_ascii_gc); 2001 if (!scalable_fonts_p
2002 || !may_use_scalable_font_p (fonts + j, names[i]))
2003 xfree (fonts[j].name);
2004 else
2005 ++j;
2006#else /* !SCALABLE_FONTS */
2007 /* Always ignore scalable fonts. */
2008 xfree (fonts[j].name);
2009#endif /* !SCALABLE_FONTS */
651 } 2010 }
652 xfree (face); 2011 else
2012 ++j;
653 } 2013 }
2014
2015 n = j;
2016
2017 /* Free font names. */
2018 BLOCK_INPUT;
2019 XFreeFontNames (names);
2020 UNBLOCK_INPUT;
654 } 2021 }
655 xfree (FRAME_COMPUTED_FACES (f)); 2022
656 FRAME_COMPUTED_FACES (f) = 0;
657 FRAME_N_COMPUTED_FACES (f) = 0;
658 2023
659 UNBLOCK_INPUT; 2024 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2025 if (n == 0 && try_alternatives_p)
2026 {
2027 Lisp_Object list = Valternate_fontname_alist;
2028
2029 while (CONSP (list))
2030 {
2031 Lisp_Object entry = XCAR (list);
2032 if (CONSP (entry)
2033 && STRINGP (XCAR (entry))
2034 && strcmp (XSTRING (XCAR (entry))->data, pattern) == 0)
2035 break;
2036 list = XCDR (list);
2037 }
2038
2039 if (CONSP (list))
2040 {
2041 Lisp_Object patterns = XCAR (list);
2042 Lisp_Object name;
2043
2044 while (CONSP (patterns)
2045 /* If list is screwed up, give up. */
2046 && (name = XCAR (patterns),
2047 STRINGP (name))
2048 /* Ignore patterns equal to PATTERN because we tried that
2049 already with no success. */
2050 && (strcmp (XSTRING (name)->data, pattern) == 0
2051 || (n = x_face_list_fonts (f, XSTRING (name)->data,
2052 fonts, nfonts, 0,
2053 scalable_fonts_p),
2054 n == 0)))
2055 patterns = XCDR (patterns);
2056 }
2057 }
2058
2059 return n;
660} 2060}
661 2061
662/* Interning faces in a frame's face array. */ 2062
2063/* Determine the first font matching PATTERN on frame F. Return in
2064 *FONT the matching font name, split into fields. Value is non-zero
2065 if a match was found. */
663 2066
664static int 2067static int
665new_computed_face (f, new_face) 2068first_font_matching (f, pattern, font)
666 struct frame *f; 2069 struct frame *f;
667 struct face *new_face; 2070 char *pattern;
2071 struct font_name *font;
668{ 2072{
669 int len = FRAME_N_COMPUTED_FACES (f); 2073 int nfonts = 100;
670 int i; 2074 struct font_name *fonts;
2075
2076 fonts = (struct font_name *) xmalloc (nfonts * sizeof *fonts);
2077 nfonts = x_face_list_fonts (f, pattern, fonts, nfonts, 1, 0);
2078
2079 if (nfonts > 0)
2080 {
2081 bcopy (&fonts[0], font, sizeof *font);
2082
2083 fonts[0].name = NULL;
2084 free_font_names (fonts, nfonts);
2085 }
2086
2087 return nfonts > 0;
2088}
2089
2090
2091/* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2092 using comparison function CMPFN. Value is the number of fonts
2093 found. If value is non-zero, *FONTS is set to a vector of
2094 font_name structures allocated from the heap containing matching
2095 fonts. Each element of *FONTS contains a name member that is also
2096 allocated from the heap. Font names in these structures are split
2097 into fields. Use free_font_names to free such an array. */
671 2098
672 /* Search for an unused computed face in the middle of the table. */ 2099static int
673 for (i = 0; i < len; i++) 2100sorted_font_list (f, pattern, cmpfn, fonts)
2101 struct frame *f;
2102 char *pattern;
2103 int (*cmpfn) P_ ((const void *, const void *));
2104 struct font_name **fonts;
2105{
2106 int nfonts;
2107
2108 /* Get the list of fonts matching pattern. 100 should suffice. */
2109 nfonts = 100;
2110 *fonts = (struct font_name *) xmalloc (nfonts * sizeof **fonts);
2111#if SCALABLE_FONTS
2112 nfonts = x_face_list_fonts (f, pattern, *fonts, nfonts, 1, 1);
2113#else
2114 nfonts = x_face_list_fonts (f, pattern, *fonts, nfonts, 1, 0);
2115#endif
2116
2117 /* Sort the resulting array and return it in *FONTS. If no
2118 fonts were found, make sure to set *FONTS to null. */
2119 if (nfonts)
2120 sort_fonts (f, *fonts, nfonts, cmpfn);
2121 else
674 { 2122 {
675 struct face *face = FRAME_COMPUTED_FACES (f)[i]; 2123 xfree (*fonts);
676 if (face->font == 0) 2124 *fonts = NULL;
2125 }
2126
2127 return nfonts;
2128}
2129
2130
2131/* Compare two font_name structures *A and *B. Value is analogous to
2132 strcmp. Sort order is given by the global variable
2133 font_sort_order. Font names are sorted so that, everything else
2134 being equal, fonts with a resolution closer to that of the frame on
2135 which they are used are listed first. The global variable
2136 font_frame is the frame on which we operate. */
2137
2138static int
2139cmp_font_names (a, b)
2140 const void *a, *b;
2141{
2142 struct font_name *x = (struct font_name *) a;
2143 struct font_name *y = (struct font_name *) b;
2144 int cmp;
2145
2146 /* All strings have been converted to lower-case by split_font_name,
2147 so we can use strcmp here. */
2148 cmp = strcmp (x->fields[XLFD_FAMILY], y->fields[XLFD_FAMILY]);
2149 if (cmp == 0)
2150 {
2151 int i;
2152
2153 for (i = 0; i < DIM (font_sort_order) && cmp == 0; ++i)
677 { 2154 {
678 FRAME_COMPUTED_FACES (f)[i] = copy_face (new_face); 2155 int j = font_sort_order[i];
679 return i; 2156 cmp = x->numeric[j] - y->numeric[j];
2157 }
2158
2159 if (cmp == 0)
2160 {
2161 /* Everything else being equal, we prefer fonts with an
2162 y-resolution closer to that of the frame. */
2163 int resy = FRAME_X_DISPLAY_INFO (font_frame)->resy;
2164 int x_resy = x->numeric[XLFD_RESY];
2165 int y_resy = y->numeric[XLFD_RESY];
2166 cmp = abs (resy - x_resy) - abs (resy - y_resy);
680 } 2167 }
681 } 2168 }
682 2169
683 if (i >= FRAME_SIZE_COMPUTED_FACES (f)) 2170 return cmp;
2171}
2172
2173
2174/* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2175 is non-null list fonts matching that pattern. Otherwise, if
2176 REGISTRY_AND_ENCODING is non-null return only fonts with that
2177 registry and encoding, otherwise return fonts of any registry and
2178 encoding. Set *FONTS to a vector of font_name structures allocated
2179 from the heap containing the fonts found. Value is the number of
2180 fonts found. */
2181
2182static int
2183font_list (f, pattern, family, registry_and_encoding, fonts)
2184 struct frame *f;
2185 char *pattern;
2186 char *family;
2187 char *registry_and_encoding;
2188 struct font_name **fonts;
2189{
2190 if (pattern == NULL)
684 { 2191 {
685 int new_size = i + 32; 2192 if (family == NULL)
2193 family = "*";
2194
2195 if (registry_and_encoding == NULL)
2196 registry_and_encoding = "*";
2197
2198 pattern = (char *) alloca (strlen (family)
2199 + strlen (registry_and_encoding)
2200 + 10);
2201 if (index (family, '-'))
2202 sprintf (pattern, "-%s-*-%s", family, registry_and_encoding);
2203 else
2204 sprintf (pattern, "-*-%s-*-%s", family, registry_and_encoding);
2205 }
2206
2207 return sorted_font_list (f, pattern, cmp_font_names, fonts);
2208}
2209
686 2210
687 FRAME_COMPUTED_FACES (f) 2211/* Remove elements from LIST whose cars are `equal'. Called from
688 = (struct face **) (FRAME_SIZE_COMPUTED_FACES (f) == 0 2212 x-font-list and x-font-family-list to remove duplicate font
689 ? xmalloc (new_size * sizeof (struct face *)) 2213 entries. */
690 : xrealloc (FRAME_COMPUTED_FACES (f), 2214
691 new_size * sizeof (struct face *))); 2215static void
692 FRAME_SIZE_COMPUTED_FACES (f) = new_size; 2216remove_duplicates (list)
2217 Lisp_Object list;
2218{
2219 Lisp_Object tail = list;
2220
2221 while (!NILP (tail) && !NILP (XCDR (tail)))
2222 {
2223 Lisp_Object next = XCDR (tail);
2224 if (!NILP (Fequal (XCAR (next), XCAR (tail))))
2225 XCDR (tail) = XCDR (next);
2226 else
2227 tail = XCDR (tail);
693 } 2228 }
2229}
2230
2231
2232DEFUN ("x-font-list", Fxfont_list, Sx_font_list, 0, 2, 0,
2233 "Return a list of available fonts of family FAMILY on FRAME.\n\
2234If FAMILY is omitted or nil, list all families.\n\
2235Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2236`?' and `*'.\n\
2237If FRAME is omitted or nil, use the selected frame.\n\
2238Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2239SLANT FIXED-P].\n\
2240FAMILY is the font family name. POINT-SIZE is the size of the\n\
2241font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2242width, weight and slant of the font. These symbols are the same as for\n\
2243face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2244The result list is sorted according to the current setting of\n\
2245the face font sort order.")
2246 (family, frame)
2247 Lisp_Object family, frame;
2248{
2249 struct frame *f = check_x_frame (frame);
2250 struct font_name *fonts;
2251 int i, nfonts;
2252 Lisp_Object result;
2253 struct gcpro gcpro1;
2254 char *family_pattern;
694 2255
695 i = FRAME_N_COMPUTED_FACES (f)++; 2256 if (NILP (family))
696 FRAME_COMPUTED_FACES (f)[i] = copy_face (new_face); 2257 family_pattern = "*";
697 return i; 2258 else
2259 {
2260 CHECK_STRING (family, 1);
2261 family_pattern = LSTRDUPA (family);
2262 }
2263
2264 result = Qnil;
2265 GCPRO1 (result);
2266 nfonts = font_list (f, NULL, family_pattern, NULL, &fonts);
2267 for (i = nfonts - 1; i >= 0; --i)
2268 {
2269 Lisp_Object v = Fmake_vector (make_number (6), Qnil);
2270
2271#define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2272
2273 ASET (v, 0, build_string (fonts[i].fields[XLFD_FAMILY]));
2274 ASET (v, 1, xlfd_symbolic_swidth (fonts + i));
2275 ASET (v, 2, make_number (xlfd_point_size (f, fonts + i)));
2276 ASET (v, 3, xlfd_symbolic_weight (fonts + i));
2277 ASET (v, 4, xlfd_symbolic_slant (fonts + i));
2278 ASET (v, 5, xlfd_fixed_p (fonts + i) ? Qt : Qnil);
2279 result = Fcons (v, result);
2280
2281#undef ASET
2282 }
2283
2284 remove_duplicates (result);
2285 free_font_names (fonts, nfonts);
2286 UNGCPRO;
2287 return result;
698} 2288}
699 2289
700 2290
701/* Find a match for NEW_FACE in a FRAME's computed face array, and add 2291DEFUN ("x-font-family-list", Fx_font_family_list, Sx_font_family_list,
702 it if we don't find one. */ 2292 0, 1, 0,
703static int 2293 "Return a list of available font families on FRAME.\n\
704intern_computed_face (f, new_face) 2294If FRAME is omitted or nil, use the selected frame.\n\
2295Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2296is a font family, and FIXED-P is non-nil if fonts of that family\n\
2297are fixed-pitch.")
2298 (frame)
2299 Lisp_Object frame;
2300{
2301 struct frame *f = check_x_frame (frame);
2302 int nfonts, i;
2303 struct font_name *fonts;
2304 Lisp_Object result;
2305 struct gcpro gcpro1;
2306
2307 nfonts = font_list (f, NULL, "*", NULL, &fonts);
2308 result = Qnil;
2309 GCPRO1 (result);
2310 for (i = nfonts - 1; i >= 0; --i)
2311 result = Fcons (Fcons (build_string (fonts[i].fields[XLFD_FAMILY]),
2312 xlfd_fixed_p (fonts + i) ? Qt : Qnil),
2313 result);
2314
2315 remove_duplicates (result);
2316 free_font_names (fonts, nfonts);
2317 UNGCPRO;
2318 return result;
2319}
2320
2321
2322DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 5, 0,
2323 "Return a list of the names of available fonts matching PATTERN.\n\
2324If optional arguments FACE and FRAME are specified, return only fonts\n\
2325the same size as FACE on FRAME.\n\
2326PATTERN is a string, perhaps with wildcard characters;\n\
2327 the * character matches any substring, and\n\
2328 the ? character matches any single character.\n\
2329 PATTERN is case-insensitive.\n\
2330FACE is a face name--a symbol.\n\
2331\n\
2332The return value is a list of strings, suitable as arguments to\n\
2333set-face-font.\n\
2334\n\
2335Fonts Emacs can't use may or may not be excluded\n\
2336even if they match PATTERN and FACE.\n\
2337The optional fourth argument MAXIMUM sets a limit on how many\n\
2338fonts to match. The first MAXIMUM fonts are reported.\n\
2339The optional fifth argument WIDTH, if specified, is a number of columns\n\
2340occupied by a character of a font. In that case, return only fonts\n\
2341the WIDTH times as wide as FACE on FRAME.")
2342 (pattern, face, frame, maximum, width)
2343 Lisp_Object pattern, face, frame, maximum, width;
2344{
2345 struct frame *f;
2346 int size;
2347 int maxnames;
2348
2349 check_x ();
2350 CHECK_STRING (pattern, 0);
2351
2352 if (NILP (maximum))
2353 maxnames = 2000;
2354 else
2355 {
2356 CHECK_NATNUM (maximum, 0);
2357 maxnames = XINT (maximum);
2358 }
2359
2360 if (!NILP (width))
2361 CHECK_NUMBER (width, 4);
2362
2363 /* We can't simply call check_x_frame because this function may be
2364 called before any frame is created. */
2365 f = frame_or_selected_frame (frame, 2);
2366 if (!FRAME_X_P (f))
2367 {
2368 /* Perhaps we have not yet created any frame. */
2369 f = NULL;
2370 face = Qnil;
2371 }
2372
2373 /* Determine the width standard for comparison with the fonts we find. */
2374
2375 if (NILP (face))
2376 size = 0;
2377 else
2378 {
2379 /* This is of limited utility since it works with character
2380 widths. Keep it for compatibility. --gerd. */
2381 int face_id = lookup_named_face (f, face, CHARSET_ASCII);
2382 struct face *face = FACE_FROM_ID (f, face_id);
2383
2384 if (face->font)
2385 size = face->font->max_bounds.width;
2386 else
2387 size = FRAME_FONT (f)->max_bounds.width;
2388
2389 if (!NILP (width))
2390 size *= XINT (width);
2391 }
2392
2393 {
2394 Lisp_Object args[2];
2395
2396 args[0] = x_list_fonts (f, pattern, size, maxnames);
2397 if (f == NULL)
2398 /* We don't have to check fontsets. */
2399 return args[0];
2400 args[1] = list_fontsets (f, pattern, size);
2401 return Fnconc (2, args);
2402 }
2403}
2404
2405#endif /* HAVE_X_WINDOWS */
2406
2407
2408
2409/***********************************************************************
2410 Lisp Faces
2411 ***********************************************************************/
2412
2413/* Access face attributes of face FACE, a Lisp vector. */
2414
2415#define LFACE_FAMILY(LFACE) \
2416 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2417#define LFACE_HEIGHT(LFACE) \
2418 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2419#define LFACE_WEIGHT(LFACE) \
2420 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2421#define LFACE_SLANT(LFACE) \
2422 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2423#define LFACE_UNDERLINE(LFACE) \
2424 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2425#define LFACE_INVERSE(LFACE) \
2426 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2427#define LFACE_FOREGROUND(LFACE) \
2428 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2429#define LFACE_BACKGROUND(LFACE) \
2430 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2431#define LFACE_STIPPLE(LFACE) \
2432 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2433#define LFACE_SWIDTH(LFACE) \
2434 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2435#define LFACE_OVERLINE(LFACE) \
2436 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2437#define LFACE_STRIKE_THROUGH(LFACE) \
2438 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2439#define LFACE_BOX(LFACE) \
2440 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2441
2442/* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2443 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2444
2445#define LFACEP(LFACE) \
2446 (VECTORP (LFACE) \
2447 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2448 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2449
2450
2451#if GLYPH_DEBUG
2452
2453/* Check consistency of Lisp face attribute vector ATTRS. */
2454
2455static void
2456check_lface_attrs (attrs)
2457 Lisp_Object *attrs;
2458{
2459 xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
2460 || STRINGP (attrs[LFACE_FAMILY_INDEX]));
2461 xassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
2462 || SYMBOLP (attrs[LFACE_SWIDTH_INDEX]));
2463 xassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
2464 || INTEGERP (attrs[LFACE_HEIGHT_INDEX]));
2465 xassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
2466 || SYMBOLP (attrs[LFACE_WEIGHT_INDEX]));
2467 xassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
2468 || SYMBOLP (attrs[LFACE_SLANT_INDEX]));
2469 xassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
2470 || SYMBOLP (attrs[LFACE_UNDERLINE_INDEX])
2471 || STRINGP (attrs[LFACE_UNDERLINE_INDEX]));
2472 xassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
2473 || SYMBOLP (attrs[LFACE_OVERLINE_INDEX])
2474 || STRINGP (attrs[LFACE_OVERLINE_INDEX]));
2475 xassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
2476 || SYMBOLP (attrs[LFACE_STRIKE_THROUGH_INDEX])
2477 || STRINGP (attrs[LFACE_STRIKE_THROUGH_INDEX]));
2478 xassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
2479 || SYMBOLP (attrs[LFACE_BOX_INDEX])
2480 || STRINGP (attrs[LFACE_BOX_INDEX])
2481 || INTEGERP (attrs[LFACE_BOX_INDEX])
2482 || CONSP (attrs[LFACE_BOX_INDEX]));
2483 xassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
2484 || SYMBOLP (attrs[LFACE_INVERSE_INDEX]));
2485 xassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
2486 || STRINGP (attrs[LFACE_FOREGROUND_INDEX]));
2487 xassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
2488 || STRINGP (attrs[LFACE_BACKGROUND_INDEX]));
2489#ifdef HAVE_WINDOW_SYSTEM
2490 xassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
2491 || SYMBOLP (attrs[LFACE_STIPPLE_INDEX])
2492 || !NILP (Fpixmap_spec_p (attrs[LFACE_STIPPLE_INDEX])));
2493#endif
2494}
2495
2496
2497/* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2498
2499static void
2500check_lface (lface)
2501 Lisp_Object lface;
2502{
2503 if (!NILP (lface))
2504 {
2505 xassert (LFACEP (lface));
2506 check_lface_attrs (XVECTOR (lface)->contents);
2507 }
2508}
2509
2510#else /* GLYPH_DEBUG == 0 */
2511
2512#define check_lface_attrs(attrs) (void) 0
2513#define check_lface(lface) (void) 0
2514
2515#endif /* GLYPH_DEBUG == 0 */
2516
2517
2518/* Return the face definition of FACE_NAME on frame F. F null means
2519 return the global definition. FACE_NAME may be a string or a
2520 symbol (apparently Emacs 20.2 allows strings as face names in face
2521 text properties; ediff uses that). If SIGNAL_P is non-zero, signal
2522 an error if FACE_NAME is not a valid face name. If SIGNAL_P is
2523 zero, value is nil if FACE_NAME is not a valid face name. */
2524
2525static INLINE Lisp_Object
2526lface_from_face_name (f, face_name, signal_p)
2527 struct frame *f;
2528 Lisp_Object face_name;
2529 int signal_p;
2530{
2531 Lisp_Object lface;
2532
2533 if (STRINGP (face_name))
2534 face_name = intern (XSTRING (face_name)->data);
2535
2536 if (f)
2537 lface = assq_no_quit (face_name, f->face_alist);
2538 else
2539 lface = assq_no_quit (face_name, Vface_new_frame_defaults);
2540
2541 if (CONSP (lface))
2542 lface = XCDR (lface);
2543 else if (signal_p)
2544 signal_error ("Invalid face", face_name);
2545
2546 check_lface (lface);
2547 return lface;
2548}
2549
2550
2551/* Get face attributes of face FACE_NAME from frame-local faces on
2552 frame F. Store the resulting attributes in ATTRS which must point
2553 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2554 is non-zero, signal an error if FACE_NAME does not name a face.
2555 Otherwise, value is zero if FACE_NAME is not a face. */
2556
2557static INLINE int
2558get_lface_attributes (f, face_name, attrs, signal_p)
705 struct frame *f; 2559 struct frame *f;
706 struct face *new_face; 2560 Lisp_Object face_name;
2561 Lisp_Object *attrs;
2562 int signal_p;
2563{
2564 Lisp_Object lface;
2565 int success_p;
2566
2567 lface = lface_from_face_name (f, face_name, signal_p);
2568 if (!NILP (lface))
2569 {
2570 bcopy (XVECTOR (lface)->contents, attrs,
2571 LFACE_VECTOR_SIZE * sizeof *attrs);
2572 success_p = 1;
2573 }
2574 else
2575 success_p = 0;
2576
2577 return success_p;
2578}
2579
2580
2581/* Non-zero if all attributes in face attribute vector ATTRS are
2582 specified, i.e. are non-nil. */
2583
2584static int
2585lface_fully_specified_p (attrs)
2586 Lisp_Object *attrs;
707{ 2587{
708 int len = FRAME_N_COMPUTED_FACES (f);
709 int i; 2588 int i;
710 2589
711 /* Search for a computed face already on F equivalent to FACE. */ 2590 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
712 for (i = 0; i < len; i++) 2591 if (UNSPECIFIEDP (attrs[i]))
2592 break;
2593
2594 return i == LFACE_VECTOR_SIZE;
2595}
2596
2597
2598#ifdef HAVE_X_WINDOWS
2599
2600/* Set font-related attributes of Lisp face LFACE from XLFD font name
2601 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2602 LFACE. Ignore fields of FONT_NAME containing wildcards. Value is
2603 zero if not successful because FONT_NAME was not in a valid format.
2604 A valid format is one that is suitable for split_font_name, see the
2605 comment there. */
2606
2607static int
2608set_lface_from_font_name (f, lface, font_name, force_p)
2609 struct frame *f;
2610 Lisp_Object lface;
2611 char *font_name;
2612 int force_p;
2613{
2614 struct font_name font;
2615 char *buffer;
2616 int pt;
2617 int free_font_name_p = 0;
2618
2619 /* If FONT_NAME contains wildcards, use the first matching font. */
2620 if (index (font_name, '*') || index (font_name, '?'))
713 { 2621 {
714 if (! FRAME_COMPUTED_FACES (f)[i]) 2622 if (!first_font_matching (f, font_name, &font))
715 abort (); 2623 return 0;
716 if (face_eql (new_face, FRAME_COMPUTED_FACES (f)[i])) 2624 free_font_name_p = 1;
717 return i; 2625 }
2626 else
2627 {
2628 font.name = STRDUPA (font_name);
2629 if (!split_font_name (f, &font, 1))
2630 {
2631 /* The font name may be something like `6x13'. Make
2632 sure we use the full name. */
2633 struct font_info *font_info;
2634
2635 BLOCK_INPUT;
2636 font_info = fs_load_font (f, FRAME_X_FONT_TABLE (f),
2637 CHARSET_ASCII, font_name, -1);
2638 UNBLOCK_INPUT;
2639
2640 if (!font_info)
2641 return 0;
2642
2643 font.name = STRDUPA (font_info->full_name);
2644 split_font_name (f, &font, 1);
2645 }
2646
2647 /* FONT_NAME should not be a fontset name, here. */
2648 xassert (xstricmp (font.fields[XLFD_REGISTRY], "fontset") != 0);
2649 }
2650
2651 /* Set attributes only if unspecified, otherwise face defaults for
2652 new frames would never take effect. */
2653
2654 if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface)))
2655 {
2656 buffer = (char *) alloca (strlen (font.fields[XLFD_FAMILY])
2657 + strlen (font.fields[XLFD_FOUNDRY])
2658 + 2);
2659 sprintf (buffer, "%s-%s", font.fields[XLFD_FOUNDRY],
2660 font.fields[XLFD_FAMILY]);
2661 LFACE_FAMILY (lface) = build_string (buffer);
718 } 2662 }
719 2663
720 /* We didn't find one; add a new one. */ 2664 if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface)))
721 return new_computed_face (f, new_face); 2665 {
2666 pt = xlfd_point_size (f, &font);
2667 xassert (pt > 0);
2668 LFACE_HEIGHT (lface) = make_number (pt);
2669 }
2670
2671 if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface)))
2672 LFACE_SWIDTH (lface) = xlfd_symbolic_swidth (&font);
2673
2674 if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface)))
2675 LFACE_WEIGHT (lface) = xlfd_symbolic_weight (&font);
2676
2677 if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface)))
2678 LFACE_SLANT (lface) = xlfd_symbolic_slant (&font);
2679
2680 if (free_font_name_p)
2681 xfree (font.name);
2682
2683 return 1;
2684}
2685
2686#endif /* HAVE_X_WINDOWS */
2687
2688
2689/* Merge two Lisp face attribute vectors FROM and TO and store the
2690 resulting attributes in TO. Every non-nil attribute of FROM
2691 overrides the corresponding attribute of TO. */
2692
2693static INLINE void
2694merge_face_vectors (from, to)
2695 Lisp_Object *from, *to;
2696{
2697 int i;
2698 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
2699 if (!UNSPECIFIEDP (from[i]))
2700 to[i] = from[i];
722} 2701}
723 2702
724/* Make parameter face id ID valid on frame F. */
725 2703
2704/* Given a Lisp face attribute vector TO and a Lisp object PROP that
2705 is a face property, determine the resulting face attributes on
2706 frame F, and store them in TO. PROP may be a single face
2707 specification or a list of such specifications. Each face
2708 specification can be
2709
2710 1. A symbol or string naming a Lisp face.
2711
2712 2. A property list of the form (KEYWORD VALUE ...) where each
2713 KEYWORD is a face attribute name, and value is an appropriate value
2714 for that attribute.
2715
2716 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2717 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2718 for compatibility with 20.2.
2719
2720 Face specifications earlier in lists take precedence over later
2721 specifications. */
2722
726static void 2723static void
727ensure_face_ready (f, id) 2724merge_face_vector_with_property (f, to, prop)
728 struct frame *f; 2725 struct frame *f;
729 int id; 2726 Lisp_Object *to;
2727 Lisp_Object prop;
730{ 2728{
731 if (FRAME_N_PARAM_FACES (f) <= id) 2729 if (CONSP (prop))
732 { 2730 {
733 int n = id + 10; 2731 Lisp_Object first = XCAR (prop);
734 int i; 2732
735 if (!FRAME_N_PARAM_FACES (f)) 2733 if (EQ (first, Qforeground_color)
736 FRAME_PARAM_FACES (f) 2734 || EQ (first, Qbackground_color))
737 = (struct face **) xmalloc (sizeof (struct face *) * n); 2735 {
2736 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2737 . COLOR). COLOR must be a string. */
2738 Lisp_Object color_name = XCDR (prop);
2739 Lisp_Object color = first;
2740
2741 if (STRINGP (color_name))
2742 {
2743 if (EQ (color, Qforeground_color))
2744 to[LFACE_FOREGROUND_INDEX] = color_name;
2745 else
2746 to[LFACE_BACKGROUND_INDEX] = color_name;
2747 }
2748 else
2749 display_message (f, "Invalid face color", color_name, Qnil);
2750 }
2751 else if (SYMBOLP (first)
2752 && *XSYMBOL (first)->name->data == ':')
2753 {
2754 /* Assume this is the property list form. */
2755 while (CONSP (prop) && CONSP (XCDR (prop)))
2756 {
2757 Lisp_Object keyword = XCAR (prop);
2758 Lisp_Object value = XCAR (XCDR (prop));
2759
2760 if (EQ (keyword, QCfamily))
2761 {
2762 if (STRINGP (value))
2763 to[LFACE_FAMILY_INDEX] = value;
2764 else
2765 display_message (f, "Illegal face font family",
2766 value, Qnil);
2767 }
2768 else if (EQ (keyword, QCheight))
2769 {
2770 if (INTEGERP (value))
2771 to[LFACE_HEIGHT_INDEX] = value;
2772 else
2773 display_message (f, "Illegal face font height",
2774 value, Qnil);
2775 }
2776 else if (EQ (keyword, QCweight))
2777 {
2778 if (SYMBOLP (value)
2779 && face_numeric_weight (value) >= 0)
2780 to[LFACE_WEIGHT_INDEX] = value;
2781 else
2782 display_message (f, "Illegal face weight", value, Qnil);
2783 }
2784 else if (EQ (keyword, QCslant))
2785 {
2786 if (SYMBOLP (value)
2787 && face_numeric_slant (value) >= 0)
2788 to[LFACE_SLANT_INDEX] = value;
2789 else
2790 display_message (f, "Illegal face slant", value, Qnil);
2791 }
2792 else if (EQ (keyword, QCunderline))
2793 {
2794 if (EQ (value, Qt)
2795 || NILP (value)
2796 || STRINGP (value))
2797 to[LFACE_UNDERLINE_INDEX] = value;
2798 else
2799 display_message (f, "Illegal face underline", value, Qnil);
2800 }
2801 else if (EQ (keyword, QCoverline))
2802 {
2803 if (EQ (value, Qt)
2804 || NILP (value)
2805 || STRINGP (value))
2806 to[LFACE_OVERLINE_INDEX] = value;
2807 else
2808 display_message (f, "Illegal face overline", value, Qnil);
2809 }
2810 else if (EQ (keyword, QCstrike_through))
2811 {
2812 if (EQ (value, Qt)
2813 || NILP (value)
2814 || STRINGP (value))
2815 to[LFACE_STRIKE_THROUGH_INDEX] = value;
2816 else
2817 display_message (f, "Illegal face strike-through",
2818 value, Qnil);
2819 }
2820 else if (EQ (keyword, QCbox))
2821 {
2822 if (EQ (value, Qt))
2823 value = make_number (1);
2824 if (INTEGERP (value)
2825 || STRINGP (value)
2826 || CONSP (value)
2827 || NILP (value))
2828 to[LFACE_BOX_INDEX] = value;
2829 else
2830 display_message (f, "Illegal face box", value, Qnil);
2831 }
2832 else if (EQ (keyword, QCinverse_video)
2833 || EQ (keyword, QCreverse_video))
2834 {
2835 if (EQ (value, Qt) || NILP (value))
2836 to[LFACE_INVERSE_INDEX] = value;
2837 else
2838 display_message (f, "Illegal face inverse-video",
2839 value, Qnil);
2840 }
2841 else if (EQ (keyword, QCforeground))
2842 {
2843 if (STRINGP (value))
2844 to[LFACE_FOREGROUND_INDEX] = value;
2845 else
2846 display_message (f, "Illegal face foreground",
2847 value, Qnil);
2848 }
2849 else if (EQ (keyword, QCbackground))
2850 {
2851 if (STRINGP (value))
2852 to[LFACE_BACKGROUND_INDEX] = value;
2853 else
2854 display_message (f, "Illegal face background",
2855 value, Qnil);
2856 }
2857 else if (EQ (keyword, QCstipple))
2858 {
2859#ifdef HAVE_X_WINDOWS
2860 Lisp_Object pixmap_p = Fpixmap_spec_p (value);
2861 if (!NILP (pixmap_p))
2862 to[LFACE_STIPPLE_INDEX] = value;
2863 else
2864 display_message (f, "Illegal face stipple", value, Qnil);
2865#endif
2866 }
2867 else if (EQ (keyword, QCwidth))
2868 {
2869 if (SYMBOLP (value)
2870 && face_numeric_swidth (value) >= 0)
2871 to[LFACE_SWIDTH_INDEX] = value;
2872 else
2873 display_message (f, "Illegal face width", value, Qnil);
2874 }
2875 else
2876 display_message (f, "Invalid attribute %s in face property",
2877 keyword, Qnil);
2878
2879 prop = XCDR (XCDR (prop));
2880 }
2881 }
2882 else
2883 {
2884 /* This is a list of face specs. Specifications at the
2885 beginning of the list take precedence over later
2886 specifications, so we have to merge starting with the
2887 last specification. */
2888 Lisp_Object next = XCDR (prop);
2889 if (!NILP (next))
2890 merge_face_vector_with_property (f, to, next);
2891 merge_face_vector_with_property (f, to, first);
2892 }
2893 }
2894 else
2895 {
2896 /* PROP ought to be a face name. */
2897 Lisp_Object lface = lface_from_face_name (f, prop, 0);
2898 if (NILP (lface))
2899 display_message (f, "Invalid face text property value: %s",
2900 prop, Qnil);
2901 else
2902 merge_face_vectors (XVECTOR (lface)->contents, to);
2903 }
2904}
2905
2906
2907DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face,
2908 Sinternal_make_lisp_face, 1, 2, 0,
2909 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
2910If FACE was not known as a face before, create a new one.\n\
2911If optional argument FRAME is specified, make a frame-local face\n\
2912for that frame. Otherwise operate on the global face definition.\n\
2913Value is a vector of face attributes.")
2914 (face, frame)
2915 Lisp_Object face, frame;
2916{
2917 Lisp_Object global_lface, lface;
2918 struct frame *f;
2919 int i;
2920
2921 CHECK_SYMBOL (face, 0);
2922 global_lface = lface_from_face_name (NULL, face, 0);
2923
2924 if (!NILP (frame))
2925 {
2926 CHECK_LIVE_FRAME (frame, 1);
2927 f = XFRAME (frame);
2928 lface = lface_from_face_name (f, face, 0);
2929 }
2930 else
2931 f = NULL, lface = Qnil;
2932
2933 /* Add a global definition if there is none. */
2934 if (NILP (global_lface))
2935 {
2936 global_lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
2937 Qunspecified);
2938 XVECTOR (global_lface)->contents[0] = Qface;
2939 Vface_new_frame_defaults = Fcons (Fcons (face, global_lface),
2940 Vface_new_frame_defaults);
2941
2942 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2943 face id to Lisp face is given by the vector lface_id_to_name.
2944 The mapping from Lisp face to Lisp face id is given by the
2945 property `face' of the Lisp face name. */
2946 if (next_lface_id == lface_id_to_name_size)
2947 {
2948 int new_size = max (50, 2 * lface_id_to_name_size);
2949 int sz = new_size * sizeof *lface_id_to_name;
2950 lface_id_to_name = (Lisp_Object *) xrealloc (lface_id_to_name, sz);
2951 lface_id_to_name_size = new_size;
2952 }
2953
2954 lface_id_to_name[next_lface_id] = face;
2955 Fput (face, Qface, make_number (next_lface_id));
2956 ++next_lface_id;
2957 }
2958 else if (f == NULL)
2959 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
2960 XVECTOR (global_lface)->contents[i] = Qunspecified;
2961
2962 /* Add a frame-local definition. */
2963 if (f)
2964 {
2965 if (NILP (lface))
2966 {
2967 lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
2968 Qunspecified);
2969 XVECTOR (lface)->contents[0] = Qface;
2970 f->face_alist = Fcons (Fcons (face, lface), f->face_alist);
2971 }
738 else 2972 else
739 FRAME_PARAM_FACES (f) 2973 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
740 = (struct face **) xrealloc (FRAME_PARAM_FACES (f), 2974 XVECTOR (lface)->contents[i] = Qunspecified;
741 sizeof (struct face *) * n); 2975 }
2976 else
2977 lface = global_lface;
742 2978
743 bzero (FRAME_PARAM_FACES (f) + FRAME_N_PARAM_FACES (f), 2979 xassert (LFACEP (lface));
744 (n - FRAME_N_PARAM_FACES (f)) * sizeof (struct face *)); 2980 check_lface (lface);
745 FRAME_N_PARAM_FACES (f) = n; 2981 return lface;
2982}
2983
2984
2985DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p,
2986 Sinternal_lisp_face_p, 1, 2, 0,
2987 "Return non-nil if FACE names a face.\n\
2988If optional second parameter FRAME is non-nil, check for the\n\
2989existence of a frame-local face with name FACE on that frame.\n\
2990Otherwise check for the existence of a global face.")
2991 (face, frame)
2992 Lisp_Object face, frame;
2993{
2994 Lisp_Object lface;
2995
2996 if (!NILP (frame))
2997 {
2998 CHECK_LIVE_FRAME (frame, 1);
2999 lface = lface_from_face_name (XFRAME (frame), face, 0);
746 } 3000 }
3001 else
3002 lface = lface_from_face_name (NULL, face, 0);
747 3003
748 if (FRAME_PARAM_FACES (f) [id] == 0) 3004 return lface;
749 FRAME_PARAM_FACES (f) [id] = allocate_face ();
750} 3005}
751 3006
3007
3008DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face,
3009 Sinternal_copy_lisp_face, 4, 4, 0,
3010 "Copy face FROM to TO.\n\
3011If FRAME it t, copy the global face definition of FROM to the\n\
3012global face definition of TO. Otherwise, copy the frame-local\n\
3013definition of FROM on FRAME to the frame-local definition of TO\n\
3014on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3015\n\
3016Value is TO.")
3017 (from, to, frame, new_frame)
3018 Lisp_Object from, to, frame, new_frame;
3019{
3020 Lisp_Object lface, copy;
3021
3022 CHECK_SYMBOL (from, 0);
3023 CHECK_SYMBOL (to, 1);
3024 if (NILP (new_frame))
3025 new_frame = frame;
3026
3027 if (EQ (frame, Qt))
3028 {
3029 /* Copy global definition of FROM. We don't make copies of
3030 strings etc. because 20.2 didn't do it either. */
3031 lface = lface_from_face_name (NULL, from, 1);
3032 copy = Finternal_make_lisp_face (to, Qnil);
3033 }
3034 else
3035 {
3036 /* Copy frame-local definition of FROM. */
3037 CHECK_LIVE_FRAME (frame, 2);
3038 CHECK_LIVE_FRAME (new_frame, 3);
3039 lface = lface_from_face_name (XFRAME (frame), from, 1);
3040 copy = Finternal_make_lisp_face (to, new_frame);
3041 }
3042
3043 bcopy (XVECTOR (lface)->contents, XVECTOR (copy)->contents,
3044 LFACE_VECTOR_SIZE * sizeof (Lisp_Object));
3045
3046 return to;
3047}
3048
3049
3050DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute,
3051 Sinternal_set_lisp_face_attribute, 3, 4, 0,
3052 "Set attribute ATTR of FACE to VALUE.\n\
3053If optional argument FRAME is given, set the face attribute of face FACE\n\
3054on that frame. If FRAME is t, set the attribute of the default for face\n\
3055FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3056frame.")
3057 (face, attr, value, frame)
3058 Lisp_Object face, attr, value, frame;
3059{
3060 Lisp_Object lface;
3061 Lisp_Object old_value = Qnil;
3062 int font_related_attr_p = 0;
3063
3064 CHECK_SYMBOL (face, 0);
3065 CHECK_SYMBOL (attr, 1);
3066
3067 /* Set lface to the Lisp attribute vector of FACE. */
3068 if (EQ (frame, Qt))
3069 lface = lface_from_face_name (NULL, face, 1);
3070 else
3071 {
3072 if (NILP (frame))
3073 XSETFRAME (frame, selected_frame);
3074
3075 CHECK_LIVE_FRAME (frame, 3);
3076 lface = lface_from_face_name (XFRAME (frame), face, 0);
3077
3078 /* If a frame-local face doesn't exist yet, create one. */
3079 if (NILP (lface))
3080 lface = Finternal_make_lisp_face (face, frame);
3081 }
3082
3083 if (EQ (attr, QCfamily))
3084 {
3085 if (!UNSPECIFIEDP (value))
3086 {
3087 CHECK_STRING (value, 3);
3088 if (XSTRING (value)->size == 0)
3089 signal_error ("Invalid face family", value);
3090 }
3091 old_value = LFACE_FAMILY (lface);
3092 LFACE_FAMILY (lface) = value;
3093 font_related_attr_p = 1;
3094 }
3095 else if (EQ (attr, QCheight))
3096 {
3097 if (!UNSPECIFIEDP (value))
3098 {
3099 CHECK_NUMBER (value, 3);
3100 if (XINT (value) <= 0)
3101 signal_error ("Invalid face height", value);
3102 }
3103 old_value = LFACE_HEIGHT (lface);
3104 LFACE_HEIGHT (lface) = value;
3105 font_related_attr_p = 1;
3106 }
3107 else if (EQ (attr, QCweight))
3108 {
3109 if (!UNSPECIFIEDP (value))
3110 {
3111 CHECK_SYMBOL (value, 3);
3112 if (face_numeric_weight (value) < 0)
3113 signal_error ("Invalid face weight", value);
3114 }
3115 old_value = LFACE_WEIGHT (lface);
3116 LFACE_WEIGHT (lface) = value;
3117 font_related_attr_p = 1;
3118 }
3119 else if (EQ (attr, QCslant))
3120 {
3121 if (!UNSPECIFIEDP (value))
3122 {
3123 CHECK_SYMBOL (value, 3);
3124 if (face_numeric_slant (value) < 0)
3125 signal_error ("Invalid face slant", value);
3126 }
3127 old_value = LFACE_SLANT (lface);
3128 LFACE_SLANT (lface) = value;
3129 font_related_attr_p = 1;
3130 }
3131 else if (EQ (attr, QCunderline))
3132 {
3133 if (!UNSPECIFIEDP (value))
3134 if ((SYMBOLP (value)
3135 && !EQ (value, Qt)
3136 && !EQ (value, Qnil))
3137 /* Underline color. */
3138 || (STRINGP (value)
3139 && XSTRING (value)->size == 0))
3140 signal_error ("Invalid face underline", value);
3141
3142 old_value = LFACE_UNDERLINE (lface);
3143 LFACE_UNDERLINE (lface) = value;
3144 }
3145 else if (EQ (attr, QCoverline))
3146 {
3147 if (!UNSPECIFIEDP (value))
3148 if ((SYMBOLP (value)
3149 && !EQ (value, Qt)
3150 && !EQ (value, Qnil))
3151 /* Overline color. */
3152 || (STRINGP (value)
3153 && XSTRING (value)->size == 0))
3154 signal_error ("Invalid face overline", value);
3155
3156 old_value = LFACE_OVERLINE (lface);
3157 LFACE_OVERLINE (lface) = value;
3158 }
3159 else if (EQ (attr, QCstrike_through))
3160 {
3161 if (!UNSPECIFIEDP (value))
3162 if ((SYMBOLP (value)
3163 && !EQ (value, Qt)
3164 && !EQ (value, Qnil))
3165 /* Strike-through color. */
3166 || (STRINGP (value)
3167 && XSTRING (value)->size == 0))
3168 signal_error ("Invalid face strike-through", value);
3169
3170 old_value = LFACE_STRIKE_THROUGH (lface);
3171 LFACE_STRIKE_THROUGH (lface) = value;
3172 }
3173 else if (EQ (attr, QCbox))
3174 {
3175 int valid_p;
3176
3177 /* Allow t meaning a simple box of width 1 in foreground color
3178 of the face. */
3179 if (EQ (value, Qt))
3180 value = make_number (1);
3181
3182 if (UNSPECIFIEDP (value))
3183 valid_p = 1;
3184 else if (NILP (value))
3185 valid_p = 1;
3186 else if (INTEGERP (value))
3187 valid_p = XINT (value) > 0;
3188 else if (STRINGP (value))
3189 valid_p = XSTRING (value)->size > 0;
3190 else if (CONSP (value))
3191 {
3192 Lisp_Object tem;
3193
3194 tem = value;
3195 while (CONSP (tem))
3196 {
3197 Lisp_Object k, v;
3198
3199 k = XCAR (tem);
3200 tem = XCDR (tem);
3201 if (!CONSP (tem))
3202 break;
3203 v = XCAR (tem);
3204 tem = XCDR (tem);
3205
3206 if (EQ (k, QCline_width))
3207 {
3208 if (!INTEGERP (v) || XINT (v) <= 0)
3209 break;
3210 }
3211 else if (EQ (k, QCcolor))
3212 {
3213 if (!STRINGP (v) || XSTRING (v)->size == 0)
3214 break;
3215 }
3216 else if (EQ (k, QCstyle))
3217 {
3218 if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button))
3219 break;
3220 }
3221 else
3222 break;
3223 }
3224
3225 valid_p = NILP (tem);
3226 }
3227 else
3228 valid_p = 0;
3229
3230 if (!valid_p)
3231 signal_error ("Invalid face box", value);
3232
3233 old_value = LFACE_BOX (lface);
3234 LFACE_BOX (lface) = value;
3235 }
3236 else if (EQ (attr, QCinverse_video)
3237 || EQ (attr, QCreverse_video))
3238 {
3239 if (!UNSPECIFIEDP (value))
3240 {
3241 CHECK_SYMBOL (value, 3);
3242 if (!EQ (value, Qt) && !NILP (value))
3243 signal_error ("Invalid inverse-video face attribute value", value);
3244 }
3245 old_value = LFACE_INVERSE (lface);
3246 LFACE_INVERSE (lface) = value;
3247 }
3248 else if (EQ (attr, QCforeground))
3249 {
3250 if (!UNSPECIFIEDP (value))
3251 {
3252 /* Don't check for valid color names here because it depends
3253 on the frame (display) whether the color will be valid
3254 when the face is realized. */
3255 CHECK_STRING (value, 3);
3256 if (XSTRING (value)->size == 0)
3257 signal_error ("Empty foreground color value", value);
3258 }
3259 old_value = LFACE_FOREGROUND (lface);
3260 LFACE_FOREGROUND (lface) = value;
3261 }
3262 else if (EQ (attr, QCbackground))
3263 {
3264 if (!UNSPECIFIEDP (value))
3265 {
3266 /* Don't check for valid color names here because it depends
3267 on the frame (display) whether the color will be valid
3268 when the face is realized. */
3269 CHECK_STRING (value, 3);
3270 if (XSTRING (value)->size == 0)
3271 signal_error ("Empty background color value", value);
3272 }
3273 old_value = LFACE_BACKGROUND (lface);
3274 LFACE_BACKGROUND (lface) = value;
3275 }
3276 else if (EQ (attr, QCstipple))
3277 {
752#ifdef HAVE_X_WINDOWS 3278#ifdef HAVE_X_WINDOWS
753/* Return non-zero if FONT1 and FONT2 have the same width. 3279 if (!UNSPECIFIEDP (value)
754 We do not check the height, because we can now deal with 3280 && !NILP (value)
755 different heights. 3281 && NILP (Fpixmap_spec_p (value)))
756 We assume that they're both character-cell fonts. */ 3282 signal_error ("Invalid stipple attribute", value);
3283 old_value = LFACE_STIPPLE (lface);
3284 LFACE_STIPPLE (lface) = value;
3285#endif /* HAVE_X_WINDOWS */
3286 }
3287 else if (EQ (attr, QCwidth))
3288 {
3289 if (!UNSPECIFIEDP (value))
3290 {
3291 CHECK_SYMBOL (value, 3);
3292 if (face_numeric_swidth (value) < 0)
3293 signal_error ("Invalid face width", value);
3294 }
3295 old_value = LFACE_SWIDTH (lface);
3296 LFACE_SWIDTH (lface) = value;
3297 font_related_attr_p = 1;
3298 }
3299 else if (EQ (attr, QCfont))
3300 {
3301#ifdef HAVE_X_WINDOWS
3302 /* Set font-related attributes of the Lisp face from an
3303 XLFD font name. */
3304 struct frame *f;
757 3305
758int 3306 CHECK_STRING (value, 3);
759same_size_fonts (font1, font2) 3307 if (EQ (frame, Qt))
760 XFontStruct *font1, *font2; 3308 f = selected_frame;
3309 else
3310 f = check_x_frame (frame);
3311
3312 if (!set_lface_from_font_name (f, lface, XSTRING (value)->data, 1))
3313 signal_error ("Invalid font name", value);
3314
3315 font_related_attr_p = 1;
3316#endif /* HAVE_X_WINDOWS */
3317 }
3318 else if (EQ (attr, QCbold))
3319 {
3320 old_value = LFACE_WEIGHT (lface);
3321 LFACE_WEIGHT (lface) = NILP (value) ? Qnormal : Qbold;
3322 font_related_attr_p = 1;
3323 }
3324 else if (EQ (attr, QCitalic))
3325 {
3326 old_value = LFACE_SLANT (lface);
3327 LFACE_SLANT (lface) = NILP (value) ? Qnormal : Qitalic;
3328 font_related_attr_p = 1;
3329 }
3330 else
3331 signal_error ("Invalid face attribute name", attr);
3332
3333 /* Changing a named face means that all realized faces depending on
3334 that face are invalid. Since we cannot tell which realized faces
3335 depend on the face, make sure they are all removed. This is done
3336 by incrementing face_change_count. The next call to
3337 init_iterator will then free realized faces. */
3338 if (!EQ (frame, Qt)
3339 && (EQ (attr, QCfont)
3340 || NILP (Fequal (old_value, value))))
3341 {
3342 ++face_change_count;
3343 ++windows_or_buffers_changed;
3344 }
3345
3346#ifdef HAVE_X_WINDOWS
3347 /* Changed font-related attributes of the `default' face are
3348 reflected in changed `font' frame parameters. */
3349 if (EQ (face, Qdefault)
3350 && !EQ (frame, Qt)
3351 && font_related_attr_p
3352 && lface_fully_specified_p (XVECTOR (lface)->contents)
3353 && NILP (Fequal (old_value, value)))
3354 set_font_frame_param (frame, lface);
3355
3356#endif /* HAVE_X_WINDOWS */
3357
3358 return face;
3359}
3360
3361
3362#ifdef HAVE_X_WINDOWS
3363
3364/* Set the `font' frame parameter of FRAME according to `default' face
3365 attributes LFACE. */
3366
3367static void
3368set_font_frame_param (frame, lface)
3369 Lisp_Object frame, lface;
761{ 3370{
762 XCharStruct *bounds1 = &font1->min_bounds; 3371 struct frame *f = XFRAME (frame);
763 XCharStruct *bounds2 = &font2->min_bounds; 3372 Lisp_Object frame_font;
3373 int fontset;
3374 char *font;
3375
3376 /* Get FRAME's font parameter. */
3377 frame_font = Fassq (Qfont, f->param_alist);
3378 xassert (CONSP (frame_font) && STRINGP (XCDR (frame_font)));
3379 frame_font = XCDR (frame_font);
3380
3381 fontset = fs_query_fontset (f, XSTRING (frame_font)->data);
3382 if (fontset >= 0)
3383 {
3384 /* Frame parameter is a fontset name. Modify the fontset so
3385 that all its fonts reflect face attributes LFACE. */
3386 int charset;
3387 struct fontset_info *fontset_info;
3388
3389 fontset_info = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
3390
3391 for (charset = 0; charset < MAX_CHARSET; ++charset)
3392 if (fontset_info->fontname[charset])
3393 {
3394 font = choose_face_fontset_font (f, XVECTOR (lface)->contents,
3395 fontset, charset);
3396 Fset_fontset_font (frame_font, CHARSET_SYMBOL (charset),
3397 build_string (font), frame);
3398 xfree (font);
3399 }
3400 }
3401 else
3402 {
3403 /* Frame parameter is an X font name. I believe this can
3404 only happen in unibyte mode. */
3405 font = choose_face_font (f, XVECTOR (lface)->contents,
3406 -1, Vface_default_registry);
3407 if (font)
3408 {
3409 store_frame_param (f, Qfont, build_string (font));
3410 xfree (font);
3411 }
3412 }
3413}
764 3414
765 return (bounds1->width == bounds2->width); 3415
3416/* Get the value of X resource RESOURCE, class CLASS for the display
3417 of frame FRAME. This is here because ordinary `x-get-resource'
3418 doesn't take a frame argument. */
3419
3420DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource,
3421 Sinternal_face_x_get_resource, 3, 3, 0, "")
3422 (resource, class, frame)
3423 Lisp_Object resource, class, frame;
3424{
3425 Lisp_Object value;
3426 CHECK_STRING (resource, 0);
3427 CHECK_STRING (class, 1);
3428 CHECK_LIVE_FRAME (frame, 2);
3429 BLOCK_INPUT;
3430 value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)),
3431 resource, class, Qnil, Qnil);
3432 UNBLOCK_INPUT;
3433 return value;
766} 3434}
767 3435
768/* Update the line_height of frame F according to the biggest font in
769 any face. Return nonzero if if line_height changes. */
770 3436
771int 3437/* Return resource string VALUE as a boolean value, i.e. nil, or t.
772frame_update_line_height (f) 3438 If VALUE is "on" or "true", return t. If VALUE is "off" or
773 FRAME_PTR f; 3439 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3440 error; if SIGNAL_P is zero, return 0. */
3441
3442static Lisp_Object
3443face_boolean_x_resource_value (value, signal_p)
3444 Lisp_Object value;
3445 int signal_p;
774{ 3446{
775 int i; 3447 Lisp_Object result = make_number (0);
776 int fontset = f->output_data.x->fontset;
777 int biggest = (fontset > 0
778 ? FRAME_FONTSET_DATA (f)->fontset_table[fontset]->height
779 : FONT_HEIGHT (f->output_data.x->font));
780 3448
781 for (i = 0; i < f->output_data.x->n_param_faces; i++) 3449 xassert (STRINGP (value));
782 if (f->output_data.x->param_faces[i] != 0 3450
783 && f->output_data.x->param_faces[i]->font != (XFontStruct *) FACE_DEFAULT) 3451 if (xstricmp (XSTRING (value)->data, "on") == 0
784 { 3452 || xstricmp (XSTRING (value)->data, "true") == 0)
785 int height = ((fontset = f->output_data.x->param_faces[i]->fontset) > 0 3453 result = Qt;
786 ? FRAME_FONTSET_DATA (f)->fontset_table[fontset]->height 3454 else if (xstricmp (XSTRING (value)->data, "off") == 0
787 : FONT_HEIGHT (f->output_data.x->param_faces[i]->font)); 3455 || xstricmp (XSTRING (value)->data, "false") == 0)
3456 result = Qnil;
3457 else if (xstricmp (XSTRING (value)->data, "unspecified") == 0)
3458 result = Qunspecified;
3459 else if (signal_p)
3460 signal_error ("Invalid face attribute value from X resource", value);
788 3461
789 if (height > biggest) 3462 return result;
790 biggest = height; 3463}
791 }
792 3464
793 if (biggest == f->output_data.x->line_height)
794 return 0;
795 3465
796 f->output_data.x->line_height = biggest; 3466DEFUN ("internal-set-lisp-face-attribute-from-resource",
797 return 1; 3467 Finternal_set_lisp_face_attribute_from_resource,
3468 Sinternal_set_lisp_face_attribute_from_resource,
3469 3, 4, 0, "")
3470 (face, attr, value, frame)
3471 Lisp_Object face, attr, value, frame;
3472{
3473 CHECK_SYMBOL (face, 0);
3474 CHECK_SYMBOL (attr, 1);
3475 CHECK_STRING (value, 2);
3476
3477 if (xstricmp (XSTRING (value)->data, "unspecified") == 0)
3478 value = Qunspecified;
3479 else if (EQ (attr, QCheight))
3480 {
3481 value = Fstring_to_number (value, make_number (10));
3482 if (XINT (value) <= 0)
3483 signal_error ("Invalid face height from X resource", value);
3484 }
3485 else if (EQ (attr, QCbold) || EQ (attr, QCitalic))
3486 value = face_boolean_x_resource_value (value, 1);
3487 else if (EQ (attr, QCweight) || EQ (attr, QCslant) || EQ (attr, QCwidth))
3488 value = intern (XSTRING (value)->data);
3489 else if (EQ (attr, QCreverse_video) || EQ (attr, QCinverse_video))
3490 value = face_boolean_x_resource_value (value, 1);
3491 else if (EQ (attr, QCunderline)
3492 || EQ (attr, QCoverline)
3493 || EQ (attr, QCstrike_through)
3494 || EQ (attr, QCbox))
3495 {
3496 Lisp_Object boolean_value;
3497
3498 /* If the result of face_boolean_x_resource_value is t or nil,
3499 VALUE does NOT specify a color. */
3500 boolean_value = face_boolean_x_resource_value (value, 0);
3501 if (SYMBOLP (boolean_value))
3502 value = boolean_value;
3503 }
3504
3505 return Finternal_set_lisp_face_attribute (face, attr, value, frame);
798} 3506}
799#endif /* not HAVE_X_WINDOWS */
800
801/* Modify face TO by copying from FROM all properties which have
802 nondefault settings. */
803 3507
804static void 3508
805merge_faces (from, to) 3509#endif /* HAVE_X_WINDOWS */
806 struct face *from, *to; 3510
3511
3512
3513DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute,
3514 Sinternal_get_lisp_face_attribute,
3515 2, 3, 0,
3516 "Return face attribute KEYWORD of face SYMBOL.\n\
3517If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
3518face attribute name, signal an error.\n\
3519If the optional argument FRAME is given, report on face FACE in that\n\
3520frame. If FRAME is t, report on the defaults for face FACE (for new\n\
3521frames). If FRAME is omitted or nil, use the selected frame.")
3522 (symbol, keyword, frame)
3523 Lisp_Object symbol, keyword, frame;
3524{
3525 Lisp_Object lface, value = Qnil;
3526
3527 CHECK_SYMBOL (symbol, 0);
3528 CHECK_SYMBOL (keyword, 1);
3529
3530 if (EQ (frame, Qt))
3531 lface = lface_from_face_name (NULL, symbol, 1);
3532 else
3533 {
3534 if (NILP (frame))
3535 XSETFRAME (frame, selected_frame);
3536 CHECK_LIVE_FRAME (frame, 2);
3537 lface = lface_from_face_name (XFRAME (frame), symbol, 1);
3538 }
3539
3540 if (EQ (keyword, QCfamily))
3541 value = LFACE_FAMILY (lface);
3542 else if (EQ (keyword, QCheight))
3543 value = LFACE_HEIGHT (lface);
3544 else if (EQ (keyword, QCweight))
3545 value = LFACE_WEIGHT (lface);
3546 else if (EQ (keyword, QCslant))
3547 value = LFACE_SLANT (lface);
3548 else if (EQ (keyword, QCunderline))
3549 value = LFACE_UNDERLINE (lface);
3550 else if (EQ (keyword, QCoverline))
3551 value = LFACE_OVERLINE (lface);
3552 else if (EQ (keyword, QCstrike_through))
3553 value = LFACE_STRIKE_THROUGH (lface);
3554 else if (EQ (keyword, QCbox))
3555 value = LFACE_BOX (lface);
3556 else if (EQ (keyword, QCinverse_video)
3557 || EQ (keyword, QCreverse_video))
3558 value = LFACE_INVERSE (lface);
3559 else if (EQ (keyword, QCforeground))
3560 value = LFACE_FOREGROUND (lface);
3561 else if (EQ (keyword, QCbackground))
3562 value = LFACE_BACKGROUND (lface);
3563 else if (EQ (keyword, QCstipple))
3564 value = LFACE_STIPPLE (lface);
3565 else if (EQ (keyword, QCwidth))
3566 value = LFACE_SWIDTH (lface);
3567 else
3568 signal_error ("Invalid face attribute name", keyword);
3569
3570 return value;
3571}
3572
3573
3574DEFUN ("internal-lisp-face-attribute-values",
3575 Finternal_lisp_face_attribute_values,
3576 Sinternal_lisp_face_attribute_values, 1, 1, 0,
3577 "Return a list of valid discrete values for face attribute ATTR.\n\
3578Value is nil if ATTR doesn't have a discrete set of valid values.")
3579 (attr)
3580 Lisp_Object attr;
3581{
3582 Lisp_Object result = Qnil;
3583
3584 CHECK_SYMBOL (attr, 0);
3585
3586 if (EQ (attr, QCweight)
3587 || EQ (attr, QCslant)
3588 || EQ (attr, QCwidth))
3589 {
3590 /* Extract permissible symbols from tables. */
3591 struct table_entry *table;
3592 int i, dim;
3593
3594 if (EQ (attr, QCweight))
3595 table = weight_table, dim = DIM (weight_table);
3596 else if (EQ (attr, QCslant))
3597 table = slant_table, dim = DIM (slant_table);
3598 else
3599 table = swidth_table, dim = DIM (swidth_table);
3600
3601 for (i = 0; i < dim; ++i)
3602 {
3603 Lisp_Object symbol = *table[i].symbol;
3604 Lisp_Object tail = result;
3605
3606 while (!NILP (tail)
3607 && !EQ (XCAR (tail), symbol))
3608 tail = XCDR (tail);
3609
3610 if (NILP (tail))
3611 result = Fcons (symbol, result);
3612 }
3613 }
3614 else if (EQ (attr, QCunderline))
3615 result = Fcons (Qt, Fcons (Qnil, Qnil));
3616 else if (EQ (attr, QCoverline))
3617 result = Fcons (Qt, Fcons (Qnil, Qnil));
3618 else if (EQ (attr, QCstrike_through))
3619 result = Fcons (Qt, Fcons (Qnil, Qnil));
3620 else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video))
3621 result = Fcons (Qt, Fcons (Qnil, Qnil));
3622
3623 return result;
3624}
3625
3626
3627DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face,
3628 Sinternal_merge_in_global_face, 2, 2, 0,
3629 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
3630 (face, frame)
3631 Lisp_Object face, frame;
3632{
3633 Lisp_Object global_lface, local_lface;
3634 CHECK_LIVE_FRAME (frame, 1);
3635 global_lface = lface_from_face_name (NULL, face, 1);
3636 local_lface = lface_from_face_name (XFRAME (frame), face, 0);
3637 if (NILP (local_lface))
3638 local_lface = Finternal_make_lisp_face (face, frame);
3639 merge_face_vectors (XVECTOR (global_lface)->contents,
3640 XVECTOR (local_lface)->contents);
3641 return face;
3642}
3643
3644
3645/* The following function is implemented for compatibility with 20.2.
3646 The function is used in x-resolve-fonts when it is asked to
3647 return fonts with the same size as the font of a face. This is
3648 done in fontset.el. */
3649
3650DEFUN ("face-font", Fface_font, Sface_font, 1, 2, 0,
3651 "Return the font name of face FACE, or nil if it is unspecified.\n\
3652If the optional argument FRAME is given, report on face FACE in that frame.\n\
3653If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3654 The font default for a face is either nil, or a list\n\
3655 of the form (bold), (italic) or (bold italic).\n\
3656If FRAME is omitted or nil, use the selected frame.")
3657 (face, frame)
3658 Lisp_Object face, frame;
3659{
3660 if (EQ (frame, Qt))
3661 {
3662 Lisp_Object result = Qnil;
3663 Lisp_Object lface = lface_from_face_name (NULL, face, 1);
3664
3665 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface))
3666 && !EQ (LFACE_WEIGHT (lface), Qnormal))
3667 result = Fcons (Qbold, result);
3668
3669 if (!NILP (LFACE_SLANT (lface))
3670 && !EQ (LFACE_SLANT (lface), Qnormal))
3671 result = Fcons (Qitalic, result);
3672
3673 return result;
3674 }
3675 else
3676 {
3677 struct frame *f = frame_or_selected_frame (frame, 1);
3678 int face_id = lookup_named_face (f, face, CHARSET_ASCII);
3679 struct face *face = FACE_FROM_ID (f, face_id);
3680 return build_string (face->font_name);
3681 }
3682}
3683
3684
3685/* Compare face vectors V1 and V2 for equality. Value is non-zero if
3686 all attributes are `equal'. Tries to be fast because this function
3687 is called quite often. */
3688
3689static INLINE int
3690lface_equal_p (v1, v2)
3691 Lisp_Object *v1, *v2;
3692{
3693 int i, equal_p = 1;
3694
3695 for (i = 1; i < LFACE_VECTOR_SIZE && equal_p; ++i)
3696 {
3697 Lisp_Object a = v1[i];
3698 Lisp_Object b = v2[i];
3699
3700 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3701 and the other is specified. */
3702 equal_p = XTYPE (a) == XTYPE (b);
3703 if (!equal_p)
3704 break;
3705
3706 if (!EQ (a, b))
3707 {
3708 switch (XTYPE (a))
3709 {
3710 case Lisp_String:
3711 equal_p = (XSTRING (a)->size == XSTRING (b)->size
3712 && bcmp (XSTRING (a)->data, XSTRING (b)->data,
3713 XSTRING (a)->size) == 0);
3714 break;
3715
3716 case Lisp_Int:
3717 case Lisp_Symbol:
3718 equal_p = 0;
3719 break;
3720
3721 default:
3722 equal_p = !NILP (Fequal (a, b));
3723 break;
3724 }
3725 }
3726 }
3727
3728 return equal_p;
3729}
3730
3731
3732DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p,
3733 Sinternal_lisp_face_equal_p, 2, 3, 0,
3734 "True if FACE1 and FACE2 are equal.\n\
3735If the optional argument FRAME is given, report on face FACE in that frame.\n\
3736If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3737If FRAME is omitted or nil, use the selected frame.")
3738 (face1, face2, frame)
3739 Lisp_Object face1, face2, frame;
807{ 3740{
808 /* Only merge the font if it's the same width as the base font. 3741 int equal_p;
809 Otherwise ignore it, since we can't handle it properly. */ 3742 struct frame *f;
810 if (from->font != (XFontStruct *) FACE_DEFAULT 3743 Lisp_Object lface1, lface2;
811 && same_size_fonts (from->font, to->font)) 3744
812 to->font = from->font; 3745 if (EQ (frame, Qt))
813 if (from->fontset != -1) 3746 f = NULL;
814 to->fontset = from->fontset; 3747 else
815 if (from->foreground != FACE_DEFAULT) 3748 /* Don't use check_x_frame here because this function is called
816 to->foreground = from->foreground; 3749 before X frames exist. At that time, if FRAME is nil,
817 if (from->background != FACE_DEFAULT) 3750 selected_frame will be used which is the frame dumped with
818 to->background = from->background; 3751 Emacs. That frame is not an X frame. */
819 if (from->stipple != FACE_DEFAULT) 3752 f = frame_or_selected_frame (frame, 2);
3753
3754 lface1 = lface_from_face_name (NULL, face1, 1);
3755 lface2 = lface_from_face_name (NULL, face2, 1);
3756 equal_p = lface_equal_p (XVECTOR (lface1)->contents,
3757 XVECTOR (lface2)->contents);
3758 return equal_p ? Qt : Qnil;
3759}
3760
3761
3762DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p,
3763 Sinternal_lisp_face_empty_p, 1, 2, 0,
3764 "True if FACE has no attribute specified.\n\
3765If the optional argument FRAME is given, report on face FACE in that frame.\n\
3766If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3767If FRAME is omitted or nil, use the selected frame.")
3768 (face, frame)
3769 Lisp_Object face, frame;
3770{
3771 struct frame *f;
3772 Lisp_Object lface;
3773 int i;
3774
3775 if (NILP (frame))
3776 f = selected_frame;
3777 else
820 { 3778 {
821 to->stipple = from->stipple; 3779 CHECK_LIVE_FRAME (frame, 0);
822 to->pixmap_h = from->pixmap_h; 3780 f = XFRAME (frame);
823 to->pixmap_w = from->pixmap_w;
824 } 3781 }
825 if (from->underline) 3782
826 to->underline = from->underline; 3783 if (EQ (frame, Qt))
3784 lface = lface_from_face_name (NULL, face, 1);
3785 else
3786 lface = lface_from_face_name (f, face, 1);
3787
3788 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
3789 if (!UNSPECIFIEDP (XVECTOR (lface)->contents[i]))
3790 break;
3791
3792 return i == LFACE_VECTOR_SIZE ? Qt : Qnil;
827} 3793}
828 3794
829/* Set up the basic set of facial parameters, based on the frame's 3795
830 data; all faces are deltas applied to this. */ 3796DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
3797 0, 1, 0,
3798 "Return an alist of frame-local faces defined on FRAME.\n\
3799For internal use only.")
3800 (frame)
3801 Lisp_Object frame;
3802{
3803 struct frame *f = frame_or_selected_frame (frame, 0);
3804 return f->face_alist;
3805}
3806
3807
3808/* Return a hash code for Lisp string STRING with case ignored. Used
3809 below in computing a hash value for a Lisp face. */
3810
3811static INLINE unsigned
3812hash_string_case_insensitive (string)
3813 Lisp_Object string;
3814{
3815 unsigned char *s;
3816 unsigned hash = 0;
3817 xassert (STRINGP (string));
3818 for (s = XSTRING (string)->data; *s; ++s)
3819 hash = (hash << 1) ^ tolower (*s);
3820 return hash;
3821}
3822
3823
3824/* Return a hash code for face attribute vector V. */
3825
3826static INLINE unsigned
3827lface_hash (v)
3828 Lisp_Object *v;
3829{
3830 return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX])
3831 ^ hash_string_case_insensitive (v[LFACE_FOREGROUND_INDEX])
3832 ^ hash_string_case_insensitive (v[LFACE_BACKGROUND_INDEX])
3833 ^ (unsigned) v[LFACE_WEIGHT_INDEX]
3834 ^ (unsigned) v[LFACE_SLANT_INDEX]
3835 ^ (unsigned) v[LFACE_SWIDTH_INDEX]
3836 ^ XFASTINT (v[LFACE_HEIGHT_INDEX]));
3837}
3838
3839
3840/* Return non-zero if LFACE1 and LFACE2 specify the same font (without
3841 considering charsets/registries). They do if they specify the same
3842 family, point size, weight, width and slant. Both LFACE1 and
3843 LFACE2 must be fully-specified. */
3844
3845static INLINE int
3846lface_same_font_attributes_p (lface1, lface2)
3847 Lisp_Object *lface1, *lface2;
3848{
3849 xassert (lface_fully_specified_p (lface1)
3850 && lface_fully_specified_p (lface2));
3851 return (xstricmp (XSTRING (lface1[LFACE_FAMILY_INDEX])->data,
3852 XSTRING (lface2[LFACE_FAMILY_INDEX])->data) == 0
3853 && (XFASTINT (lface1[LFACE_HEIGHT_INDEX])
3854 == XFASTINT (lface2[LFACE_HEIGHT_INDEX]))
3855 && EQ (lface1[LFACE_SWIDTH_INDEX], lface2[LFACE_SWIDTH_INDEX])
3856 && EQ (lface1[LFACE_WEIGHT_INDEX], lface2[LFACE_WEIGHT_INDEX])
3857 && EQ (lface1[LFACE_SLANT_INDEX], lface2[LFACE_SLANT_INDEX]));
3858}
3859
3860
3861
3862/***********************************************************************
3863 Realized Faces
3864 ***********************************************************************/
3865
3866/* Allocate and return a new realized face for Lisp face attribute
3867 vector ATTR, charset CHARSET, and registry REGISTRY. */
3868
3869static struct face *
3870make_realized_face (attr, charset, registry)
3871 Lisp_Object *attr;
3872 int charset;
3873 Lisp_Object registry;
3874{
3875 struct face *face = (struct face *) xmalloc (sizeof *face);
3876 bzero (face, sizeof *face);
3877 face->charset = charset;
3878 face->registry = registry;
3879 bcopy (attr, face->lface, sizeof face->lface);
3880 return face;
3881}
3882
3883
3884/* Free realized face FACE, including its X resources. FACE may
3885 be null. */
831 3886
832static void 3887static void
833compute_base_face (f, face) 3888free_realized_face (f, face)
834 FRAME_PTR f; 3889 struct frame *f;
835 struct face *face; 3890 struct face *face;
836{ 3891{
837 face->gc = 0; 3892 if (face)
838 face->foreground = FRAME_FOREGROUND_PIXEL (f); 3893 {
839 face->background = FRAME_BACKGROUND_PIXEL (f); 3894#ifdef HAVE_X_WINDOWS
840 face->font = FRAME_FONT (f); 3895 if (FRAME_X_P (f))
841 face->fontset = -1; 3896 {
842 face->stipple = 0; 3897 if (face->gc)
843 face->underline = 0; 3898 {
3899 x_free_gc (f, face->gc);
3900 face->gc = 0;
3901 }
3902
3903 free_face_colors (f, face);
3904 x_destroy_bitmap (f, face->stipple);
3905 }
3906#endif /* HAVE_X_WINDOWS */
3907
3908 xfree (face);
3909 }
844} 3910}
845 3911
846/* Return the face ID to use to display a special glyph which selects
847 FACE_CODE as the face ID, assuming that ordinarily the face would
848 be CURRENT_FACE. F is the frame. */
849 3912
850int 3913/* Prepare face FACE for subsequent display on frame F. This
851compute_glyph_face (f, face_code, current_face) 3914 allocated GCs if they haven't been allocated yet or have been freed
3915 by clearing the face cache. */
3916
3917void
3918prepare_face_for_display (f, face)
852 struct frame *f; 3919 struct frame *f;
853 int face_code, current_face; 3920 struct face *face;
854{ 3921{
855 struct face face; 3922#ifdef HAVE_X_WINDOWS
3923 xassert (FRAME_X_P (f));
3924
3925 if (face->gc == 0)
3926 {
3927 XGCValues xgcv;
3928 unsigned long mask = GCForeground | GCBackground | GCGraphicsExposures;
3929
3930 xgcv.foreground = face->foreground;
3931 xgcv.background = face->background;
3932 xgcv.graphics_exposures = False;
856 3933
857 face = *FRAME_COMPUTED_FACES (f)[current_face]; 3934 /* The font of FACE may be null if we couldn't load it. */
3935 if (face->font)
3936 {
3937 xgcv.font = face->font->fid;
3938 mask |= GCFont;
3939 }
858 3940
859 if (face_code >= 0 && face_code < FRAME_N_PARAM_FACES (f) 3941 BLOCK_INPUT;
860 && FRAME_PARAM_FACES (f) [face_code] != 0) 3942 if (face->stipple)
861 merge_faces (FRAME_PARAM_FACES (f) [face_code], &face); 3943 {
3944 xgcv.fill_style = FillStippled;
3945 xgcv.stipple = x_bitmap_pixmap (f, face->stipple);
3946 mask |= GCFillStyle | GCStipple;
3947 }
862 3948
863 return intern_computed_face (f, &face); 3949 face->gc = x_create_gc (f, mask, &xgcv);
3950 UNBLOCK_INPUT;
3951 }
3952#endif
864} 3953}
865 3954
866/* Return the face ID to use to display a special glyph which selects 3955
867 FACE_CODE as the face ID, assuming that ordinarily the face would 3956/* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
868 be CURRENT_FACE. F is the frame. */ 3957 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
3958 ISO8859-1 if the ASCII face suffices. */
869 3959
870int 3960int
871compute_glyph_face_1 (f, face_name, current_face) 3961face_suitable_for_iso8859_1_p (face)
3962 struct face *face;
3963{
3964 int len = strlen (face->font_name);
3965 return len >= 9 && xstricmp (face->font_name + len - 9, "iso8859-1") == 0;
3966}
3967
3968
3969/* Value is non-zero if FACE is suitable for displaying characters
3970 of CHARSET. CHARSET < 0 means unibyte text. */
3971
3972INLINE int
3973face_suitable_for_charset_p (face, charset)
3974 struct face *face;
3975 int charset;
3976{
3977 int suitable_p = 0;
3978
3979 if (charset < 0)
3980 {
3981 if (EQ (face->registry, Vface_default_registry)
3982 || !NILP (Fequal (face->registry, Vface_default_registry)))
3983 suitable_p = 1;
3984 }
3985 else if (face->charset == charset)
3986 suitable_p = 1;
3987 else if (face->charset == CHARSET_ASCII
3988 && charset == charset_latin_iso8859_1)
3989 suitable_p = face_suitable_for_iso8859_1_p (face);
3990 else if (face->charset == charset_latin_iso8859_1
3991 && charset == CHARSET_ASCII)
3992 suitable_p = 1;
3993
3994 return suitable_p;
3995}
3996
3997
3998
3999/***********************************************************************
4000 Face Cache
4001 ***********************************************************************/
4002
4003/* Return a new face cache for frame F. */
4004
4005static struct face_cache *
4006make_face_cache (f)
872 struct frame *f; 4007 struct frame *f;
873 Lisp_Object face_name;
874 int current_face;
875{ 4008{
876 struct face face; 4009 struct face_cache *c;
4010 int size;
4011
4012 c = (struct face_cache *) xmalloc (sizeof *c);
4013 bzero (c, sizeof *c);
4014 size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
4015 c->buckets = (struct face **) xmalloc (size);
4016 bzero (c->buckets, size);
4017 c->size = 50;
4018 c->faces_by_id = (struct face **) xmalloc (c->size * sizeof *c->faces_by_id);
4019 c->f = f;
4020 return c;
4021}
4022
877 4023
878 face = *FRAME_COMPUTED_FACES (f)[current_face]; 4024/* Clear out all graphics contexts for all realized faces, except for
4025 the basic faces. This should be done from time to time just to avoid
4026 keeping too many graphics contexts that are no longer needed. */
879 4027
880 if (!NILP (face_name)) 4028static void
4029clear_face_gcs (c)
4030 struct face_cache *c;
4031{
4032 if (c && FRAME_X_P (c->f))
881 { 4033 {
882 int facecode = face_name_id_number (f, face_name); 4034#ifdef HAVE_X_WINDOWS
883 if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) 4035 int i;
884 && FRAME_PARAM_FACES (f) [facecode] != 0) 4036 for (i = BASIC_FACE_ID_SENTINEL; i < c->used; ++i)
885 merge_faces (FRAME_PARAM_FACES (f) [facecode], &face); 4037 {
4038 struct face *face = c->faces_by_id[i];
4039 if (face && face->gc)
4040 {
4041 x_free_gc (c->f, face->gc);
4042 face->gc = 0;
4043 }
4044 }
4045#endif /* HAVE_X_WINDOWS */
886 } 4046 }
4047}
887 4048
888 return intern_computed_face (f, &face); 4049
4050/* Free all realized faces in face cache C, including basic faces. C
4051 may be null. If faces are freed, make sure the frame's current
4052 matrix is marked invalid, so that a display caused by an expose
4053 event doesn't try to use faces we destroyed. */
4054
4055static void
4056free_realized_faces (c)
4057 struct face_cache *c;
4058{
4059 if (c && c->used)
4060 {
4061 int i, size;
4062 struct frame *f = c->f;
4063
4064 for (i = 0; i < c->used; ++i)
4065 {
4066 free_realized_face (f, c->faces_by_id[i]);
4067 c->faces_by_id[i] = NULL;
4068 }
4069
4070 c->used = 0;
4071 size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
4072 bzero (c->buckets, size);
4073
4074 /* Must do a thorough redisplay the next time. Mark current
4075 matrices as invalid because they will reference faces freed
4076 above. This function is also called when a frame is
4077 destroyed. In this case, the root window of F is nil. */
4078 if (WINDOWP (f->root_window))
4079 {
4080 clear_current_matrices (f);
4081 ++windows_or_buffers_changed;
4082 }
4083 }
889} 4084}
890
891/* Return the face ID associated with a buffer position POS.
892 Store into *ENDPTR the position at which a different face is needed.
893 This does not take account of glyphs that specify their own face codes.
894 F is the frame in use for display, and W is a window displaying
895 the current buffer.
896 4085
897 REGION_BEG, REGION_END delimit the region, so it can be highlighted.
898 4086
899 LIMIT is a position not to scan beyond. That is to limit 4087/* Free all realized faces on FRAME or on all frames if FRAME is nil.
900 the time this function can take. 4088 This is done after attributes of a named face have been changed,
4089 because we can't tell which realized faces depend on that face. */
901 4090
902 If MOUSE is nonzero, use the character's mouse-face, not its face. */ 4091void
4092free_all_realized_faces (frame)
4093 Lisp_Object frame;
4094{
4095 if (NILP (frame))
4096 {
4097 Lisp_Object rest;
4098 FOR_EACH_FRAME (rest, frame)
4099 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame)));
4100 }
4101 else
4102 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame)));
4103}
903 4104
904int 4105
905compute_char_face (f, w, pos, region_beg, region_end, endptr, limit, mouse) 4106/* Free face cache C and faces in it, including their X resources. */
906 struct frame *f; 4107
907 struct window *w; 4108static void
908 int pos; 4109free_face_cache (c)
909 int region_beg, region_end; 4110 struct face_cache *c;
910 int *endptr;
911 int limit;
912 int mouse;
913{ 4111{
914 struct face face; 4112 if (c)
915 Lisp_Object prop, position; 4113 {
916 int i, j, noverlays; 4114 free_realized_faces (c);
917 int facecode; 4115 xfree (c->buckets);
918 Lisp_Object *overlay_vec; 4116 xfree (c->faces_by_id);
919 Lisp_Object frame; 4117 xfree (c);
920 int endpos; 4118 }
921 Lisp_Object propname; 4119}
922 4120
923 /* W must display the current buffer. We could write this function
924 to use the frame and buffer of W, but right now it doesn't. */
925 if (XBUFFER (w->buffer) != current_buffer)
926 abort ();
927 4121
928 XSETFRAME (frame, f); 4122/* Cache realized face FACE in face cache C. HASH is the hash value
4123 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4124 collision list of the face hash table of C. This is done because
4125 otherwise lookup_face would find FACE for every charset, even if
4126 faces with the same attributes but for specific charsets exist. */
929 4127
930 endpos = ZV; 4128static void
931 if (pos < region_beg && region_beg < endpos) 4129cache_face (c, face, hash)
932 endpos = region_beg; 4130 struct face_cache *c;
4131 struct face *face;
4132 unsigned hash;
4133{
4134 int i = hash % FACE_CACHE_BUCKETS_SIZE;
933 4135
934 XSETFASTINT (position, pos); 4136 face->hash = hash;
935 4137
936 if (mouse) 4138 if (face->fontset >= 0)
937 propname = Qmouse_face; 4139 {
4140 struct face *last = c->buckets[i];
4141 if (last)
4142 {
4143 while (last->next)
4144 last = last->next;
4145 last->next = face;
4146 face->prev = last;
4147 face->next = NULL;
4148 }
4149 else
4150 {
4151 c->buckets[i] = face;
4152 face->prev = face->next = NULL;
4153 }
4154 }
938 else 4155 else
939 propname = Qface; 4156 {
4157 face->prev = NULL;
4158 face->next = c->buckets[i];
4159 if (face->next)
4160 face->next->prev = face;
4161 c->buckets[i] = face;
4162 }
940 4163
941 prop = Fget_text_property (position, propname, w->buffer); 4164 /* Find a free slot in C->faces_by_id and use the index of the free
4165 slot as FACE->id. */
4166 for (i = 0; i < c->used; ++i)
4167 if (c->faces_by_id[i] == NULL)
4168 break;
4169 face->id = i;
4170
4171 /* Maybe enlarge C->faces_by_id. */
4172 if (i == c->used && c->used == c->size)
4173 {
4174 int new_size = 2 * c->size;
4175 int sz = new_size * sizeof *c->faces_by_id;
4176 c->faces_by_id = (struct face **) xrealloc (c->faces_by_id, sz);
4177 c->size = new_size;
4178 }
942 4179
4180#if GLYPH_DEBUG
4181 /* Check that FACE got a unique id. */
943 { 4182 {
944 Lisp_Object limit1, end; 4183 int j, n;
4184 struct face *face;
4185
4186 for (j = n = 0; j < FACE_CACHE_BUCKETS_SIZE; ++j)
4187 for (face = c->buckets[j]; face; face = face->next)
4188 if (face->id == i)
4189 ++n;
945 4190
946 XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); 4191 xassert (n == 1);
947 end = Fnext_single_property_change (position, propname, w->buffer, limit1);
948 if (INTEGERP (end))
949 endpos = XINT (end);
950 } 4192 }
4193#endif /* GLYPH_DEBUG */
4194
4195 c->faces_by_id[i] = face;
4196 if (i == c->used)
4197 ++c->used;
4198}
951 4199
952 {
953 int next_overlay;
954 int len;
955 4200
956 /* First try with room for 40 overlays. */ 4201/* Remove face FACE from cache C. */
957 len = 40;
958 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
959
960 noverlays = overlays_at (pos, 0, &overlay_vec, &len,
961 &next_overlay, (int *) 0);
962 4202
963 /* If there are more than 40, 4203static void
964 make enough space for all, and try again. */ 4204uncache_face (c, face)
965 if (noverlays > len) 4205 struct face_cache *c;
966 { 4206 struct face *face;
967 len = noverlays; 4207{
968 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); 4208 int i = face->hash % FACE_CACHE_BUCKETS_SIZE;
969 noverlays = overlays_at (pos, 0, &overlay_vec, &len, 4209
970 &next_overlay, (int *) 0); 4210 if (face->prev)
971 } 4211 face->prev->next = face->next;
4212 else
4213 c->buckets[i] = face->next;
4214
4215 if (face->next)
4216 face->next->prev = face->prev;
4217
4218 c->faces_by_id[face->id] = NULL;
4219 if (face->id == c->used)
4220 --c->used;
4221}
972 4222
973 if (next_overlay < endpos)
974 endpos = next_overlay;
975 }
976 4223
977 *endptr = endpos; 4224/* Look up a realized face with face attributes ATTR in the face cache
4225 of frame F. The face will be used to display characters of
4226 CHARSET. CHARSET < 0 means the face will be used to display
4227 unibyte text. The value of face-default-registry is used to choose
4228 a font for the face in that case. Value is the ID of the face
4229 found. If no suitable face is found, realize a new one. */
978 4230
979 /* Optimize the default case. */ 4231INLINE int
980 if (noverlays == 0 && NILP (prop) 4232lookup_face (f, attr, charset)
981 && !(pos >= region_beg && pos < region_end)) 4233 struct frame *f;
982 return 0; 4234 Lisp_Object *attr;
4235 int charset;
4236{
4237 struct face_cache *c = FRAME_FACE_CACHE (f);
4238 unsigned hash;
4239 int i;
4240 struct face *face;
983 4241
984 compute_base_face (f, &face); 4242 xassert (c != NULL);
4243 check_lface_attrs (attr);
985 4244
986 merge_face_list (f, &face, prop); 4245 /* Look up ATTR in the face cache. */
4246 hash = lface_hash (attr);
4247 i = hash % FACE_CACHE_BUCKETS_SIZE;
4248
4249 for (face = c->buckets[i]; face; face = face->next)
4250 if (face->hash == hash
4251 && (FRAME_TERMCAP_P (f)
4252 || FACE_SUITABLE_FOR_CHARSET_P (face, charset))
4253 && lface_equal_p (face->lface, attr))
4254 break;
4255
4256 /* If not found, realize a new face. */
4257 if (face == NULL)
4258 {
4259 face = realize_face (c, attr, charset);
4260 cache_face (c, face, hash);
4261 }
987 4262
988 noverlays = sort_overlays (overlay_vec, noverlays, w); 4263#if GLYPH_DEBUG
4264 xassert (face == FACE_FROM_ID (f, face->id));
4265 if (FRAME_X_P (f))
4266 xassert (charset < 0 || FACE_SUITABLE_FOR_CHARSET_P (face, charset));
4267#endif /* GLYPH_DEBUG */
4268
4269 return face->id;
4270}
989 4271
990 /* Now merge the overlay data in that order. */ 4272
991 for (i = 0; i < noverlays; i++) 4273/* Return the face id of the realized face for named face SYMBOL on
4274 frame F suitable for displaying characters from CHARSET. CHARSET <
4275 0 means unibyte text. */
4276
4277int
4278lookup_named_face (f, symbol, charset)
4279 struct frame *f;
4280 Lisp_Object symbol;
4281 int charset;
4282{
4283 Lisp_Object attrs[LFACE_VECTOR_SIZE];
4284 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
4285 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4286
4287 get_lface_attributes (f, symbol, symbol_attrs, 1);
4288 bcopy (default_face->lface, attrs, sizeof attrs);
4289 merge_face_vectors (symbol_attrs, attrs);
4290 return lookup_face (f, attrs, charset);
4291}
4292
4293
4294/* Return the ID of the realized ASCII face of Lisp face with ID
4295 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4296
4297int
4298ascii_face_of_lisp_face (f, lface_id)
4299 struct frame *f;
4300 int lface_id;
4301{
4302 int face_id;
4303
4304 if (lface_id >= 0 && lface_id < lface_id_to_name_size)
992 { 4305 {
993 Lisp_Object oend; 4306 Lisp_Object face_name = lface_id_to_name[lface_id];
994 int oendpos; 4307 face_id = lookup_named_face (f, face_name, CHARSET_ASCII);
4308 }
4309 else
4310 face_id = -1;
995 4311
996 prop = Foverlay_get (overlay_vec[i], propname); 4312 return face_id;
997 merge_face_list (f, &face, prop); 4313}
998 4314
999 oend = OVERLAY_END (overlay_vec[i]); 4315
1000 oendpos = OVERLAY_POSITION (oend); 4316/* Return a face for charset ASCII that is like the face with id
1001 if (oendpos < endpos) 4317 FACE_ID on frame F, but has a font that is STEPS steps smaller.
1002 endpos = oendpos; 4318 STEPS < 0 means larger. Value is the id of the face. */
4319
4320int
4321smaller_face (f, face_id, steps)
4322 struct frame *f;
4323 int face_id, steps;
4324 {
4325#ifdef HAVE_X_WINDOWS
4326 struct face *face;
4327 Lisp_Object attrs[LFACE_VECTOR_SIZE];
4328 int pt, last_pt, last_height;
4329 int delta;
4330 int new_face_id;
4331 struct face *new_face;
4332
4333 /* If not called for an X frame, just return the original face. */
4334 if (FRAME_TERMCAP_P (f))
4335 return face_id;
4336
4337 /* Try in increments of 1/2 pt. */
4338 delta = steps < 0 ? 5 : -5;
4339 steps = abs (steps);
4340
4341 face = FACE_FROM_ID (f, face_id);
4342 bcopy (face->lface, attrs, sizeof attrs);
4343 pt = last_pt = XFASTINT (attrs[LFACE_HEIGHT_INDEX]);
4344 new_face_id = face_id;
4345 last_height = FONT_HEIGHT (face->font);
4346
4347 while (steps
4348 && pt + delta > 0
4349 /* Give up if we cannot find a font within 10pt. */
4350 && abs (last_pt - pt) < 100)
4351 {
4352 /* Look up a face for a slightly smaller/larger font. */
4353 pt += delta;
4354 attrs[LFACE_HEIGHT_INDEX] = make_number (pt);
4355 new_face_id = lookup_face (f, attrs, CHARSET_ASCII);
4356 new_face = FACE_FROM_ID (f, new_face_id);
4357
4358 /* If height changes, count that as one step. */
4359 if (FONT_HEIGHT (new_face->font) != last_height)
4360 {
4361 --steps;
4362 last_height = FONT_HEIGHT (new_face->font);
4363 last_pt = pt;
4364 }
1003 } 4365 }
1004 4366
1005 if (pos >= region_beg && pos < region_end) 4367 return new_face_id;
4368
4369#else /* not HAVE_X_WINDOWS */
4370
4371 return face_id;
4372
4373#endif /* not HAVE_X_WINDOWS */
4374}
4375
4376
4377/* Return a face for charset ASCII that is like the face with id
4378 FACE_ID on frame F, but has height HEIGHT. */
4379
4380int
4381face_with_height (f, face_id, height)
4382 struct frame *f;
4383 int face_id;
4384 int height;
4385{
4386#ifdef HAVE_X_WINDOWS
4387 struct face *face;
4388 Lisp_Object attrs[LFACE_VECTOR_SIZE];
4389
4390 if (FRAME_TERMCAP_P (f)
4391 || height <= 0)
4392 return face_id;
4393
4394 face = FACE_FROM_ID (f, face_id);
4395 bcopy (face->lface, attrs, sizeof attrs);
4396 attrs[LFACE_HEIGHT_INDEX] = make_number (height);
4397 face_id = lookup_face (f, attrs, CHARSET_ASCII);
4398#endif /* HAVE_X_WINDOWS */
4399
4400 return face_id;
4401}
4402
4403
4404
4405/***********************************************************************
4406 Font selection
4407 ***********************************************************************/
4408
4409DEFUN ("internal-set-font-selection-order",
4410 Finternal_set_font_selection_order,
4411 Sinternal_set_font_selection_order, 1, 1, 0,
4412 "Set font selection order for face font selection to ORDER.\n\
4413ORDER must be a list of length 4 containing the symbols `:width',\n\
4414`:height', `:weight', and `:slant'. Face attributes appearing\n\
4415first in ORDER are matched first, e.g. if `:height' appears before\n\
4416`:weight' in ORDER, font selection first tries to find a font with\n\
4417a suitable height, and then tries to match the font weight.\n\
4418Value is ORDER.")
4419 (order)
4420 Lisp_Object order;
4421{
4422 Lisp_Object list;
4423 int i;
4424 int indices[4];
4425
4426 CHECK_LIST (order, 0);
4427 bzero (indices, sizeof indices);
4428 i = 0;
4429
4430 for (list = order;
4431 CONSP (list) && i < DIM (indices);
4432 list = XCDR (list), ++i)
1006 { 4433 {
1007 if (region_end < endpos) 4434 Lisp_Object attr = XCAR (list);
1008 endpos = region_end; 4435 int xlfd;
1009 if (region_face >= 0 && region_face < next_face_id) 4436
1010 merge_faces (FRAME_PARAM_FACES (f)[region_face], &face); 4437 if (EQ (attr, QCwidth))
4438 xlfd = XLFD_SWIDTH;
4439 else if (EQ (attr, QCheight))
4440 xlfd = XLFD_POINT_SIZE;
4441 else if (EQ (attr, QCweight))
4442 xlfd = XLFD_WEIGHT;
4443 else if (EQ (attr, QCslant))
4444 xlfd = XLFD_SLANT;
4445 else
4446 break;
4447
4448 if (indices[i] != 0)
4449 break;
4450 indices[i] = xlfd;
1011 } 4451 }
1012 4452
1013 *endptr = endpos; 4453 if (!NILP (list)
4454 || i != DIM (indices)
4455 || indices[0] == 0
4456 || indices[1] == 0
4457 || indices[2] == 0
4458 || indices[3] == 0)
4459 signal_error ("Invalid font sort order", order);
1014 4460
1015 return intern_computed_face (f, &face); 4461 if (bcmp (indices, font_sort_order, sizeof indices) != 0)
4462 {
4463 bcopy (indices, font_sort_order, sizeof font_sort_order);
4464 free_all_realized_faces (Qnil);
4465 }
4466
4467 return Qnil;
1016} 4468}
1017 4469
1018static void 4470
1019merge_face_list (f, face, prop) 4471DEFUN ("internal-set-alternative-font-family-alist",
1020 FRAME_PTR f; 4472 Finternal_set_alternative_font_family_alist,
1021 struct face *face; 4473 Sinternal_set_alternative_font_family_alist, 1, 1, 0,
1022 Lisp_Object prop; 4474 "Define alternative font families to try in face font selection.\n\
4475ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
4476Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
4477be found. Value is ALIST.")
4478 (alist)
4479 Lisp_Object alist;
4480{
4481 CHECK_LIST (alist, 0);
4482 Vface_alternative_font_family_alist = alist;
4483 free_all_realized_faces (Qnil);
4484 return alist;
4485}
4486
4487
4488#ifdef HAVE_X_WINDOWS
4489
4490/* Return the X registry and encoding of font name FONT_NAME on frame F.
4491 Value is nil if not successful. */
4492
4493static Lisp_Object
4494deduce_unibyte_registry (f, font_name)
4495 struct frame *f;
4496 char *font_name;
4497{
4498 struct font_name font;
4499 Lisp_Object registry = Qnil;
4500
4501 font.name = STRDUPA (font_name);
4502 if (split_font_name (f, &font, 0))
4503 {
4504 char *buffer;
4505
4506 /* Extract registry and encoding. */
4507 buffer = (char *) alloca (strlen (font.fields[XLFD_REGISTRY])
4508 + strlen (font.fields[XLFD_ENCODING])
4509 + 10);
4510 strcpy (buffer, font.fields[XLFD_REGISTRY]);
4511 strcat (buffer, "-");
4512 strcat (buffer, font.fields[XLFD_ENCODING]);
4513 registry = build_string (buffer);
4514 }
4515
4516 return registry;
4517}
4518
4519
4520/* Value is non-zero if FONT is the name of a scalable font. The
4521 X11R6 XLFD spec says that point size, pixel size, and average width
4522 are zero for scalable fonts. Intlfonts contain at least one
4523 scalable font ("*-muleindian-1") for which this isn't true, so we
4524 just test average width. */
4525
4526static int
4527font_scalable_p (font)
4528 struct font_name *font;
4529{
4530 char *s = font->fields[XLFD_AVGWIDTH];
4531 return *s == '0' && *(s + 1) == '\0';
4532}
4533
4534
4535/* Value is non-zero if FONT1 is a better match for font attributes
4536 VALUES than FONT2. VALUES is an array of face attribute values in
4537 font sort order. COMPARE_PT_P zero means don't compare point
4538 sizes. */
4539
4540static int
4541better_font_p (values, font1, font2, compare_pt_p)
4542 int *values;
4543 struct font_name *font1, *font2;
4544 int compare_pt_p;
4545{
4546 int i;
4547
4548 for (i = 0; i < 4; ++i)
4549 {
4550 int xlfd_idx = font_sort_order[i];
4551
4552 if (compare_pt_p || xlfd_idx != XLFD_POINT_SIZE)
4553 {
4554 int delta1 = abs (values[i] - font1->numeric[xlfd_idx]);
4555 int delta2 = abs (values[i] - font2->numeric[xlfd_idx]);
4556
4557 if (delta1 > delta2)
4558 return 0;
4559 else if (delta1 < delta2)
4560 return 1;
4561 else
4562 {
4563 /* The difference may be equal because, e.g., the face
4564 specifies `italic' but we have only `regular' and
4565 `oblique'. Prefer `oblique' in this case. */
4566 if ((xlfd_idx == XLFD_WEIGHT || xlfd_idx == XLFD_SLANT)
4567 && font1->numeric[xlfd_idx] > values[i]
4568 && font2->numeric[xlfd_idx] < values[i])
4569 return 1;
4570 }
4571 }
4572 }
4573
4574 return 0;
4575}
4576
4577
4578#if SCALABLE_FONTS
4579
4580/* Value is non-zero if FONT is an exact match for face attributes in
4581 SPECIFIED. SPECIFIED is an array of face attribute values in font
4582 sort order. */
4583
4584static int
4585exact_face_match_p (specified, font)
4586 int *specified;
4587 struct font_name *font;
1023{ 4588{
1024 Lisp_Object length; 4589 int i;
1025 int len; 4590
1026 Lisp_Object *faces; 4591 for (i = 0; i < 4; ++i)
1027 int j; 4592 if (specified[i] != font->numeric[font_sort_order[i]])
4593 break;
4594
4595 return i == 4;
4596}
4597
1028 4598
1029 if (CONSP (prop) 4599/* Value is the name of a scaled font, generated from scalable font
1030 && ! STRINGP (XCONS (prop)->cdr)) 4600 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
4601 Value is allocated from heap. */
4602
4603static char *
4604build_scalable_font_name (f, font, specified_pt)
4605 struct frame *f;
4606 struct font_name *font;
4607 int specified_pt;
4608{
4609 char point_size[20], pixel_size[20];
4610 int pixel_value;
4611 double resy = FRAME_X_DISPLAY_INFO (f)->resy;
4612 double pt;
4613
4614 /* If scalable font is for a specific resolution, compute
4615 the point size we must specify from the resolution of
4616 the display and the specified resolution of the font. */
4617 if (font->numeric[XLFD_RESY] != 0)
1031 { 4618 {
1032 /* We have a list of faces, merge them in reverse order. */ 4619 pt = resy / font->numeric[XLFD_RESY] * specified_pt + 0.5;
4620 pixel_value = font->numeric[XLFD_RESY] / 720.0 * pt;
4621 }
4622 else
4623 {
4624 pt = specified_pt;
4625 pixel_value = resy / 720.0 * pt;
4626 }
4627
4628 /* Set point size of the font. */
4629 sprintf (point_size, "%d", (int) pt);
4630 font->fields[XLFD_POINT_SIZE] = point_size;
4631 font->numeric[XLFD_POINT_SIZE] = pt;
4632
4633 /* Set pixel size. */
4634 sprintf (pixel_size, "%d", pixel_value);
4635 font->fields[XLFD_PIXEL_SIZE] = pixel_size;
4636 font->numeric[XLFD_PIXEL_SIZE] = pixel_value;
4637
4638 /* If font doesn't specify its resolution, use the
4639 resolution of the display. */
4640 if (font->numeric[XLFD_RESY] == 0)
4641 {
4642 char buffer[20];
4643 sprintf (buffer, "%d", (int) resy);
4644 font->fields[XLFD_RESY] = buffer;
4645 font->numeric[XLFD_RESY] = resy;
4646 }
4647
4648 if (strcmp (font->fields[XLFD_RESX], "0") == 0)
4649 {
4650 char buffer[20];
4651 int resx = FRAME_X_DISPLAY_INFO (f)->resx;
4652 sprintf (buffer, "%d", resx);
4653 font->fields[XLFD_RESX] = buffer;
4654 font->numeric[XLFD_RESX] = resx;
4655 }
4656
4657 return build_font_name (font);
4658}
1033 4659
1034 length = Fsafe_length (prop);
1035 len = XFASTINT (length);
1036 4660
1037 /* Put them into an array. */ 4661/* Value is non-zero if we are allowed to use scalable font FONT. We
1038 faces = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); 4662 can't run a Lisp function here since this function may be called
1039 for (j = 0; j < len; j++) 4663 with input blocked. */
4664
4665static int
4666may_use_scalable_font_p (font, name)
4667 struct font_name *font;
4668 char *name;
4669{
4670 if (EQ (Vscalable_fonts_allowed, Qt))
4671 return 1;
4672 else if (CONSP (Vscalable_fonts_allowed))
4673 {
4674 Lisp_Object tail, regexp;
4675
4676 for (tail = Vscalable_fonts_allowed; CONSP (tail); tail = XCDR (tail))
1040 { 4677 {
1041 faces[j] = Fcar (prop); 4678 regexp = XCAR (tail);
1042 prop = Fcdr (prop); 4679 if (STRINGP (regexp)
4680 && fast_c_string_match_ignore_case (regexp, name) >= 0)
4681 return 1;
1043 } 4682 }
1044 /* So that we can merge them in the reverse order. */
1045 } 4683 }
4684
4685 return 0;
4686}
4687
4688#endif /* SCALABLE_FONTS != 0 */
4689
4690
4691/* Return the name of the best matching font for face attributes
4692 ATTRS in the array of font_name structures FONTS which contains
4693 NFONTS elements. Value is a font name which is allocated from
4694 the heap. FONTS is freed by this function. */
4695
4696static char *
4697best_matching_font (f, attrs, fonts, nfonts)
4698 struct frame *f;
4699 Lisp_Object *attrs;
4700 struct font_name *fonts;
4701 int nfonts;
4702{
4703 char *font_name;
4704 struct font_name *best;
4705 int i, pt;
4706 int specified[4];
4707 int exact_p;
4708
4709 if (nfonts == 0)
4710 return NULL;
4711
4712 /* Make specified font attributes available in `specified',
4713 indexed by sort order. */
4714 for (i = 0; i < DIM (font_sort_order); ++i)
4715 {
4716 int xlfd_idx = font_sort_order[i];
4717
4718 if (xlfd_idx == XLFD_SWIDTH)
4719 specified[i] = face_numeric_swidth (attrs[LFACE_SWIDTH_INDEX]);
4720 else if (xlfd_idx == XLFD_POINT_SIZE)
4721 specified[i] = pt = XFASTINT (attrs[LFACE_HEIGHT_INDEX]);
4722 else if (xlfd_idx == XLFD_WEIGHT)
4723 specified[i] = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
4724 else if (xlfd_idx == XLFD_SLANT)
4725 specified[i] = face_numeric_slant (attrs[LFACE_SLANT_INDEX]);
4726 else
4727 abort ();
4728 }
4729
4730#if SCALABLE_FONTS
4731
4732 /* Set to 1 */
4733 exact_p = 0;
4734
4735 /* Start with the first non-scalable font in the list. */
4736 for (i = 0; i < nfonts; ++i)
4737 if (!font_scalable_p (fonts + i))
4738 break;
4739
4740 /* Find the best match among the non-scalable fonts. */
4741 if (i < nfonts)
4742 {
4743 best = fonts + i;
4744
4745 for (i = 1; i < nfonts; ++i)
4746 if (!font_scalable_p (fonts + i)
4747 && better_font_p (specified, fonts + i, best, 1))
4748 {
4749 best = fonts + i;
4750
4751 exact_p = exact_face_match_p (specified, best);
4752 if (exact_p)
4753 break;
4754 }
4755
4756 }
4757 else
4758 best = NULL;
4759
4760 /* Unless we found an exact match among non-scalable fonts, see if
4761 we can find a better match among scalable fonts. */
4762 if (!exact_p)
4763 {
4764 /* A scalable font is better if
4765
4766 1. its weight, slant, swidth attributes are better, or.
4767
4768 2. the best non-scalable font doesn't have the required
4769 point size, and the scalable fonts weight, slant, swidth
4770 isn't worse. */
4771
4772 int non_scalable_has_exact_height_p;
4773
4774 if (best && best->numeric[XLFD_POINT_SIZE] == pt)
4775 non_scalable_has_exact_height_p = 1;
4776 else
4777 non_scalable_has_exact_height_p = 0;
4778
4779 for (i = 0; i < nfonts; ++i)
4780 if (font_scalable_p (fonts + i))
4781 {
4782 if (best == NULL
4783 || better_font_p (specified, fonts + i, best, 0)
4784 || (!non_scalable_has_exact_height_p
4785 && !better_font_p (specified, best, fonts + i, 0)))
4786 best = fonts + i;
4787 }
4788 }
4789
4790 if (font_scalable_p (best))
4791 font_name = build_scalable_font_name (f, best, pt);
1046 else 4792 else
4793 font_name = build_font_name (best);
4794
4795#else /* !SCALABLE_FONTS */
4796
4797 /* Find the best non-scalable font. */
4798 best = fonts;
4799
4800 for (i = 1; i < nfonts; ++i)
1047 { 4801 {
1048 faces = (Lisp_Object *) alloca (sizeof (Lisp_Object)); 4802 xassert (!font_scalable_p (fonts + i));
1049 faces[0] = prop; 4803 if (better_font_p (specified, fonts + i, best, 1))
1050 len = 1; 4804 best = fonts + i;
1051 } 4805 }
4806
4807 font_name = build_font_name (best);
4808
4809#endif /* !SCALABLE_FONTS */
1052 4810
1053 for (j = len - 1; j >= 0; j--) 4811 /* Free font_name structures. */
4812 free_font_names (fonts, nfonts);
4813
4814 return font_name;
4815}
4816
4817
4818/* Try to get a list of fonts on frame F with font family FAMILY and
4819 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
4820 of font_name structures for the fonts matched. Value is the number
4821 of fonts found. */
4822
4823static int
4824try_font_list (f, attrs, pattern, family, registry, fonts)
4825 struct frame *f;
4826 Lisp_Object *attrs;
4827 char *pattern, *family, *registry;
4828 struct font_name **fonts;
4829{
4830 int nfonts;
4831
4832 if (family == NULL)
4833 family = LSTRDUPA (attrs[LFACE_FAMILY_INDEX]);
4834
4835 nfonts = font_list (f, pattern, family, registry, fonts);
4836
4837 if (nfonts == 0)
1054 { 4838 {
1055 if (CONSP (faces[j])) 4839 Lisp_Object alter;
4840
4841 /* Try alternative font families from
4842 Vface_alternative_font_family_alist. */
4843 alter = Fassoc (build_string (family),
4844 Vface_alternative_font_family_alist);
4845 if (CONSP (alter))
4846 for (alter = XCDR (alter);
4847 CONSP (alter) && nfonts == 0;
4848 alter = XCDR (alter))
4849 {
4850 if (STRINGP (XCAR (alter)))
4851 {
4852 family = LSTRDUPA (XCAR (alter));
4853 nfonts = font_list (f, NULL, family, registry, fonts);
4854 }
4855 }
4856
4857 /* Try font family of the default face or "fixed". */
4858 if (nfonts == 0)
1056 { 4859 {
1057 if (EQ (XCONS (faces[j])->car, Qbackground_color)) 4860 struct face *dflt = FACE_FROM_ID (f, DEFAULT_FACE_ID);
1058 face->background = load_color (f, XCONS (faces[j])->cdr); 4861 if (dflt)
1059 if (EQ (XCONS (faces[j])->car, Qforeground_color)) 4862 family = LSTRDUPA (dflt->lface[LFACE_FAMILY_INDEX]);
1060 face->foreground = load_color (f, XCONS (faces[j])->cdr); 4863 else
4864 family = "fixed";
4865 nfonts = font_list (f, NULL, family, registry, fonts);
1061 } 4866 }
4867
4868 /* Try any family with the given registry. */
4869 if (nfonts == 0)
4870 nfonts = font_list (f, NULL, "*", registry, fonts);
4871 }
4872
4873 return nfonts;
4874}
4875
4876
4877/* Return the registry and encoding pattern that fonts for CHARSET
4878 should match. Value is allocated from the heap. */
4879
4880char *
4881x_charset_registry (charset)
4882 int charset;
4883{
4884 Lisp_Object prop, charset_plist;
4885 char *registry;
4886
4887 /* Get registry and encoding from the charset's plist. */
4888 charset_plist = CHARSET_TABLE_INFO (charset, CHARSET_PLIST_IDX);
4889 prop = Fplist_get (charset_plist, Qx_charset_registry);
4890
4891 if (STRINGP (prop))
4892 {
4893 if (index (XSTRING (prop)->data, '-'))
4894 registry = xstrdup (XSTRING (prop)->data);
1062 else 4895 else
1063 { 4896 {
1064 int facecode = face_name_id_number (f, faces[j]); 4897 /* If registry doesn't contain a `-', make it a pattern. */
1065 if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) 4898 registry = (char *) xmalloc (STRING_BYTES (XSTRING (prop)) + 5);
1066 && FRAME_PARAM_FACES (f) [facecode] != 0) 4899 strcpy (registry, XSTRING (prop)->data);
1067 merge_faces (FRAME_PARAM_FACES (f) [facecode], face); 4900 strcat (registry, "*-*");
1068 } 4901 }
1069 } 4902 }
4903 else if (STRINGP (Vface_default_registry))
4904 registry = xstrdup (XSTRING (Vface_default_registry)->data);
4905 else
4906 registry = xstrdup ("iso8859-1");
4907
4908 return registry;
4909}
4910
4911
4912/* Return the fontset id of the fontset name or alias name given by
4913 the family attribute of ATTRS on frame F. Value is -1 if the
4914 family attribute of ATTRS doesn't name a fontset. */
4915
4916static int
4917face_fontset (f, attrs)
4918 struct frame *f;
4919 Lisp_Object *attrs;
4920{
4921 Lisp_Object name = attrs[LFACE_FAMILY_INDEX];
4922 int fontset;
4923
4924 name = Fquery_fontset (name, Qnil);
4925 if (NILP (name))
4926 fontset = -1;
4927 else
4928 fontset = fs_query_fontset (f, XSTRING (name)->data);
4929
4930 return fontset;
4931}
4932
4933
4934/* Get the font to use for the face realizing the fully-specified Lisp
4935 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
4936 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
4937 in this case. Value is the font name which is allocated from the
4938 heap (which means that it must be freed eventually). */
4939
4940static char *
4941choose_face_font (f, attrs, charset, unibyte_registry)
4942 struct frame *f;
4943 Lisp_Object *attrs;
4944 int charset;
4945 Lisp_Object unibyte_registry;
4946{
4947 struct font_name *fonts;
4948 int nfonts;
4949 char *registry;
4950
4951 /* ATTRS must be fully-specified. */
4952 xassert (lface_fully_specified_p (attrs));
4953
4954 if (STRINGP (unibyte_registry))
4955 registry = xstrdup (XSTRING (unibyte_registry)->data);
4956 else
4957 registry = x_charset_registry (charset);
4958
4959 nfonts = try_font_list (f, attrs, NULL, NULL, registry, &fonts);
4960 xfree (registry);
4961 return best_matching_font (f, attrs, fonts, nfonts);
4962}
4963
4964
4965/* Choose a font to use on frame F to display CHARSET using FONTSET
4966 with Lisp face attributes specified by ATTRS. CHARSET may be any
4967 valid charset except CHARSET_COMPOSITION. CHARSET < 0 means
4968 unibyte text. If the fontset doesn't contain a font pattern for
4969 charset, use the pattern for CHARSET_ASCII. Value is the font name
4970 which is allocated from the heap and must be freed by the caller. */
4971
4972static char *
4973choose_face_fontset_font (f, attrs, fontset, charset)
4974 struct frame *f;
4975 Lisp_Object *attrs;
4976 int fontset, charset;
4977{
4978 char *pattern;
4979 char *font_name = NULL;
4980 struct fontset_info *fontset_info;
4981 struct font_name *fonts;
4982 int nfonts;
4983
4984 xassert (charset != CHARSET_COMPOSITION);
4985 xassert (fontset >= 0 && fontset < FRAME_FONTSET_DATA (f)->n_fontsets);
4986
4987 /* For unibyte text, use the ASCII font of the fontset. Using the
4988 ASCII font seems to be the most reasonable thing we can do in
4989 this case. */
4990 if (charset < 0)
4991 charset = CHARSET_ASCII;
4992
4993 /* Get the font name pattern to use for CHARSET from the fontset. */
4994 fontset_info = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
4995 pattern = fontset_info->fontname[charset];
4996 if (!pattern)
4997 pattern = fontset_info->fontname[CHARSET_ASCII];
4998 xassert (pattern);
4999
5000 /* Get a list of fonts matching that pattern and choose the
5001 best match for the specified face attributes from it. */
5002 nfonts = try_font_list (f, attrs, pattern, NULL, NULL, &fonts);
5003 font_name = best_matching_font (f, attrs, fonts, nfonts);
5004 return font_name;
1070} 5005}
1071 5006
5007#endif /* HAVE_X_WINDOWS */
5008
5009
1072 5010
1073/* Recompute the GC's for the default and modeline faces. 5011/***********************************************************************
1074 We call this after changing frame parameters on which those GC's 5012 Face Realization
1075 depend. */ 5013 ***********************************************************************/
1076 5014
1077void 5015/* Realize basic faces on frame F. Value is zero if frame parameters
1078recompute_basic_faces (f) 5016 of F don't contain enough information needed to realize the default
1079 FRAME_PTR f; 5017 face. */
5018
5019static int
5020realize_basic_faces (f)
5021 struct frame *f;
1080{ 5022{
1081 /* If the frame's faces haven't been initialized yet, don't worry about 5023 int success_p = 0;
1082 this stuff. */ 5024
1083 if (FRAME_N_PARAM_FACES (f) < 2) 5025 if (realize_default_face (f))
1084 return; 5026 {
5027 realize_named_face (f, Qmodeline, MODE_LINE_FACE_ID);
5028 realize_named_face (f, Qtoolbar, TOOLBAR_FACE_ID);
5029 realize_named_face (f, Qbitmap_area, BITMAP_AREA_FACE_ID);
5030 realize_named_face (f, Qtop_line, TOP_LINE_FACE_ID);
5031 success_p = 1;
5032 }
1085 5033
1086 BLOCK_INPUT; 5034 return success_p;
5035}
5036
5037
5038/* Realize the default face on frame F. If the face is not fully
5039 specified, make it fully-specified. Attributes of the default face
5040 that are not explicitly specified are taken from frame parameters. */
5041
5042static int
5043realize_default_face (f)
5044 struct frame *f;
5045{
5046 struct face_cache *c = FRAME_FACE_CACHE (f);
5047 Lisp_Object lface;
5048 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5049 Lisp_Object unibyte_registry;
5050 Lisp_Object frame_font;
5051 struct face *face;
5052 int fontset;
1087 5053
1088 if (FRAME_DEFAULT_FACE (f)->gc) 5054 /* If the `default' face is not yet known, create it. */
5055 lface = lface_from_face_name (f, Qdefault, 0);
5056 if (NILP (lface))
1089 { 5057 {
1090 XFreeGC (FRAME_X_DISPLAY (f), FRAME_DEFAULT_FACE (f)->gc); 5058 Lisp_Object frame;
1091 XFreeGC (FRAME_X_DISPLAY (f), FRAME_DEFAULT_FACE (f)->non_ascii_gc); 5059 XSETFRAME (frame, f);
5060 lface = Finternal_make_lisp_face (Qdefault, frame);
1092 } 5061 }
1093 if (FRAME_MODE_LINE_FACE (f)->gc) 5062
5063#ifdef HAVE_X_WINDOWS
5064 if (FRAME_X_P (f))
1094 { 5065 {
1095 XFreeGC (FRAME_X_DISPLAY (f), FRAME_MODE_LINE_FACE (f)->gc); 5066 /* Set frame_font to the value of the `font' frame parameter. */
1096 XFreeGC (FRAME_X_DISPLAY (f), FRAME_MODE_LINE_FACE (f)->non_ascii_gc); 5067 frame_font = Fassq (Qfont, f->param_alist);
5068 xassert (CONSP (frame_font) && STRINGP (XCDR (frame_font)));
5069 frame_font = XCDR (frame_font);
5070
5071 fontset = fs_query_fontset (f, XSTRING (frame_font)->data);
5072 if (fontset >= 0)
5073 {
5074 /* If frame_font is a fontset name, don't use that for
5075 determining font-related attributes of the default face
5076 because it is just an artificial name. Use the ASCII font of
5077 the fontset, instead. */
5078 struct font_info *font_info;
5079 struct font_name font;
5080
5081 BLOCK_INPUT;
5082 font_info = FS_LOAD_FONT (f, FRAME_X_FONT_TABLE (f), CHARSET_ASCII,
5083 NULL, fontset);
5084 UNBLOCK_INPUT;
5085
5086 /* Set weight etc. from the ASCII font. */
5087 if (!set_lface_from_font_name (f, lface, font_info->full_name, 0))
5088 return 0;
5089
5090 /* Remember registry and encoding of the frame font. */
5091 unibyte_registry = deduce_unibyte_registry (f, font_info->full_name);
5092 if (STRINGP (unibyte_registry))
5093 Vface_default_registry = unibyte_registry;
5094 else
5095 Vface_default_registry = build_string ("iso8859-1");
5096
5097 /* But set the family to the fontset alias name. Implementation
5098 note: When a font is passed to Emacs via `-fn FONT', a
5099 fontset is created in `x-win.el' whose name ends in
5100 `fontset-startup'. This fontset has an alias name that is
5101 equal to frame_font. */
5102 xassert (STRINGP (frame_font));
5103 font.name = LSTRDUPA (frame_font);
5104
5105 if (!split_font_name (f, &font, 1)
5106 || xstricmp (font.fields[XLFD_REGISTRY], "fontset") != 0
5107 || xstricmp (font.fields[XLFD_ENCODING], "startup") != 0)
5108 LFACE_FAMILY (lface) = frame_font;
5109 }
5110 else
5111 {
5112 /* Frame parameters contain a real font. Fill default face
5113 attributes from that font. */
5114 if (!set_lface_from_font_name (f, lface,
5115 XSTRING (frame_font)->data, 0))
5116 return 0;
5117
5118 /* Remember registry and encoding of the frame font. */
5119 unibyte_registry
5120 = deduce_unibyte_registry (f, XSTRING (frame_font)->data);
5121 if (STRINGP (unibyte_registry))
5122 Vface_default_registry = unibyte_registry;
5123 else
5124 Vface_default_registry = build_string ("iso8859-1");
5125 }
1097 } 5126 }
1098 compute_base_face (f, FRAME_DEFAULT_FACE (f)); 5127#endif /* HAVE_X_WINDOWS */
1099 compute_base_face (f, FRAME_MODE_LINE_FACE (f));
1100 5128
1101 merge_faces (FRAME_DEFAULT_PARAM_FACE (f), FRAME_DEFAULT_FACE (f)); 5129 if (FRAME_TERMCAP_P (f))
1102 merge_faces (FRAME_MODE_LINE_PARAM_FACE (f), FRAME_MODE_LINE_FACE (f)); 5130 {
5131 LFACE_FAMILY (lface) = build_string ("default");
5132 LFACE_SWIDTH (lface) = Qnormal;
5133 LFACE_HEIGHT (lface) = make_number (1);
5134 LFACE_WEIGHT (lface) = Qnormal;
5135 LFACE_SLANT (lface) = Qnormal;
5136 }
5137
5138 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface)))
5139 LFACE_UNDERLINE (lface) = Qnil;
5140
5141 if (UNSPECIFIEDP (LFACE_OVERLINE (lface)))
5142 LFACE_OVERLINE (lface) = Qnil;
5143
5144 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface)))
5145 LFACE_STRIKE_THROUGH (lface) = Qnil;
5146
5147 if (UNSPECIFIEDP (LFACE_BOX (lface)))
5148 LFACE_BOX (lface) = Qnil;
5149
5150 if (UNSPECIFIEDP (LFACE_INVERSE (lface)))
5151 LFACE_INVERSE (lface) = Qnil;
5152
5153 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface)))
5154 {
5155 /* This function is called so early that colors are not yet
5156 set in the frame parameter list. */
5157 Lisp_Object color = Fassq (Qforeground_color, f->param_alist);
5158
5159 if (CONSP (color) && STRINGP (XCDR (color)))
5160 LFACE_FOREGROUND (lface) = XCDR (color);
5161 else if (FRAME_X_P (f))
5162 return 0;
5163 else if (FRAME_TERMCAP_P (f))
5164 /* Frame parameters for terminal frames usually don't contain
5165 a color. Use an empty string to indicate that the face
5166 should use the (unknown) default color of the terminal. */
5167 LFACE_FOREGROUND (lface) = build_string ("");
5168 else
5169 abort ();
5170 }
1103 5171
1104 intern_face (f, FRAME_DEFAULT_FACE (f)); 5172 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface)))
1105 intern_face (f, FRAME_MODE_LINE_FACE (f)); 5173 {
5174 /* This function is called so early that colors are not yet
5175 set in the frame parameter list. */
5176 Lisp_Object color = Fassq (Qbackground_color, f->param_alist);
5177 if (CONSP (color) && STRINGP (XCDR (color)))
5178 LFACE_BACKGROUND (lface) = XCDR (color);
5179 else if (FRAME_X_P (f))
5180 return 0;
5181 else if (FRAME_TERMCAP_P (f))
5182 /* Frame parameters for terminal frames usually don't contain
5183 a color. Use an empty string to indicate that the face
5184 should use the (unknown) default color of the terminal. */
5185 LFACE_BACKGROUND (lface) = build_string ("");
5186 else
5187 abort ();
5188 }
5189
5190 if (UNSPECIFIEDP (LFACE_STIPPLE (lface)))
5191 LFACE_STIPPLE (lface) = Qnil;
1106 5192
1107 UNBLOCK_INPUT; 5193 /* Realize the face; it must be fully-specified now. */
5194 xassert (lface_fully_specified_p (XVECTOR (lface)->contents));
5195 check_lface (lface);
5196 bcopy (XVECTOR (lface)->contents, attrs, sizeof attrs);
5197 face = realize_face (c, attrs, CHARSET_ASCII);
5198
5199 /* Remove the former default face. */
5200 if (c->used > DEFAULT_FACE_ID)
5201 {
5202 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5203 uncache_face (c, default_face);
5204 free_realized_face (f, default_face);
5205 }
5206
5207 /* Insert the new default face. */
5208 cache_face (c, face, lface_hash (attrs));
5209 xassert (face->id == DEFAULT_FACE_ID);
5210 return 1;
1108} 5211}
1109 5212
1110 5213
1111 5214/* Realize basic faces other than the default face in face cache C.
1112/* Lisp interface. */ 5215 SYMBOL is the face name, ID is the face id the realized face must
5216 have. The default face must have been realized already. */
1113 5217
1114DEFUN ("make-face-internal", Fmake_face_internal, Smake_face_internal, 1, 1, 0, 5218static void
1115 "Create face number FACE-ID on all frames.") 5219realize_named_face (f, symbol, id)
1116 (face_id) 5220 struct frame *f;
1117 Lisp_Object face_id; 5221 Lisp_Object symbol;
5222 int id;
1118{ 5223{
1119 Lisp_Object rest, frame; 5224 struct face_cache *c = FRAME_FACE_CACHE (f);
1120 int id = XINT (face_id); 5225 Lisp_Object lface = lface_from_face_name (f, symbol, 0);
5226 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5227 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
5228 struct face *new_face;
5229
5230 /* The default face must exist and be fully specified. */
5231 get_lface_attributes (f, Qdefault, attrs, 1);
5232 check_lface_attrs (attrs);
5233 xassert (lface_fully_specified_p (attrs));
5234
5235 /* If SYMBOL isn't know as a face, create it. */
5236 if (NILP (lface))
5237 {
5238 Lisp_Object frame;
5239 XSETFRAME (frame, f);
5240 lface = Finternal_make_lisp_face (symbol, frame);
5241 }
1121 5242
1122 CHECK_NUMBER (face_id, 0); 5243 /* Merge SYMBOL's face with the default face. */
1123 if (id < 0 || id >= next_face_id) 5244 get_lface_attributes (f, symbol, symbol_attrs, 1);
1124 error ("Face id out of range"); 5245 merge_face_vectors (symbol_attrs, attrs);
1125 5246
1126 FOR_EACH_FRAME (rest, frame) 5247 /* Realize the face. */
5248 new_face = realize_face (c, attrs, CHARSET_ASCII);
5249
5250 /* Remove the former face. */
5251 if (c->used > id)
1127 { 5252 {
1128 if (FRAME_MSDOS_P (XFRAME (frame)) || FRAME_X_P (XFRAME (frame))) 5253 struct face *old_face = c->faces_by_id[id];
1129 ensure_face_ready (XFRAME (frame), id); 5254 uncache_face (c, old_face);
5255 free_realized_face (f, old_face);
1130 } 5256 }
1131 return Qnil; 5257
5258 /* Insert the new face. */
5259 cache_face (c, new_face, lface_hash (attrs));
5260 xassert (new_face->id == id);
1132} 5261}
1133 5262
1134 5263
1135DEFUN ("set-face-attribute-internal", Fset_face_attribute_internal, 5264/* Realize the fully-specified face with attributes ATTRS in face
1136 Sset_face_attribute_internal, 4, 4, 0, "") 5265 cache C for character set CHARSET or for unibyte text if CHARSET <
1137 (face_id, attr_name, attr_value, frame) 5266 0. Value is a pointer to the newly created realized face. */
1138 Lisp_Object face_id, attr_name, attr_value, frame; 5267
5268static struct face *
5269realize_face (c, attrs, charset)
5270 struct face_cache *c;
5271 Lisp_Object *attrs;
5272 int charset;
1139{ 5273{
1140 struct face *face; 5274 struct face *face;
1141 struct frame *f; 5275
1142 int magic_p; 5276 /* LFACE must be fully specified. */
1143 int id; 5277 xassert (c != NULL);
1144 int garbaged = 0; 5278 check_lface_attrs (attrs);
1145 5279
1146 CHECK_FRAME (frame, 0); 5280 if (FRAME_X_P (c->f))
1147 CHECK_NUMBER (face_id, 0); 5281 face = realize_x_face (c, attrs, charset);
1148 CHECK_SYMBOL (attr_name, 0); 5282 else if (FRAME_TERMCAP_P (c->f))
5283 face = realize_tty_face (c, attrs, charset);
5284 else
5285 abort ();
1149 5286
1150 f = XFRAME (frame); 5287 return face;
1151 id = XINT (face_id); 5288}
1152 if (id < 0 || id >= next_face_id)
1153 error ("Face id out of range");
1154 5289
1155 if (! FRAME_X_P (f) && ! FRAME_MSDOS_P (f))
1156 return Qnil;
1157 5290
1158 ensure_face_ready (f, id); 5291/* Realize the fully-specified face with attributes ATTRS in face
1159 face = FRAME_PARAM_FACES (f) [XFASTINT (face_id)]; 5292 cache C for character set CHARSET or for unibyte text if CHARSET <
5293 0. Do it for X frame C->f. Value is a pointer to the newly
5294 created realized face. */
1160 5295
1161 if (EQ (attr_name, intern ("font"))) 5296static struct face *
5297realize_x_face (c, attrs, charset)
5298 struct face_cache *c;
5299 Lisp_Object *attrs;
5300 int charset;
5301{
5302#ifdef HAVE_X_WINDOWS
5303 struct face *face, *default_face;
5304 struct frame *f = c->f;
5305 Lisp_Object stipple, overline, strike_through, box;
5306 Lisp_Object unibyte_registry;
5307 struct gcpro gcpro1;
5308
5309 xassert (FRAME_X_P (f));
5310
5311 /* If realizing a face for use in unibyte text, get the X registry
5312 and encoding to use from Vface_default_registry. */
5313 if (charset < 0)
5314 unibyte_registry = (STRINGP (Vface_default_registry)
5315 ? Vface_default_registry
5316 : build_string ("iso8859-1"));
5317 else
5318 unibyte_registry = Qnil;
5319 GCPRO1 (unibyte_registry);
5320
5321 /* Allocate a new realized face. */
5322 face = make_realized_face (attrs, charset, unibyte_registry);
5323
5324 /* Determine the font to use. Most of the time, the font will be
5325 the same as the font of the default face, so try that first. */
5326 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5327 if (default_face
5328 && FACE_SUITABLE_FOR_CHARSET_P (default_face, charset)
5329 && lface_same_font_attributes_p (default_face->lface, attrs))
1162 { 5330 {
1163#if defined (MSDOS) && !defined (HAVE_X_WINDOWS) 5331 face->font = default_face->font;
1164 /* The one and only font. Must *not* be zero (which 5332 face->fontset = default_face->fontset;
1165 is taken to mean an unused face nowadays). */ 5333 face->font_info_id = default_face->font_info_id;
1166 face->font = (XFontStruct *)1 ; 5334 face->font_name = default_face->font_name;
1167#else 5335 face->registry = default_face->registry;
1168 XFontStruct *font; 5336 }
1169 int fontset; 5337 else if (charset >= 0)
1170 5338 {
1171 if (NILP (attr_value)) 5339 /* For all charsets except CHARSET_COMPOSITION, we use our own
5340 font selection functions to choose a best matching font for
5341 the specified face attributes. If the face specifies a
5342 fontset alias name, the fontset determines the font name
5343 pattern, otherwise we construct a font pattern from face
5344 attributes and charset.
5345
5346 If charset is CHARSET_COMPOSITION, we always construct a face
5347 with a fontset, even if the face doesn't specify a fontset alias
5348 (we use fontset-standard in that case). When the composite
5349 character is displayed in xterm.c, a suitable concrete font is
5350 loaded in x_get_char_font_and_encoding. */
5351
5352 char *font_name = NULL;
5353 int fontset = face_fontset (f, attrs);
5354
5355 if (charset == CHARSET_COMPOSITION)
5356 fontset = max (0, fontset);
5357 else if (fontset < 0)
5358 font_name = choose_face_font (f, attrs, charset, Qnil);
5359 else
1172 { 5360 {
1173 font = (XFontStruct *) FACE_DEFAULT; 5361 font_name = choose_face_fontset_font (f, attrs, fontset, charset);
1174 fontset = -1; 5362 fontset = -1;
1175 } 5363 }
5364
5365 load_face_font_or_fontset (f, face, font_name, fontset);
5366 xfree (font_name);
5367 }
5368 else
5369 {
5370 /* Unibyte case, and font is not equal to that of the default
5371 face. UNIBYTE_REGISTRY is the X registry and encoding the
5372 font should have. What is a reasonable thing to do if the
5373 user specified a fontset alias name for the face in this
5374 case? We choose a font by taking the ASCII font of the
5375 fontset, but using UNIBYTE_REGISTRY for its registry and
5376 encoding. */
5377
5378 char *font_name = NULL;
5379 int fontset = face_fontset (f, attrs);
5380
5381 if (fontset < 0)
5382 font_name = choose_face_font (f, attrs, charset, unibyte_registry);
1176 else 5383 else
5384 font_name = choose_face_fontset_font (f, attrs, fontset, charset);
5385
5386 load_face_font_or_fontset (f, face, font_name, -1);
5387 xfree (font_name);
5388 }
5389
5390 /* Load colors, and set remaining attributes. */
5391
5392 load_face_colors (f, face, attrs);
5393
5394 /* Set up box. */
5395 box = attrs[LFACE_BOX_INDEX];
5396 if (STRINGP (box))
5397 {
5398 /* A simple box of line width 1 drawn in color given by
5399 the string. */
5400 face->box_color = load_color (f, face, attrs[LFACE_BOX_INDEX],
5401 LFACE_BOX_INDEX);
5402 face->box = FACE_SIMPLE_BOX;
5403 face->box_line_width = 1;
5404 }
5405 else if (INTEGERP (box))
5406 {
5407 /* Simple box of specified line width in foreground color of the
5408 face. */
5409 xassert (XINT (box) > 0);
5410 face->box = FACE_SIMPLE_BOX;
5411 face->box_line_width = XFASTINT (box);
5412 face->box_color = face->foreground;
5413 face->box_color_defaulted_p = 1;
5414 }
5415 else if (CONSP (box))
5416 {
5417 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5418 being one of `raised' or `sunken'. */
5419 face->box = FACE_SIMPLE_BOX;
5420 face->box_color = face->foreground;
5421 face->box_color_defaulted_p = 1;
5422 face->box_line_width = 1;
5423
5424 while (CONSP (box))
1177 { 5425 {
1178 CHECK_STRING (attr_value, 0); 5426 Lisp_Object keyword, value;
1179 fontset = fs_query_fontset (f, XSTRING (attr_value)->data); 5427
1180 if (fontset >= 0) 5428 keyword = XCAR (box);
5429 box = XCDR (box);
5430
5431 if (!CONSP (box))
5432 break;
5433 value = XCAR (box);
5434 box = XCDR (box);
5435
5436 if (EQ (keyword, QCline_width))
1181 { 5437 {
1182 struct font_info *fontp; 5438 if (INTEGERP (value) && XINT (value) > 0)
1183 5439 face->box_line_width = XFASTINT (value);
1184 if (!(fontp = FS_LOAD_FONT (f, FRAME_X_FONT_TABLE (f), 5440 }
1185 CHARSET_ASCII, NULL, fontset))) 5441 else if (EQ (keyword, QCcolor))
1186 Fsignal (Qerror, 5442 {
1187 Fcons (build_string ("ASCII font can't be loaded"), 5443 if (STRINGP (value))
1188 Fcons (attr_value, Qnil))); 5444 {
1189 font = (XFontStruct *) (fontp->font); 5445 face->box_color = load_color (f, face, value,
5446 LFACE_BOX_INDEX);
5447 face->use_box_color_for_shadows_p = 1;
5448 }
5449 }
5450 else if (EQ (keyword, QCstyle))
5451 {
5452 if (EQ (value, Qreleased_button))
5453 face->box = FACE_RAISED_BOX;
5454 else if (EQ (value, Qpressed_button))
5455 face->box = FACE_SUNKEN_BOX;
1190 } 5456 }
1191 else
1192 font = load_font (f, attr_value);
1193 } 5457 }
5458 }
1194 5459
1195 if (face->fontset == -1 && face->font != f->output_data.x->font) 5460 /* Text underline, overline, strike-through. */
1196 unload_font (f, face->font); 5461
1197 5462 if (EQ (attrs[LFACE_UNDERLINE_INDEX], Qt))
1198 face->font = font; 5463 {
1199 face->fontset = fontset; 5464 /* Use default color (same as foreground color). */
1200 if (frame_update_line_height (f)) 5465 face->underline_p = 1;
1201 x_set_window_size (f, 0, f->width, f->height); 5466 face->underline_defaulted_p = 1;
1202 /* Must clear cache, since it might contain the font 5467 face->underline_color = 0;
1203 we just got rid of. */ 5468 }
1204 garbaged = 1; 5469 else if (STRINGP (attrs[LFACE_UNDERLINE_INDEX]))
1205#endif 5470 {
5471 /* Use specified color. */
5472 face->underline_p = 1;
5473 face->underline_defaulted_p = 0;
5474 face->underline_color
5475 = load_color (f, face, attrs[LFACE_UNDERLINE_INDEX],
5476 LFACE_UNDERLINE_INDEX);
1206 } 5477 }
1207 else if (EQ (attr_name, intern ("foreground"))) 5478 else if (NILP (attrs[LFACE_UNDERLINE_INDEX]))
1208 { 5479 {
1209 unsigned long new_color = load_color (f, attr_value); 5480 face->underline_p = 0;
1210 unload_color (f, face->foreground); 5481 face->underline_defaulted_p = 0;
1211 face->foreground = new_color; 5482 face->underline_color = 0;
1212 garbaged = 1;
1213 } 5483 }
1214 else if (EQ (attr_name, intern ("background"))) 5484
5485 overline = attrs[LFACE_OVERLINE_INDEX];
5486 if (STRINGP (overline))
1215 { 5487 {
1216 unsigned long new_color = load_color (f, attr_value); 5488 face->overline_color
1217 unload_color (f, face->background); 5489 = load_color (f, face, attrs[LFACE_OVERLINE_INDEX],
1218 face->background = new_color; 5490 LFACE_OVERLINE_INDEX);
1219 garbaged = 1; 5491 face->overline_p = 1;
1220 } 5492 }
1221 else if (EQ (attr_name, intern ("background-pixmap"))) 5493 else if (EQ (overline, Qt))
1222 { 5494 {
1223 unsigned int w, h; 5495 face->overline_color = face->foreground;
1224 unsigned long new_pixmap = load_pixmap (f, attr_value, &w, &h); 5496 face->overline_color_defaulted_p = 1;
1225 x_destroy_bitmap (f, face->stipple); 5497 face->overline_p = 1;
1226 face->stipple = new_pixmap;
1227 face->pixmap_w = w;
1228 face->pixmap_h = h;
1229 garbaged = 1;
1230 } 5498 }
1231 else if (EQ (attr_name, intern ("underline"))) 5499
5500 strike_through = attrs[LFACE_STRIKE_THROUGH_INDEX];
5501 if (STRINGP (strike_through))
1232 { 5502 {
1233 int new = !NILP (attr_value); 5503 face->strike_through_color
1234 face->underline = new; 5504 = load_color (f, face, attrs[LFACE_STRIKE_THROUGH_INDEX],
5505 LFACE_STRIKE_THROUGH_INDEX);
5506 face->strike_through_p = 1;
1235 } 5507 }
5508 else if (EQ (strike_through, Qt))
5509 {
5510 face->strike_through_color = face->foreground;
5511 face->strike_through_color_defaulted_p = 1;
5512 face->strike_through_p = 1;
5513 }
5514
5515 stipple = attrs[LFACE_STIPPLE_INDEX];
5516 if (!NILP (stipple))
5517 face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h);
5518
5519 UNGCPRO;
5520 xassert (face->fontset < 0 || face->charset == CHARSET_COMPOSITION);
5521 xassert (FACE_SUITABLE_FOR_CHARSET_P (face, charset));
5522 return face;
5523#endif /* HAVE_X_WINDOWS */
5524}
5525
5526
5527/* Realize the fully-specified face with attributes ATTRS in face
5528 cache C for character set CHARSET or for unibyte text if CHARSET <
5529 0. Do it for TTY frame C->f. Value is a pointer to the newly
5530 created realized face. */
5531
5532static struct face *
5533realize_tty_face (c, attrs, charset)
5534 struct face_cache *c;
5535 Lisp_Object *attrs;
5536 int charset;
5537{
5538 struct face *face;
5539 int weight, slant;
5540 Lisp_Object color;
5541
5542 /* Frame must be a termcap frame. */
5543 xassert (FRAME_TERMCAP_P (c->f));
5544
5545 /* Allocate a new realized face. */
5546 face = make_realized_face (attrs, charset, Qnil);
5547 face->font_name = "tty";
5548
5549 /* Map face attributes to TTY appearances. We map slant to
5550 dimmed text because we want italic text to appear differently
5551 and because dimmed text is probably used infrequently. */
5552 weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
5553 slant = face_numeric_slant (attrs[LFACE_SLANT_INDEX]);
5554
5555 if (weight > XLFD_WEIGHT_MEDIUM)
5556 face->tty_bold_p = 1;
5557 if (weight < XLFD_WEIGHT_MEDIUM || slant != XLFD_SLANT_ROMAN)
5558 face->tty_dim_p = 1;
5559 if (!NILP (attrs[LFACE_UNDERLINE_INDEX]))
5560 face->tty_underline_p = 1;
5561 if (!NILP (attrs[LFACE_INVERSE_INDEX]))
5562 face->tty_reverse_p = 1;
5563
5564 /* Map color names to color indices. */
5565 face->foreground = face->background = FACE_TTY_DEFAULT_COLOR;
5566
5567 color = attrs[LFACE_FOREGROUND_INDEX];
5568 if (XSTRING (color)->size
5569 && (color = Fassoc (color, Vface_tty_color_alist),
5570 CONSP (color)))
5571 face->foreground = XINT (XCDR (color));
5572
5573 color = attrs[LFACE_BACKGROUND_INDEX];
5574 if (XSTRING (color)->size
5575 && (color = Fassoc (color, Vface_tty_color_alist),
5576 CONSP (color)))
5577 face->background = XINT (XCDR (color));
5578
5579 return face;
5580}
5581
5582
5583DEFUN ("face-register-tty-color", Fface_register_tty_color,
5584 Sface_register_tty_color, 2, 2, 0,
5585 "Say that COLOR is color number NUMBER on the terminal.\n\
5586COLOR is a string, the color name. Value is COLOR.")
5587 (color, number)
5588 Lisp_Object color, number;
5589{
5590 Lisp_Object entry;
5591
5592 CHECK_STRING (color, 0);
5593 CHECK_NUMBER (number, 1);
5594 entry = Fassoc (color, Vface_tty_color_alist);
5595 if (NILP (entry))
5596 Vface_tty_color_alist = Fcons (Fcons (color, number),
5597 Vface_tty_color_alist);
1236 else 5598 else
1237 error ("unknown face attribute"); 5599 Fsetcdr (entry, number);
5600 return color;
5601}
5602
5603
5604DEFUN ("face-clear-tty-colors", Fface_clear_tty_colors,
5605 Sface_clear_tty_colors, 0, 0, 0,
5606 "Unregister all registered tty colors.")
5607 ()
5608{
5609 return Vface_tty_color_alist = Qnil;
5610}
5611
5612
5613DEFUN ("tty-defined-colors", Ftty_defined_colors,
5614 Stty_defined_colors, 0, 0, 0,
5615 "Return a list of registered tty colors.")
5616 ()
5617{
5618 Lisp_Object list, colors;
1238 5619
1239 if (id == 0 || id == 1) 5620 colors = Qnil;
1240 recompute_basic_faces (f); 5621 for (list = Vface_tty_color_alist; CONSP (list); list = XCDR (list))
5622 colors = Fcons (XCAR (XCAR (list)), colors);
1241 5623
1242 /* We must redraw the frame whenever any face font or color changes, 5624 return colors;
1243 because it's possible that a merged (display) face 5625}
1244 contains the font or color we just replaced. 5626
1245 And we must inhibit any Expose events until the redraw is done, 5627
1246 since they would try to use the invalid display faces. */ 5628
1247 if (garbaged) 5629/***********************************************************************
5630 Computing Faces
5631 ***********************************************************************/
5632
5633/* Return the ID of the face to use to display character CH with face
5634 property PROP on frame F in current_buffer. */
5635
5636int
5637compute_char_face (f, ch, prop)
5638 struct frame *f;
5639 int ch;
5640 Lisp_Object prop;
5641{
5642 int face_id;
5643 int charset = (NILP (current_buffer->enable_multibyte_characters)
5644 ? -1
5645 : CHAR_CHARSET (ch));
5646
5647 if (NILP (prop))
5648 face_id = FACE_FOR_CHARSET (f, DEFAULT_FACE_ID, charset);
5649 else
1248 { 5650 {
1249 SET_FRAME_GARBAGED (f); 5651 Lisp_Object attrs[LFACE_VECTOR_SIZE];
1250#ifdef HAVE_X_WINDOWS 5652 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
1251 FRAME_X_DISPLAY_INFO (f)->mouse_face_defer = 1; 5653 bcopy (default_face->lface, attrs, sizeof attrs);
1252#endif 5654 merge_face_vector_with_property (f, attrs, prop);
5655 face_id = lookup_face (f, attrs, charset);
1253 } 5656 }
1254 5657
1255 return Qnil; 5658 return face_id;
1256} 5659}
1257/* Return the face id for name NAME on frame FRAME. 5660
1258 (It should be the same for all frames, 5661
1259 but it's as easy to use the "right" frame to look it up 5662/* Return the face ID associated with buffer position POS for
1260 as to use any other one.) */ 5663 displaying ASCII characters. Return in *ENDPTR the position at
5664 which a different face is needed, as far as text properties and
5665 overlays are concerned. W is a window displaying current_buffer.
5666
5667 REGION_BEG, REGION_END delimit the region, so it can be
5668 highlighted.
5669
5670 LIMIT is a position not to scan beyond. That is to limit the time
5671 this function can take.
5672
5673 If MOUSE is non-zero, use the character's mouse-face, not its face.
5674
5675 The face returned is suitable for displaying CHARSET_ASCII if
5676 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
5677 the face is suitable for displaying unibyte text. */
1261 5678
1262int 5679int
1263face_name_id_number (f, name) 5680face_at_buffer_position (w, pos, region_beg, region_end,
1264 FRAME_PTR f; 5681 endptr, limit, mouse)
1265 Lisp_Object name; 5682 struct window *w;
5683 int pos;
5684 int region_beg, region_end;
5685 int *endptr;
5686 int limit;
5687 int mouse;
1266{ 5688{
1267 Lisp_Object tem; 5689 struct frame *f = XFRAME (w->frame);
5690 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5691 Lisp_Object prop, position;
5692 int i, noverlays;
5693 Lisp_Object *overlay_vec;
5694 Lisp_Object frame;
5695 int endpos;
5696 Lisp_Object propname = mouse ? Qmouse_face : Qface;
5697 Lisp_Object limit1, end;
5698 struct face *default_face;
5699 int multibyte_p = !NILP (current_buffer->enable_multibyte_characters);
1268 5700
1269 tem = Fcdr (assq_no_quit (name, f->face_alist)); 5701 /* W must display the current buffer. We could write this function
1270 if (NILP (tem)) 5702 to use the frame and buffer of W, but right now it doesn't. */
1271 return 0; 5703 xassert (XBUFFER (w->buffer) == current_buffer);
1272 CHECK_VECTOR (tem, 0); 5704
1273 tem = XVECTOR (tem)->contents[2]; 5705 XSETFRAME (frame, f);
1274 CHECK_NUMBER (tem, 0); 5706 XSETFASTINT (position, pos);
1275 return XINT (tem); 5707
5708 endpos = ZV;
5709 if (pos < region_beg && region_beg < endpos)
5710 endpos = region_beg;
5711
5712 /* Get the `face' or `mouse_face' text property at POS, and
5713 determine the next position at which the property changes. */
5714 prop = Fget_text_property (position, propname, w->buffer);
5715 XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
5716 end = Fnext_single_property_change (position, propname, w->buffer, limit1);
5717 if (INTEGERP (end))
5718 endpos = XINT (end);
5719
5720 /* Look at properties from overlays. */
5721 {
5722 int next_overlay;
5723 int len;
5724
5725 /* First try with room for 40 overlays. */
5726 len = 40;
5727 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
5728 noverlays = overlays_at (pos, 0, &overlay_vec, &len,
5729 &next_overlay, NULL);
5730
5731 /* If there are more than 40, make enough space for all, and try
5732 again. */
5733 if (noverlays > len)
5734 {
5735 len = noverlays;
5736 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
5737 noverlays = overlays_at (pos, 0, &overlay_vec, &len,
5738 &next_overlay, NULL);
5739 }
5740
5741 if (next_overlay < endpos)
5742 endpos = next_overlay;
5743 }
5744
5745 *endptr = endpos;
5746
5747 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5748
5749 /* Optimize common cases where we can use the default face. */
5750 if (noverlays == 0
5751 && NILP (prop)
5752 && !(pos >= region_beg && pos < region_end)
5753 && (multibyte_p
5754 || !FRAME_WINDOW_P (f)
5755 || FACE_SUITABLE_FOR_CHARSET_P (default_face, -1)))
5756 return DEFAULT_FACE_ID;
5757
5758 /* Begin with attributes from the default face. */
5759 bcopy (default_face->lface, attrs, sizeof attrs);
5760
5761 /* Merge in attributes specified via text properties. */
5762 if (!NILP (prop))
5763 merge_face_vector_with_property (f, attrs, prop);
5764
5765 /* Now merge the overlay data. */
5766 noverlays = sort_overlays (overlay_vec, noverlays, w);
5767 for (i = 0; i < noverlays; i++)
5768 {
5769 Lisp_Object oend;
5770 int oendpos;
5771
5772 prop = Foverlay_get (overlay_vec[i], propname);
5773 if (!NILP (prop))
5774 merge_face_vector_with_property (f, attrs, prop);
5775
5776 oend = OVERLAY_END (overlay_vec[i]);
5777 oendpos = OVERLAY_POSITION (oend);
5778 if (oendpos < endpos)
5779 endpos = oendpos;
5780 }
5781
5782 /* If in the region, merge in the region face. */
5783 if (pos >= region_beg && pos < region_end)
5784 {
5785 Lisp_Object region_face = lface_from_face_name (f, Qregion, 0);
5786 merge_face_vectors (XVECTOR (region_face)->contents, attrs);
5787
5788 if (region_end < endpos)
5789 endpos = region_end;
5790 }
5791
5792 *endptr = endpos;
5793
5794 /* Look up a realized face with the given face attributes,
5795 or realize a new one. Charset is ignored for tty frames. */
5796 return lookup_face (f, attrs, multibyte_p ? CHARSET_ASCII : -1);
5797}
5798
5799
5800/* Compute the face at character position POS in Lisp string STRING on
5801 window W, for charset CHARSET_ASCII.
5802
5803 If STRING is an overlay string, it comes from position BUFPOS in
5804 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
5805 not an overlay string. W must display the current buffer.
5806 REGION_BEG and REGION_END give the start and end positions of the
5807 region; both are -1 if no region is visible. BASE_FACE_ID is the
5808 id of the basic face to merge with. It is usually equal to
5809 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or TOP_LINE_FACE_ID
5810 for strings displayed in the mode or top line.
5811
5812 Set *ENDPTR to the next position where to check for faces in
5813 STRING; -1 if the face is constant from POS to the end of the
5814 string.
5815
5816 Value is the id of the face to use. The face returned is suitable
5817 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
5818 the face is suitable for displaying unibyte text. */
5819
5820int
5821face_at_string_position (w, string, pos, bufpos, region_beg,
5822 region_end, endptr, base_face_id)
5823 struct window *w;
5824 Lisp_Object string;
5825 int pos, bufpos;
5826 int region_beg, region_end;
5827 int *endptr;
5828 enum face_id base_face_id;
5829{
5830 Lisp_Object prop, position, end, limit;
5831 struct frame *f = XFRAME (WINDOW_FRAME (w));
5832 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5833 struct face *base_face;
5834 int multibyte_p = STRING_MULTIBYTE (string);
5835
5836 /* Get the value of the face property at the current position within
5837 STRING. Value is nil if there is no face property. */
5838 XSETFASTINT (position, pos);
5839 prop = Fget_text_property (position, Qface, string);
5840
5841 /* Get the next position at which to check for faces. Value of end
5842 is nil if face is constant all the way to the end of the string.
5843 Otherwise it is a string position where to check faces next.
5844 Limit is the maximum position up to which to check for property
5845 changes in Fnext_single_property_change. Strings are usually
5846 short, so set the limit to the end of the string. */
5847 XSETFASTINT (limit, XSTRING (string)->size);
5848 end = Fnext_single_property_change (position, Qface, string, limit);
5849 if (INTEGERP (end))
5850 *endptr = XFASTINT (end);
5851 else
5852 *endptr = -1;
5853
5854 base_face = FACE_FROM_ID (f, base_face_id);
5855 xassert (base_face);
5856
5857 /* Optimize the default case that there is no face property and we
5858 are not in the region. */
5859 if (NILP (prop)
5860 && (base_face_id != DEFAULT_FACE_ID
5861 /* BUFPOS <= 0 means STRING is not an overlay string, so
5862 that the region doesn't have to be taken into account. */
5863 || bufpos <= 0
5864 || bufpos < region_beg
5865 || bufpos >= region_end)
5866 && (multibyte_p
5867 /* We can't realize faces for different charsets differently
5868 if we don't have fonts, so we can stop here if not working
5869 on a window-system frame. */
5870 || !FRAME_WINDOW_P (f)
5871 || FACE_SUITABLE_FOR_CHARSET_P (base_face, -1)))
5872 return base_face->id;
5873
5874 /* Begin with attributes from the base face. */
5875 bcopy (base_face->lface, attrs, sizeof attrs);
5876
5877 /* Merge in attributes specified via text properties. */
5878 if (!NILP (prop))
5879 merge_face_vector_with_property (f, attrs, prop);
5880
5881 /* If in the region, merge in the region face. */
5882 if (bufpos
5883 && bufpos >= region_beg
5884 && bufpos < region_end)
5885 {
5886 Lisp_Object region_face = lface_from_face_name (f, Qregion, 0);
5887 merge_face_vectors (XVECTOR (region_face)->contents, attrs);
5888 }
5889
5890 /* Look up a realized face with the given face attributes,
5891 or realize a new one. */
5892 return lookup_face (f, attrs, multibyte_p ? CHARSET_ASCII : -1);
1276} 5893}
1277 5894
1278#endif /* HAVE_FACES */
1279 5895
1280 5896
1281DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist, 1, 1, 0, 5897/***********************************************************************
1282 "") 5898 Tests
1283 (frame) 5899 ***********************************************************************/
1284 Lisp_Object frame; 5900
5901#if GLYPH_DEBUG
5902
5903/* Print the contents of the realized face FACE to stderr. */
5904
5905static void
5906dump_realized_face (face)
5907 struct face *face;
1285{ 5908{
1286 CHECK_FRAME (frame, 0); 5909 fprintf (stderr, "ID: %d\n", face->id);
1287 return XFRAME (frame)->face_alist; 5910#ifdef HAVE_X_WINDOWS
5911 fprintf (stderr, "gc: %d\n", (int) face->gc);
5912#endif
5913 fprintf (stderr, "foreground: 0x%lx (%s)\n",
5914 face->foreground,
5915 XSTRING (face->lface[LFACE_FOREGROUND_INDEX])->data);
5916 fprintf (stderr, "background: 0x%lx (%s)\n",
5917 face->background,
5918 XSTRING (face->lface[LFACE_BACKGROUND_INDEX])->data);
5919 fprintf (stderr, "font_name: %s (%s)\n",
5920 face->font_name,
5921 XSTRING (face->lface[LFACE_FAMILY_INDEX])->data);
5922#ifdef HAVE_X_WINDOWS
5923 fprintf (stderr, "font = %p\n", face->font);
5924#endif
5925 fprintf (stderr, "font_info_id = %d\n", face->font_info_id);
5926 fprintf (stderr, "fontset: %d\n", face->fontset);
5927 fprintf (stderr, "underline: %d (%s)\n",
5928 face->underline_p,
5929 XSTRING (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX]))->data);
5930 fprintf (stderr, "hash: %d\n", face->hash);
5931 fprintf (stderr, "charset: %d\n", face->charset);
1288} 5932}
1289 5933
1290DEFUN ("set-frame-face-alist", Fset_frame_face_alist, Sset_frame_face_alist, 5934
1291 2, 2, 0, "") 5935DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, "")
1292 (frame, value) 5936 (n)
1293 Lisp_Object frame, value; 5937 Lisp_Object n;
1294{ 5938{
1295 CHECK_FRAME (frame, 0); 5939 if (NILP (n))
1296 XFRAME (frame)->face_alist = value; 5940 {
1297 return value; 5941 int i;
5942
5943 fprintf (stderr, "font selection order: ");
5944 for (i = 0; i < DIM (font_sort_order); ++i)
5945 fprintf (stderr, "%d ", font_sort_order[i]);
5946 fprintf (stderr, "\n");
5947
5948 fprintf (stderr, "alternative fonts: ");
5949 debug_print (Vface_alternative_font_family_alist);
5950 fprintf (stderr, "\n");
5951
5952 for (i = 0; i < FRAME_FACE_CACHE (selected_frame)->used; ++i)
5953 Fdump_face (make_number (i));
5954 }
5955 else
5956 {
5957 struct face *face;
5958 CHECK_NUMBER (n, 0);
5959 face = FACE_FROM_ID (selected_frame, XINT (n));
5960 if (face == NULL)
5961 error ("Not a valid face");
5962 dump_realized_face (face);
5963 }
5964
5965 return Qnil;
1298} 5966}
1299 5967
1300DEFUN ("internal-next-face-id", Finternal_next_face_id, Sinternal_next_face_id, 5968
1301 0, 0, 0, "") 5969DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
5970 0, 0, 0, "")
1302 () 5971 ()
1303{ 5972{
1304 return make_number (next_face_id++); 5973 fprintf (stderr, "number of colors = %d\n", ncolors_allocated);
5974 fprintf (stderr, "number of pixmaps = %d\n", npixmaps_allocated);
5975 fprintf (stderr, "number of GCs = %d\n", ngcs);
5976 return Qnil;
1305} 5977}
5978
5979#endif /* GLYPH_DEBUG != 0 */
5980
5981
1306 5982
1307/* Emacs initialization. */ 5983/***********************************************************************
5984 Initialization
5985 ***********************************************************************/
1308 5986
1309void 5987void
1310syms_of_xfaces () 5988syms_of_xfaces ()
1311{ 5989{
1312#ifdef HAVE_FACES
1313 Qface = intern ("face"); 5990 Qface = intern ("face");
1314 staticpro (&Qface); 5991 staticpro (&Qface);
1315 Qpixmap_spec_p = intern ("pixmap-spec-p"); 5992 Qpixmap_spec_p = intern ("pixmap-spec-p");
1316 staticpro (&Qpixmap_spec_p); 5993 staticpro (&Qpixmap_spec_p);
1317 5994
1318 DEFVAR_INT ("region-face", &region_face, 5995 /* Lisp face attribute keywords. */
1319 "Face number to use to highlight the region\n\ 5996 QCfamily = intern (":family");
1320The region is highlighted with this face\n\ 5997 staticpro (&QCfamily);
1321when Transient Mark mode is enabled and the mark is active."); 5998 QCheight = intern (":height");
1322 5999 staticpro (&QCheight);
1323 defsubr (&Smake_face_internal); 6000 QCweight = intern (":weight");
1324 defsubr (&Sset_face_attribute_internal); 6001 staticpro (&QCweight);
1325#endif /* HAVE_FACES */ 6002 QCslant = intern (":slant");
6003 staticpro (&QCslant);
6004 QCunderline = intern (":underline");
6005 staticpro (&QCunderline);
6006 QCinverse_video = intern (":inverse-video");
6007 staticpro (&QCinverse_video);
6008 QCreverse_video = intern (":reverse-video");
6009 staticpro (&QCreverse_video);
6010 QCforeground = intern (":foreground");
6011 staticpro (&QCforeground);
6012 QCbackground = intern (":background");
6013 staticpro (&QCbackground);
6014 QCstipple = intern (":stipple");;
6015 staticpro (&QCstipple);
6016 QCwidth = intern (":width");
6017 staticpro (&QCwidth);
6018 QCfont = intern (":font");
6019 staticpro (&QCfont);
6020 QCbold = intern (":bold");
6021 staticpro (&QCbold);
6022 QCitalic = intern (":italic");
6023 staticpro (&QCitalic);
6024 QCoverline = intern (":overline");
6025 staticpro (&QCoverline);
6026 QCstrike_through = intern (":strike-through");
6027 staticpro (&QCstrike_through);
6028 QCbox = intern (":box");
6029 staticpro (&QCbox);
6030
6031 /* Symbols used for Lisp face attribute values. */
6032 QCcolor = intern (":color");
6033 staticpro (&QCcolor);
6034 QCline_width = intern (":line-width");
6035 staticpro (&QCline_width);
6036 QCstyle = intern (":style");
6037 staticpro (&QCstyle);
6038 Qreleased_button = intern ("released-button");
6039 staticpro (&Qreleased_button);
6040 Qpressed_button = intern ("pressed-button");
6041 staticpro (&Qpressed_button);
6042 Qnormal = intern ("normal");
6043 staticpro (&Qnormal);
6044 Qultra_light = intern ("ultra-light");
6045 staticpro (&Qultra_light);
6046 Qextra_light = intern ("extra-light");
6047 staticpro (&Qextra_light);
6048 Qlight = intern ("light");
6049 staticpro (&Qlight);
6050 Qsemi_light = intern ("semi-light");
6051 staticpro (&Qsemi_light);
6052 Qsemi_bold = intern ("semi-bold");
6053 staticpro (&Qsemi_bold);
6054 Qbold = intern ("bold");
6055 staticpro (&Qbold);
6056 Qextra_bold = intern ("extra-bold");
6057 staticpro (&Qextra_bold);
6058 Qultra_bold = intern ("ultra-bold");
6059 staticpro (&Qultra_bold);
6060 Qoblique = intern ("oblique");
6061 staticpro (&Qoblique);
6062 Qitalic = intern ("italic");
6063 staticpro (&Qitalic);
6064 Qreverse_oblique = intern ("reverse-oblique");
6065 staticpro (&Qreverse_oblique);
6066 Qreverse_italic = intern ("reverse-italic");
6067 staticpro (&Qreverse_italic);
6068 Qultra_condensed = intern ("ultra-condensed");
6069 staticpro (&Qultra_condensed);
6070 Qextra_condensed = intern ("extra-condensed");
6071 staticpro (&Qextra_condensed);
6072 Qcondensed = intern ("condensed");
6073 staticpro (&Qcondensed);
6074 Qsemi_condensed = intern ("semi-condensed");
6075 staticpro (&Qsemi_condensed);
6076 Qsemi_expanded = intern ("semi-expanded");
6077 staticpro (&Qsemi_expanded);
6078 Qexpanded = intern ("expanded");
6079 staticpro (&Qexpanded);
6080 Qextra_expanded = intern ("extra-expanded");
6081 staticpro (&Qextra_expanded);
6082 Qultra_expanded = intern ("ultra-expanded");
6083 staticpro (&Qultra_expanded);
6084 Qbackground_color = intern ("background-color");
6085 staticpro (&Qbackground_color);
6086 Qforeground_color = intern ("foreground-color");
6087 staticpro (&Qforeground_color);
6088 Qunspecified = intern ("unspecified");
6089 staticpro (&Qunspecified);
6090
6091 Qx_charset_registry = intern ("x-charset-registry");
6092 staticpro (&Qx_charset_registry);
6093 Qdefault = intern ("default");
6094 staticpro (&Qdefault);
6095 Qmodeline = intern ("modeline");
6096 staticpro (&Qmodeline);
6097 Qtoolbar = intern ("toolbar");
6098 staticpro (&Qtoolbar);
6099 Qregion = intern ("region");
6100 staticpro (&Qregion);
6101 Qbitmap_area = intern ("bitmap-area");
6102 staticpro (&Qbitmap_area);
6103 Qtop_line = intern ("top-line");
6104 staticpro (&Qtop_line);
6105
6106 defsubr (&Sinternal_make_lisp_face);
6107 defsubr (&Sinternal_lisp_face_p);
6108 defsubr (&Sinternal_set_lisp_face_attribute);
6109#ifdef HAVE_X_WINDOWS
6110 defsubr (&Sinternal_set_lisp_face_attribute_from_resource);
6111 defsubr (&Sface_color_gray_p);
6112 defsubr (&Sface_color_supported_p);
6113#endif
6114 defsubr (&Sinternal_get_lisp_face_attribute);
6115 defsubr (&Sinternal_lisp_face_attribute_values);
6116 defsubr (&Sinternal_lisp_face_equal_p);
6117 defsubr (&Sinternal_lisp_face_empty_p);
6118 defsubr (&Sinternal_copy_lisp_face);
6119 defsubr (&Sinternal_merge_in_global_face);
6120 defsubr (&Sface_font);
6121 defsubr (&Sframe_face_alist);
6122 defsubr (&Sinternal_set_font_selection_order);
6123 defsubr (&Sinternal_set_alternative_font_family_alist);
6124#if GLYPH_DEBUG
6125 defsubr (&Sdump_face);
6126 defsubr (&Sshow_face_resources);
6127#endif /* GLYPH_DEBUG */
6128 defsubr (&Sclear_face_cache);
6129
6130 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults,
6131 "List of global face definitions (for internal use only.)");
6132 Vface_new_frame_defaults = Qnil;
6133
6134 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple,
6135 "*Default stipple pattern used on monochrome displays.\n\
6136This stipple pattern is used on monochrome displays\n\
6137instead of shades of gray for a face background color.\n\
6138See `set-face-stipple' for possible values for this variable.");
6139 Vface_default_stipple = build_string ("gray3");
6140
6141 DEFVAR_LISP ("face-default-registry", &Vface_default_registry,
6142 "Default registry and encoding to use.\n\
6143This registry and encoding is used for unibyte text. It is set up\n\
6144from the specified frame font when Emacs starts. (For internal use only.)");
6145 Vface_default_registry = Qnil;
6146
6147 DEFVAR_LISP ("face-alternative-font-family-alist",
6148 &Vface_alternative_font_family_alist, "");
6149 Vface_alternative_font_family_alist = Qnil;
6150
6151#if SCALABLE_FONTS
6152
6153 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed,
6154 "Allowed scalable fonts.\n\
6155A value of nil means don't allow any scalable fonts.\n\
6156A value of t means allow any scalable font.\n\
6157Otherwise, value must be a list of regular expressions. A font may be\n\
6158scaled if its name matches a regular expression in the list.");
6159 Vscalable_fonts_allowed = Qnil;
6160
6161#endif /* SCALABLE_FONTS */
1326 6162
1327#ifdef HAVE_X_WINDOWS 6163#ifdef HAVE_X_WINDOWS
1328 defsubr (&Spixmap_spec_p); 6164 defsubr (&Spixmap_spec_p);
1329#endif 6165 defsubr (&Sx_list_fonts);
6166 defsubr (&Sinternal_face_x_get_resource);
6167 defsubr (&Sx_font_list);
6168 defsubr (&Sx_font_family_list);
6169#endif /* HAVE_X_WINDOWS */
1330 6170
1331 defsubr (&Sframe_face_alist); 6171 /* TTY face support. */
1332 defsubr (&Sset_frame_face_alist); 6172 defsubr (&Sface_register_tty_color);
1333 defsubr (&Sinternal_next_face_id); 6173 defsubr (&Sface_clear_tty_colors);
6174 defsubr (&Stty_defined_colors);
6175 Vface_tty_color_alist = Qnil;
6176 staticpro (&Vface_tty_color_alist);
1334} 6177}