17052
|
1 /* Fontset handler.
|
28223
|
2 Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
|
18341
|
3 Licensed to the Free Software Foundation.
|
64770
|
4 Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
|
17052
|
5
|
17071
|
6 This file is part of GNU Emacs.
|
|
7
|
|
8 GNU Emacs is free software; you can redistribute it and/or modify
|
|
9 it under the terms of the GNU General Public License as published by
|
|
10 the Free Software Foundation; either version 2, or (at your option)
|
|
11 any later version.
|
17052
|
12
|
17071
|
13 GNU Emacs is distributed in the hope that it will be useful,
|
|
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
16 GNU General Public License for more details.
|
17052
|
17
|
17071
|
18 You should have received a copy of the GNU General Public License
|
|
19 along with GNU Emacs; see the file COPYING. If not, write to
|
64084
|
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
21 Boston, MA 02110-1301, USA. */
|
17052
|
22
|
28223
|
23 /* #define FONTSET_DEBUG */
|
|
24
|
17052
|
25 #include <config.h>
|
28223
|
26
|
|
27 #ifdef FONTSET_DEBUG
|
|
28 #include <stdio.h>
|
|
29 #endif
|
|
30
|
17052
|
31 #include "lisp.h"
|
28963
|
32 #include "buffer.h"
|
17052
|
33 #include "charset.h"
|
|
34 #include "ccl.h"
|
31102
|
35 #include "keyboard.h"
|
23517
|
36 #include "frame.h"
|
28223
|
37 #include "dispextern.h"
|
17052
|
38 #include "fontset.h"
|
28223
|
39 #include "window.h"
|
52654
|
40 #ifdef HAVE_X_WINDOWS
|
|
41 #include "xterm.h"
|
|
42 #endif
|
|
43 #ifdef WINDOWSNT
|
|
44 #include "w32term.h"
|
|
45 #endif
|
|
46 #ifdef MAC_OS
|
|
47 #include "macterm.h"
|
|
48 #endif
|
28223
|
49
|
|
50 #ifdef FONTSET_DEBUG
|
|
51 #undef xassert
|
|
52 #define xassert(X) do {if (!(X)) abort ();} while (0)
|
|
53 #undef INLINE
|
|
54 #define INLINE
|
|
55 #endif
|
|
56
|
|
57
|
|
58 /* FONTSET
|
|
59
|
|
60 A fontset is a collection of font related information to give
|
|
61 similar appearance (style, size, etc) of characters. There are two
|
|
62 kinds of fontsets; base and realized. A base fontset is created by
|
|
63 new-fontset from Emacs Lisp explicitly. A realized fontset is
|
|
64 created implicitly when a face is realized for ASCII characters. A
|
|
65 face is also realized for multibyte characters based on an ASCII
|
|
66 face. All of the multibyte faces based on the same ASCII face
|
|
67 share the same realized fontset.
|
41987
|
68
|
28223
|
69 A fontset object is implemented by a char-table.
|
|
70
|
|
71 An element of a base fontset is:
|
|
72 (INDEX . FONTNAME) or
|
|
73 (INDEX . (FOUNDRY . REGISTRY ))
|
|
74 FONTNAME is a font name pattern for the corresponding character.
|
41987
|
75 FOUNDRY and REGISTRY are respectively foundry and registry fields of
|
28223
|
76 a font name for the corresponding character. INDEX specifies for
|
|
77 which character (or generic character) the element is defined. It
|
|
78 may be different from an index to access this element. For
|
|
79 instance, if a fontset defines some font for all characters of
|
|
80 charset `japanese-jisx0208', INDEX is the generic character of this
|
|
81 charset. REGISTRY is the
|
|
82
|
|
83 An element of a realized fontset is FACE-ID which is a face to use
|
41987
|
84 for displaying the corresponding character.
|
28223
|
85
|
41987
|
86 All single byte characters (ASCII and 8bit-unibyte) share the same
|
29767
|
87 element in a fontset. The element is stored in the first element
|
|
88 of the fontset.
|
28223
|
89
|
|
90 To access or set each element, use macros FONTSET_REF and
|
|
91 FONTSET_SET respectively for efficiency.
|
|
92
|
|
93 A fontset has 3 extra slots.
|
17052
|
94
|
28223
|
95 The 1st slot is an ID number of the fontset.
|
|
96
|
|
97 The 2nd slot is a name of the fontset. This is nil for a realized
|
|
98 face.
|
|
99
|
|
100 The 3rd slot is a frame that the fontset belongs to. This is nil
|
|
101 for a default face.
|
|
102
|
|
103 A parent of a base fontset is nil. A parent of a realized fontset
|
|
104 is a base fontset.
|
|
105
|
30398
|
106 All fontsets are recorded in Vfontset_table.
|
28223
|
107
|
|
108
|
|
109 DEFAULT FONTSET
|
|
110
|
|
111 There's a special fontset named `default fontset' which defines a
|
30398
|
112 default fontname pattern. When a base fontset doesn't specify a
|
|
113 font for a specific character, the corresponding value in the
|
|
114 default fontset is used. The format is the same as a base fontset.
|
28223
|
115
|
30398
|
116 The parent of a realized fontset created for such a face that has
|
|
117 no fontset is the default fontset.
|
28223
|
118
|
|
119
|
|
120 These structures are hidden from the other codes than this file.
|
|
121 The other codes handle fontsets only by their ID numbers. They
|
|
122 usually use variable name `fontset' for IDs. But, in this file, we
|
41987
|
123 always use variable name `id' for IDs, and name `fontset' for the
|
28223
|
124 actual fontset objects.
|
|
125
|
|
126 */
|
|
127
|
|
128 /********** VARIABLES and FUNCTION PROTOTYPES **********/
|
|
129
|
|
130 extern Lisp_Object Qfont;
|
|
131 Lisp_Object Qfontset;
|
|
132
|
|
133 /* Vector containing all fontsets. */
|
|
134 static Lisp_Object Vfontset_table;
|
|
135
|
41987
|
136 /* Next possibly free fontset ID. Usually this keeps the minimum
|
28223
|
137 fontset ID not yet used. */
|
|
138 static int next_fontset_id;
|
|
139
|
|
140 /* The default fontset. This gives default FAMILY and REGISTRY of
|
|
141 font for each characters. */
|
|
142 static Lisp_Object Vdefault_fontset;
|
|
143
|
53353
|
144 /* Alist of font specifications. It override the font specification
|
|
145 in the default fontset. */
|
|
146 static Lisp_Object Voverriding_fontspec_alist;
|
|
147
|
17052
|
148 Lisp_Object Vfont_encoding_alist;
|
17112
|
149 Lisp_Object Vuse_default_ascent;
|
19282
|
150 Lisp_Object Vignore_relative_composition;
|
19450
|
151 Lisp_Object Valternate_fontname_alist;
|
17730
|
152 Lisp_Object Vfontset_alias_alist;
|
26858
|
153 Lisp_Object Vvertical_centering_font_regexp;
|
17052
|
154
|
28223
|
155 /* The following six are declarations of callback functions depending
|
|
156 on window system. See the comments in src/fontset.h for more
|
|
157 detail. */
|
17052
|
158
|
|
159 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
|
20315
|
160 struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx));
|
17052
|
161
|
41987
|
162 /* Return a list of font names which matches PATTERN. See the documentation
|
|
163 of `x-list-fonts' for more details. */
|
23517
|
164 Lisp_Object (*list_fonts_func) P_ ((struct frame *f,
|
|
165 Lisp_Object pattern,
|
|
166 int size,
|
|
167 int maxnames));
|
17052
|
168
|
|
169 /* Load a font named NAME for frame F and return a pointer to the
|
|
170 information of the loaded font. If loading is failed, return 0. */
|
20315
|
171 struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int));
|
17052
|
172
|
|
173 /* Return a pointer to struct font_info of a font named NAME for frame F. */
|
20315
|
174 struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name));
|
17052
|
175
|
|
176 /* Additional function for setting fontset or changing fontset
|
|
177 contents of frame F. */
|
20315
|
178 void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg,
|
|
179 Lisp_Object oldval));
|
17052
|
180
|
21553
|
181 /* To find a CCL program, fs_load_font calls this function.
|
|
182 The argument is a pointer to the struct font_info.
|
41987
|
183 This function set the member `encoder' of the structure. */
|
21553
|
184 void (*find_ccl_program_func) P_ ((struct font_info *));
|
|
185
|
17052
|
186 /* Check if any window system is used now. */
|
20315
|
187 void (*check_window_system_func) P_ ((void));
|
17052
|
188
|
28223
|
189
|
|
190 /* Prototype declarations for static functions. */
|
|
191 static Lisp_Object fontset_ref P_ ((Lisp_Object, int));
|
53353
|
192 static Lisp_Object lookup_overriding_fontspec P_ ((Lisp_Object, int));
|
28223
|
193 static void fontset_set P_ ((Lisp_Object, int, Lisp_Object));
|
|
194 static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
|
|
195 static int fontset_id_valid_p P_ ((int));
|
|
196 static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
|
35658
|
197 static Lisp_Object font_family_registry P_ ((Lisp_Object, int));
|
54995
|
198 static Lisp_Object regularize_fontname P_ ((Lisp_Object));
|
28223
|
199
|
|
200
|
|
201 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
|
|
202
|
|
203 /* Return the fontset with ID. No check of ID's validness. */
|
|
204 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
|
|
205
|
30398
|
206 /* Macros to access special values of FONTSET. */
|
28223
|
207 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
|
|
208 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
|
|
209 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
|
29767
|
210 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0]
|
28223
|
211 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
|
|
212
|
|
213 #define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
|
|
214
|
|
215
|
|
216 /* Return the element of FONTSET (char-table) at index C (character). */
|
|
217
|
|
218 #define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
|
|
219
|
30398
|
220 static Lisp_Object
|
28223
|
221 fontset_ref (fontset, c)
|
|
222 Lisp_Object fontset;
|
|
223 int c;
|
|
224 {
|
|
225 int charset, c1, c2;
|
|
226 Lisp_Object elt, defalt;
|
|
227
|
|
228 if (SINGLE_BYTE_CHAR_P (c))
|
|
229 return FONTSET_ASCII (fontset);
|
|
230
|
29011
|
231 SPLIT_CHAR (c, charset, c1, c2);
|
28223
|
232 elt = XCHAR_TABLE (fontset)->contents[charset + 128];
|
|
233 if (!SUB_CHAR_TABLE_P (elt))
|
|
234 return elt;
|
|
235 defalt = XCHAR_TABLE (elt)->defalt;
|
|
236 if (c1 < 32
|
|
237 || (elt = XCHAR_TABLE (elt)->contents[c1],
|
|
238 NILP (elt)))
|
|
239 return defalt;
|
|
240 if (!SUB_CHAR_TABLE_P (elt))
|
|
241 return elt;
|
|
242 defalt = XCHAR_TABLE (elt)->defalt;
|
|
243 if (c2 < 32
|
|
244 || (elt = XCHAR_TABLE (elt)->contents[c2],
|
|
245 NILP (elt)))
|
|
246 return defalt;
|
|
247 return elt;
|
|
248 }
|
|
249
|
|
250
|
53353
|
251 static Lisp_Object
|
|
252 lookup_overriding_fontspec (frame, c)
|
|
253 Lisp_Object frame;
|
|
254 int c;
|
|
255 {
|
|
256 Lisp_Object tail;
|
|
257
|
|
258 for (tail = Voverriding_fontspec_alist; CONSP (tail); tail = XCDR (tail))
|
|
259 {
|
|
260 Lisp_Object val, target, elt;
|
|
261
|
|
262 val = XCAR (tail);
|
|
263 target = XCAR (val);
|
|
264 val = XCDR (val);
|
|
265 /* Now VAL is (NO-FRAME-LIST OK-FRAME-LIST CHAR FONTNAME). */
|
|
266 if (NILP (Fmemq (frame, XCAR (val)))
|
|
267 && (CHAR_TABLE_P (target)
|
|
268 ? ! NILP (CHAR_TABLE_REF (target, c))
|
|
269 : XINT (target) == CHAR_CHARSET (c)))
|
|
270 {
|
|
271 val = XCDR (val);
|
|
272 elt = XCDR (val);
|
|
273 if (NILP (Fmemq (frame, XCAR (val))))
|
|
274 {
|
|
275 if (! face_font_available_p (XFRAME (frame), XCDR (elt)))
|
|
276 {
|
|
277 val = XCDR (XCAR (tail));
|
|
278 XSETCAR (val, Fcons (frame, XCAR (val)));
|
|
279 continue;
|
|
280 }
|
|
281 XSETCAR (val, Fcons (frame, XCAR (val)));
|
|
282 }
|
|
283 if (NILP (XCAR (elt)))
|
|
284 XSETCAR (elt, make_number (c));
|
|
285 return elt;
|
|
286 }
|
|
287 }
|
|
288 return Qnil;
|
|
289 }
|
|
290
|
28223
|
291 #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
|
|
292
|
30398
|
293 static Lisp_Object
|
28223
|
294 fontset_ref_via_base (fontset, c)
|
|
295 Lisp_Object fontset;
|
|
296 int *c;
|
|
297 {
|
|
298 int charset, c1, c2;
|
|
299 Lisp_Object elt;
|
|
300
|
|
301 if (SINGLE_BYTE_CHAR_P (*c))
|
|
302 return FONTSET_ASCII (fontset);
|
|
303
|
53353
|
304 elt = Qnil;
|
|
305 if (! EQ (FONTSET_BASE (fontset), Vdefault_fontset))
|
|
306 elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
|
|
307 if (NILP (elt))
|
|
308 elt = lookup_overriding_fontspec (FONTSET_FRAME (fontset), *c);
|
53524
|
309 if (NILP (elt))
|
29767
|
310 elt = FONTSET_REF (Vdefault_fontset, *c);
|
28223
|
311 if (NILP (elt))
|
|
312 return Qnil;
|
|
313
|
|
314 *c = XINT (XCAR (elt));
|
29011
|
315 SPLIT_CHAR (*c, charset, c1, c2);
|
28223
|
316 elt = XCHAR_TABLE (fontset)->contents[charset + 128];
|
|
317 if (c1 < 32)
|
|
318 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
|
|
319 if (!SUB_CHAR_TABLE_P (elt))
|
|
320 return Qnil;
|
|
321 elt = XCHAR_TABLE (elt)->contents[c1];
|
|
322 if (c2 < 32)
|
|
323 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
|
|
324 if (!SUB_CHAR_TABLE_P (elt))
|
|
325 return Qnil;
|
|
326 elt = XCHAR_TABLE (elt)->contents[c2];
|
|
327 return elt;
|
|
328 }
|
|
329
|
|
330
|
30398
|
331 /* Store into the element of FONTSET at index C the value NEWELT. */
|
28223
|
332 #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
|
|
333
|
|
334 static void
|
|
335 fontset_set (fontset, c, newelt)
|
|
336 Lisp_Object fontset;
|
|
337 int c;
|
|
338 Lisp_Object newelt;
|
17052
|
339 {
|
28223
|
340 int charset, code[3];
|
34975
|
341 Lisp_Object *elt;
|
|
342 int i;
|
28223
|
343
|
|
344 if (SINGLE_BYTE_CHAR_P (c))
|
|
345 {
|
|
346 FONTSET_ASCII (fontset) = newelt;
|
|
347 return;
|
|
348 }
|
|
349
|
29011
|
350 SPLIT_CHAR (c, charset, code[0], code[1]);
|
28223
|
351 code[2] = 0; /* anchor */
|
|
352 elt = &XCHAR_TABLE (fontset)->contents[charset + 128];
|
|
353 for (i = 0; code[i] > 0; i++)
|
|
354 {
|
|
355 if (!SUB_CHAR_TABLE_P (*elt))
|
61736
|
356 {
|
|
357 Lisp_Object val = *elt;
|
61823
|
358 *elt = make_sub_char_table (Qnil);
|
61736
|
359 XCHAR_TABLE (*elt)->defalt = val;
|
|
360 }
|
28223
|
361 elt = &XCHAR_TABLE (*elt)->contents[code[i]];
|
|
362 }
|
|
363 if (SUB_CHAR_TABLE_P (*elt))
|
|
364 XCHAR_TABLE (*elt)->defalt = newelt;
|
|
365 else
|
|
366 *elt = newelt;
|
|
367 }
|
|
368
|
|
369
|
|
370 /* Return a newly created fontset with NAME. If BASE is nil, make a
|
|
371 base fontset. Otherwise make a realized fontset whose parent is
|
|
372 BASE. */
|
|
373
|
|
374 static Lisp_Object
|
|
375 make_fontset (frame, name, base)
|
|
376 Lisp_Object frame, name, base;
|
|
377 {
|
34975
|
378 Lisp_Object fontset;
|
28223
|
379 int size = ASIZE (Vfontset_table);
|
|
380 int id = next_fontset_id;
|
|
381
|
|
382 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
|
|
383 the next available fontset ID. So it is expected that this loop
|
|
384 terminates quickly. In addition, as the last element of
|
41987
|
385 Vfontset_table is always nil, we don't have to check the range of
|
28223
|
386 id. */
|
|
387 while (!NILP (AREF (Vfontset_table, id))) id++;
|
|
388
|
|
389 if (id + 1 == size)
|
|
390 {
|
|
391 Lisp_Object tem;
|
41987
|
392 int i;
|
28223
|
393
|
|
394 tem = Fmake_vector (make_number (size + 8), Qnil);
|
|
395 for (i = 0; i < size; i++)
|
|
396 AREF (tem, i) = AREF (Vfontset_table, i);
|
|
397 Vfontset_table = tem;
|
|
398 }
|
|
399
|
29767
|
400 fontset = Fmake_char_table (Qfontset, Qnil);
|
28223
|
401
|
|
402 FONTSET_ID (fontset) = make_number (id);
|
|
403 FONTSET_NAME (fontset) = name;
|
|
404 FONTSET_FRAME (fontset) = frame;
|
|
405 FONTSET_BASE (fontset) = base;
|
17052
|
406
|
28223
|
407 AREF (Vfontset_table, id) = fontset;
|
|
408 next_fontset_id = id + 1;
|
|
409 return fontset;
|
|
410 }
|
|
411
|
|
412
|
|
413 /* Return 1 if ID is a valid fontset id, else return 0. */
|
|
414
|
|
415 static INLINE int
|
|
416 fontset_id_valid_p (id)
|
|
417 int id;
|
|
418 {
|
|
419 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
|
|
420 }
|
|
421
|
|
422
|
35658
|
423 /* Extract `family' and `registry' string from FONTNAME and a cons of
|
|
424 them. Actually, `family' may also contain `foundry', `registry'
|
|
425 may also contain `encoding' of FONTNAME. But, if FONTNAME doesn't
|
|
426 conform to XLFD nor explicitely specifies the other fields
|
|
427 (i.e. not using wildcard `*'), return FONTNAME. If FORCE is
|
|
428 nonzero, specifications of the other fields are ignored, and return
|
|
429 a cons as far as FONTNAME conform to XLFD. */
|
28223
|
430
|
|
431 static Lisp_Object
|
35658
|
432 font_family_registry (fontname, force)
|
28223
|
433 Lisp_Object fontname;
|
35658
|
434 int force;
|
28223
|
435 {
|
|
436 Lisp_Object family, registry;
|
46466
|
437 const char *p = SDATA (fontname);
|
|
438 const char *sep[15];
|
28223
|
439 int i = 0;
|
41987
|
440
|
35658
|
441 while (*p && i < 15)
|
|
442 if (*p++ == '-')
|
|
443 {
|
|
444 if (!force && i >= 2 && i <= 11 && *p != '*' && p[1] != '-')
|
|
445 return fontname;
|
|
446 sep[i++] = p;
|
|
447 }
|
28223
|
448 if (i != 14)
|
|
449 return fontname;
|
17052
|
450
|
28223
|
451 family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);
|
|
452 registry = make_unibyte_string (sep[12], p - sep[12]);
|
|
453 return Fcons (family, registry);
|
17052
|
454 }
|
|
455
|
28223
|
456
|
41987
|
457 /********** INTERFACES TO xfaces.c and dispextern.h **********/
|
28223
|
458
|
|
459 /* Return name of the fontset with ID. */
|
|
460
|
|
461 Lisp_Object
|
|
462 fontset_name (id)
|
|
463 int id;
|
|
464 {
|
|
465 Lisp_Object fontset;
|
|
466 fontset = FONTSET_FROM_ID (id);
|
|
467 return FONTSET_NAME (fontset);
|
|
468 }
|
|
469
|
|
470
|
|
471 /* Return ASCII font name of the fontset with ID. */
|
|
472
|
|
473 Lisp_Object
|
|
474 fontset_ascii (id)
|
|
475 int id;
|
|
476 {
|
|
477 Lisp_Object fontset, elt;
|
|
478 fontset= FONTSET_FROM_ID (id);
|
|
479 elt = FONTSET_ASCII (fontset);
|
|
480 return XCDR (elt);
|
|
481 }
|
|
482
|
|
483
|
|
484 /* Free fontset of FACE. Called from free_realized_face. */
|
|
485
|
17052
|
486 void
|
28223
|
487 free_face_fontset (f, face)
|
|
488 FRAME_PTR f;
|
|
489 struct face *face;
|
17052
|
490 {
|
28223
|
491 if (fontset_id_valid_p (face->fontset))
|
17052
|
492 {
|
28223
|
493 AREF (Vfontset_table, face->fontset) = Qnil;
|
|
494 if (face->fontset < next_fontset_id)
|
|
495 next_fontset_id = face->fontset;
|
|
496 }
|
|
497 }
|
|
498
|
|
499
|
|
500 /* Return 1 iff FACE is suitable for displaying character C.
|
|
501 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
|
|
502 when C is not a single byte character.. */
|
|
503
|
|
504 int
|
|
505 face_suitable_for_char_p (face, c)
|
|
506 struct face *face;
|
|
507 int c;
|
|
508 {
|
|
509 Lisp_Object fontset, elt;
|
|
510
|
|
511 if (SINGLE_BYTE_CHAR_P (c))
|
|
512 return (face == face->ascii_face);
|
|
513
|
|
514 xassert (fontset_id_valid_p (face->fontset));
|
|
515 fontset = FONTSET_FROM_ID (face->fontset);
|
|
516 xassert (!BASE_FONTSET_P (fontset));
|
17052
|
517
|
28223
|
518 elt = FONTSET_REF_VIA_BASE (fontset, c);
|
|
519 return (!NILP (elt) && face->id == XFASTINT (elt));
|
|
520 }
|
|
521
|
|
522
|
|
523 /* Return ID of face suitable for displaying character C on frame F.
|
|
524 The selection of face is done based on the fontset of FACE. FACE
|
|
525 should already have been realized for ASCII characters. Called
|
|
526 from the macro FACE_FOR_CHAR when C is not a single byte character. */
|
17052
|
527
|
28223
|
528 int
|
|
529 face_for_char (f, face, c)
|
|
530 FRAME_PTR f;
|
|
531 struct face *face;
|
|
532 int c;
|
|
533 {
|
|
534 Lisp_Object fontset, elt;
|
|
535 int face_id;
|
|
536
|
|
537 xassert (fontset_id_valid_p (face->fontset));
|
|
538 fontset = FONTSET_FROM_ID (face->fontset);
|
|
539 xassert (!BASE_FONTSET_P (fontset));
|
|
540
|
|
541 elt = FONTSET_REF_VIA_BASE (fontset, c);
|
|
542 if (!NILP (elt))
|
|
543 return XINT (elt);
|
|
544
|
|
545 /* No face is recorded for C in the fontset of FACE. Make a new
|
|
546 realized face for C that has the same fontset. */
|
|
547 face_id = lookup_face (f, face->lface, c, face);
|
41987
|
548
|
28223
|
549 /* Record the face ID in FONTSET at the same index as the
|
|
550 information in the base fontset. */
|
|
551 FONTSET_SET (fontset, c, make_number (face_id));
|
|
552 return face_id;
|
17052
|
553 }
|
|
554
|
28223
|
555
|
|
556 /* Make a realized fontset for ASCII face FACE on frame F from the
|
|
557 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
|
|
558 default fontset as the base. Value is the id of the new fontset.
|
|
559 Called from realize_x_face. */
|
|
560
|
|
561 int
|
|
562 make_fontset_for_ascii_face (f, base_fontset_id)
|
|
563 FRAME_PTR f;
|
|
564 int base_fontset_id;
|
|
565 {
|
34975
|
566 Lisp_Object base_fontset, fontset, frame;
|
28223
|
567
|
|
568 XSETFRAME (frame, f);
|
|
569 if (base_fontset_id >= 0)
|
|
570 {
|
|
571 base_fontset = FONTSET_FROM_ID (base_fontset_id);
|
|
572 if (!BASE_FONTSET_P (base_fontset))
|
|
573 base_fontset = FONTSET_BASE (base_fontset);
|
|
574 xassert (BASE_FONTSET_P (base_fontset));
|
|
575 }
|
|
576 else
|
|
577 base_fontset = Vdefault_fontset;
|
|
578
|
|
579 fontset = make_fontset (frame, Qnil, base_fontset);
|
28511
|
580 return XINT (FONTSET_ID (fontset));
|
28223
|
581 }
|
|
582
|
|
583
|
|
584 /* Return the font name pattern for C that is recorded in the fontset
|
35658
|
585 with ID. If a font name pattern is specified (instead of a cons of
|
|
586 family and registry), check if a font can be opened by that pattern
|
|
587 to get the fullname. If a font is opened, return that name.
|
|
588 Otherwise, return nil. If ID is -1, or the fontset doesn't contain
|
28223
|
589 information about C, get the registry and encoding of C from the
|
|
590 default fontset. Called from choose_face_font. */
|
18346
|
591
|
28223
|
592 Lisp_Object
|
|
593 fontset_font_pattern (f, id, c)
|
|
594 FRAME_PTR f;
|
|
595 int id, c;
|
|
596 {
|
|
597 Lisp_Object fontset, elt;
|
|
598 struct font_info *fontp;
|
41987
|
599
|
28223
|
600 elt = Qnil;
|
|
601 if (fontset_id_valid_p (id))
|
|
602 {
|
|
603 fontset = FONTSET_FROM_ID (id);
|
|
604 xassert (!BASE_FONTSET_P (fontset));
|
|
605 fontset = FONTSET_BASE (fontset);
|
53622
|
606 if (! EQ (fontset, Vdefault_fontset))
|
|
607 elt = FONTSET_REF (fontset, c);
|
28223
|
608 }
|
29767
|
609 if (NILP (elt))
|
53353
|
610 {
|
|
611 Lisp_Object frame;
|
|
612
|
|
613 XSETFRAME (frame, f);
|
|
614 elt = lookup_overriding_fontspec (frame, c);
|
|
615 }
|
|
616 if (NILP (elt))
|
28223
|
617 elt = FONTSET_REF (Vdefault_fontset, c);
|
|
618
|
|
619 if (!CONSP (elt))
|
|
620 return Qnil;
|
|
621 if (CONSP (XCDR (elt)))
|
|
622 return XCDR (elt);
|
|
623
|
|
624 /* The fontset specifies only a font name pattern (not cons of
|
35658
|
625 family and registry). If a font can be opened by that pattern,
|
|
626 return the name of opened font. Otherwise return nil. The
|
|
627 exception is a font for single byte characters. In that case, we
|
|
628 return a cons of FAMILY and REGISTRY extracted from the opened
|
|
629 font name. */
|
28223
|
630 elt = XCDR (elt);
|
|
631 xassert (STRINGP (elt));
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
632 fontp = FS_LOAD_FONT (f, c, SDATA (elt), -1);
|
28223
|
633 if (!fontp)
|
|
634 return Qnil;
|
|
635
|
35658
|
636 return font_family_registry (build_string (fontp->full_name),
|
|
637 SINGLE_BYTE_CHAR_P (c));
|
28223
|
638 }
|
|
639
|
|
640
|
40028
|
641 #if defined(WINDOWSNT) && defined (_MSC_VER)
|
|
642 #pragma optimize("", off)
|
|
643 #endif
|
|
644
|
28223
|
645 /* Load a font named FONTNAME to display character C on frame F.
|
|
646 Return a pointer to the struct font_info of the loaded font. If
|
|
647 loading fails, return NULL. If FACE is non-zero and a fontset is
|
|
648 assigned to it, record FACE->id in the fontset for C. If FONTNAME
|
|
649 is NULL, the name is taken from the fontset of FACE or what
|
|
650 specified by ID. */
|
17052
|
651
|
|
652 struct font_info *
|
28223
|
653 fs_load_font (f, c, fontname, id, face)
|
17052
|
654 FRAME_PTR f;
|
28223
|
655 int c;
|
17052
|
656 char *fontname;
|
28223
|
657 int id;
|
|
658 struct face *face;
|
17052
|
659 {
|
28223
|
660 Lisp_Object fontset;
|
57573
|
661 Lisp_Object list, elt, fullname;
|
17052
|
662 int size = 0;
|
|
663 struct font_info *fontp;
|
28223
|
664 int charset = CHAR_CHARSET (c);
|
17052
|
665
|
28223
|
666 if (face)
|
|
667 id = face->fontset;
|
|
668 if (id < 0)
|
|
669 fontset = Qnil;
|
|
670 else
|
|
671 fontset = FONTSET_FROM_ID (id);
|
|
672
|
|
673 if (!NILP (fontset)
|
|
674 && !BASE_FONTSET_P (fontset))
|
17052
|
675 {
|
28223
|
676 elt = FONTSET_REF_VIA_BASE (fontset, c);
|
|
677 if (!NILP (elt))
|
|
678 {
|
|
679 /* A suitable face for C is already recorded, which means
|
|
680 that a proper font is already loaded. */
|
|
681 int face_id = XINT (elt);
|
|
682
|
|
683 xassert (face_id == face->id);
|
|
684 face = FACE_FROM_ID (f, face_id);
|
|
685 return (*get_font_info_func) (f, face->font_info_id);
|
|
686 }
|
|
687
|
|
688 if (!fontname && charset == CHARSET_ASCII)
|
|
689 {
|
|
690 elt = FONTSET_ASCII (fontset);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
691 fontname = SDATA (XCDR (elt));
|
28223
|
692 }
|
17052
|
693 }
|
|
694
|
|
695 if (!fontname)
|
|
696 /* No way to get fontname. */
|
|
697 return 0;
|
|
698
|
28223
|
699 fontp = (*load_font_func) (f, fontname, size);
|
|
700 if (!fontp)
|
|
701 return 0;
|
17052
|
702
|
28223
|
703 /* Fill in members (charset, vertical_centering, encoding, etc) of
|
|
704 font_info structure that are not set by (*load_font_func). */
|
17052
|
705 fontp->charset = charset;
|
|
706
|
57573
|
707 fullname = build_string (fontp->full_name);
|
26858
|
708 fontp->vertical_centering
|
|
709 = (STRINGP (Vvertical_centering_font_regexp)
|
57573
|
710 && (fast_string_match_ignore_case
|
|
711 (Vvertical_centering_font_regexp, fullname) >= 0));
|
26858
|
712
|
17999
|
713 if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
|
17052
|
714 {
|
|
715 /* The font itself tells which code points to be used. Use this
|
|
716 encoding for all other charsets. */
|
|
717 int i;
|
|
718
|
|
719 fontp->encoding[0] = fontp->encoding[1];
|
17190
|
720 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
|
17052
|
721 fontp->encoding[i] = fontp->encoding[1];
|
|
722 }
|
|
723 else
|
|
724 {
|
28223
|
725 /* The font itself doesn't have information about encoding. */
|
17052
|
726 int i;
|
|
727
|
28766
|
728 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
|
|
729 others is 1 (i.e. 0x80..0xFF). */
|
|
730 fontp->encoding[0] = 0;
|
17190
|
731 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
|
17052
|
732 fontp->encoding[i] = 1;
|
|
733 /* Then override them by a specification in Vfont_encoding_alist. */
|
26164
|
734 for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list))
|
17052
|
735 {
|
26164
|
736 elt = XCAR (list);
|
17052
|
737 if (CONSP (elt)
|
26164
|
738 && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
|
57573
|
739 && (fast_string_match_ignore_case (XCAR (elt), fullname) >= 0))
|
17052
|
740 {
|
|
741 Lisp_Object tmp;
|
|
742
|
26164
|
743 for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp))
|
|
744 if (CONSP (XCAR (tmp))
|
|
745 && ((i = get_charset_id (XCAR (XCAR (tmp))))
|
17052
|
746 >= 0)
|
26164
|
747 && INTEGERP (XCDR (XCAR (tmp)))
|
|
748 && XFASTINT (XCDR (XCAR (tmp))) < 4)
|
17052
|
749 fontp->encoding[i]
|
26164
|
750 = XFASTINT (XCDR (XCAR (tmp)));
|
17052
|
751 }
|
|
752 }
|
|
753 }
|
|
754
|
52729
|
755 if (! fontp->font_encoder && find_ccl_program_func)
|
21553
|
756 (*find_ccl_program_func) (fontp);
|
17052
|
757
|
28963
|
758 /* If we loaded a font for a face that has fontset, record the face
|
|
759 ID in the fontset for C. */
|
|
760 if (face
|
|
761 && !NILP (fontset)
|
|
762 && !BASE_FONTSET_P (fontset))
|
|
763 FONTSET_SET (fontset, c, make_number (face->id));
|
17052
|
764 return fontp;
|
|
765 }
|
|
766
|
40028
|
767 #if defined(WINDOWSNT) && defined (_MSC_VER)
|
|
768 #pragma optimize("", on)
|
|
769 #endif
|
|
770
|
60511
|
771 /* Set the ASCII font of the default fontset to FONTNAME if that is
|
|
772 not yet set. */
|
|
773 void
|
|
774 set_default_ascii_font (fontname)
|
|
775 Lisp_Object fontname;
|
|
776 {
|
|
777 if (! CONSP (FONTSET_ASCII (Vdefault_fontset)))
|
|
778 {
|
|
779 int id = fs_query_fontset (fontname, 2);
|
|
780
|
|
781 if (id >= 0)
|
|
782 fontname = XCDR (FONTSET_ASCII (FONTSET_FROM_ID (id)));
|
|
783 FONTSET_ASCII (Vdefault_fontset)
|
|
784 = Fcons (make_number (0), fontname);
|
|
785 }
|
|
786 }
|
|
787
|
28223
|
788
|
17052
|
789 /* Cache data used by fontset_pattern_regexp. The car part is a
|
|
790 pattern string containing at least one wild card, the cdr part is
|
|
791 the corresponding regular expression. */
|
|
792 static Lisp_Object Vcached_fontset_data;
|
|
793
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
794 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
|
26164
|
795 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
|
17052
|
796
|
|
797 /* If fontset name PATTERN contains any wild card, return regular
|
|
798 expression corresponding to PATTERN. */
|
|
799
|
28223
|
800 static Lisp_Object
|
17052
|
801 fontset_pattern_regexp (pattern)
|
|
802 Lisp_Object pattern;
|
|
803 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
804 if (!index (SDATA (pattern), '*')
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
805 && !index (SDATA (pattern), '?'))
|
17052
|
806 /* PATTERN does not contain any wild cards. */
|
17730
|
807 return Qnil;
|
17052
|
808
|
|
809 if (!CONSP (Vcached_fontset_data)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
810 || strcmp (SDATA (pattern), CACHED_FONTSET_NAME))
|
17052
|
811 {
|
|
812 /* We must at first update the cached data. */
|
57947
|
813 unsigned char *regex, *p0, *p1;
|
57685
|
814 int ndashes = 0, nstars = 0;
|
57947
|
815
|
57685
|
816 for (p0 = SDATA (pattern); *p0; p0++)
|
|
817 {
|
|
818 if (*p0 == '-')
|
|
819 ndashes++;
|
58025
|
820 else if (*p0 == '*')
|
57685
|
821 nstars++;
|
|
822 }
|
17052
|
823
|
57685
|
824 /* If PATTERN is not full XLFD we conert "*" to ".*". Otherwise
|
|
825 we convert "*" to "[^-]*" which is much faster in regular
|
|
826 expression matching. */
|
|
827 if (ndashes < 14)
|
57947
|
828 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 1);
|
57685
|
829 else
|
57947
|
830 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 1);
|
57685
|
831
|
17730
|
832 *p1++ = '^';
|
57947
|
833 for (p0 = SDATA (pattern); *p0; p0++)
|
17052
|
834 {
|
58025
|
835 if (*p0 == '*')
|
17052
|
836 {
|
57685
|
837 if (ndashes < 14)
|
|
838 *p1++ = '.';
|
|
839 else
|
|
840 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
|
17730
|
841 *p1++ = '*';
|
17052
|
842 }
|
17730
|
843 else if (*p0 == '?')
|
21127
|
844 *p1++ = '.';
|
17730
|
845 else
|
|
846 *p1++ = *p0;
|
17052
|
847 }
|
|
848 *p1++ = '$';
|
|
849 *p1++ = 0;
|
|
850
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
851 Vcached_fontset_data = Fcons (build_string (SDATA (pattern)),
|
17052
|
852 build_string (regex));
|
|
853 }
|
|
854
|
|
855 return CACHED_FONTSET_REGEX;
|
|
856 }
|
|
857
|
28223
|
858 /* Return ID of the base fontset named NAME. If there's no such
|
58025
|
859 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
|
|
860 0: pattern containing '*' and '?' as wildcards
|
|
861 1: regular expression
|
|
862 2: literal fontset name
|
|
863 */
|
28223
|
864
|
|
865 int
|
58025
|
866 fs_query_fontset (name, name_pattern)
|
28223
|
867 Lisp_Object name;
|
58025
|
868 int name_pattern;
|
28223
|
869 {
|
34975
|
870 Lisp_Object tem;
|
28223
|
871 int i;
|
|
872
|
|
873 name = Fdowncase (name);
|
58025
|
874 if (name_pattern != 1)
|
28223
|
875 {
|
|
876 tem = Frassoc (name, Vfontset_alias_alist);
|
|
877 if (CONSP (tem) && STRINGP (XCAR (tem)))
|
|
878 name = XCAR (tem);
|
58025
|
879 else if (name_pattern == 0)
|
28223
|
880 {
|
|
881 tem = fontset_pattern_regexp (name);
|
|
882 if (STRINGP (tem))
|
|
883 {
|
|
884 name = tem;
|
58025
|
885 name_pattern = 1;
|
28223
|
886 }
|
|
887 }
|
|
888 }
|
|
889
|
|
890 for (i = 0; i < ASIZE (Vfontset_table); i++)
|
|
891 {
|
57573
|
892 Lisp_Object fontset, this_name;
|
28223
|
893
|
|
894 fontset = FONTSET_FROM_ID (i);
|
|
895 if (NILP (fontset)
|
|
896 || !BASE_FONTSET_P (fontset))
|
|
897 continue;
|
|
898
|
57573
|
899 this_name = FONTSET_NAME (fontset);
|
58025
|
900 if (name_pattern == 1
|
57573
|
901 ? fast_string_match (name, this_name) >= 0
|
|
902 : !strcmp (SDATA (name), SDATA (this_name)))
|
28223
|
903 return i;
|
|
904 }
|
|
905 return -1;
|
|
906 }
|
|
907
|
|
908
|
21553
|
909 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
|
41001
|
910 doc: /* Return the name of a fontset that matches PATTERN.
|
|
911 The value is nil if there is no matching fontset.
|
|
912 PATTERN can contain `*' or `?' as a wildcard
|
|
913 just as X font name matching algorithm allows.
|
|
914 If REGEXPP is non-nil, PATTERN is a regular expression. */)
|
|
915 (pattern, regexpp)
|
21553
|
916 Lisp_Object pattern, regexpp;
|
17052
|
917 {
|
28223
|
918 Lisp_Object fontset;
|
|
919 int id;
|
17052
|
920
|
|
921 (*check_window_system_func) ();
|
|
922
|
40656
|
923 CHECK_STRING (pattern);
|
17052
|
924
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
925 if (SCHARS (pattern) == 0)
|
17052
|
926 return Qnil;
|
|
927
|
28223
|
928 id = fs_query_fontset (pattern, !NILP (regexpp));
|
|
929 if (id < 0)
|
|
930 return Qnil;
|
17052
|
931
|
28223
|
932 fontset = FONTSET_FROM_ID (id);
|
|
933 return FONTSET_NAME (fontset);
|
17052
|
934 }
|
|
935
|
28223
|
936 /* Return a list of base fontset names matching PATTERN on frame F.
|
|
937 If SIZE is not 0, it is the size (maximum bound width) of fontsets
|
41987
|
938 to be listed. */
|
17052
|
939
|
|
940 Lisp_Object
|
|
941 list_fontsets (f, pattern, size)
|
|
942 FRAME_PTR f;
|
|
943 Lisp_Object pattern;
|
|
944 int size;
|
|
945 {
|
34975
|
946 Lisp_Object frame, regexp, val;
|
28223
|
947 int id;
|
|
948
|
|
949 XSETFRAME (frame, f);
|
17052
|
950
|
|
951 regexp = fontset_pattern_regexp (pattern);
|
28223
|
952 val = Qnil;
|
17052
|
953
|
28223
|
954 for (id = 0; id < ASIZE (Vfontset_table); id++)
|
17052
|
955 {
|
57573
|
956 Lisp_Object fontset, name;
|
17052
|
957
|
28223
|
958 fontset = FONTSET_FROM_ID (id);
|
|
959 if (NILP (fontset)
|
|
960 || !BASE_FONTSET_P (fontset)
|
|
961 || !EQ (frame, FONTSET_FRAME (fontset)))
|
|
962 continue;
|
57573
|
963 name = FONTSET_NAME (fontset);
|
17052
|
964
|
28223
|
965 if (!NILP (regexp)
|
57573
|
966 ? (fast_string_match (regexp, name) < 0)
|
|
967 : strcmp (SDATA (pattern), SDATA (name)))
|
28223
|
968 continue;
|
|
969
|
|
970 if (size)
|
17052
|
971 {
|
28223
|
972 struct font_info *fontp;
|
|
973 fontp = FS_LOAD_FONT (f, 0, NULL, id);
|
|
974 if (!fontp || size != fontp->size)
|
|
975 continue;
|
17052
|
976 }
|
28223
|
977 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
|
17052
|
978 }
|
|
979
|
|
980 return val;
|
|
981 }
|
|
982
|
|
983 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
|
41001
|
984 doc: /* Create a new fontset NAME that contains font information in FONTLIST.
|
|
985 FONTLIST is an alist of charsets vs corresponding font name patterns. */)
|
|
986 (name, fontlist)
|
17052
|
987 Lisp_Object name, fontlist;
|
|
988 {
|
28223
|
989 Lisp_Object fontset, elements, ascii_font;
|
|
990 Lisp_Object tem, tail, elt;
|
58025
|
991 int id;
|
17052
|
992
|
|
993 (*check_window_system_func) ();
|
|
994
|
40656
|
995 CHECK_STRING (name);
|
|
996 CHECK_LIST (fontlist);
|
17052
|
997
|
28223
|
998 name = Fdowncase (name);
|
58025
|
999 id = fs_query_fontset (name, 2);
|
|
1000 if (id >= 0)
|
|
1001 {
|
|
1002 fontset = FONTSET_FROM_ID (id);
|
|
1003 tem = FONTSET_NAME (fontset);
|
|
1004 error ("Fontset `%s' matches the existing fontset `%s'",
|
|
1005 SDATA (name), SDATA (tem));
|
|
1006 }
|
17052
|
1007
|
28223
|
1008 /* Check the validity of FONTLIST while creating a template for
|
|
1009 fontset elements. */
|
|
1010 elements = ascii_font = Qnil;
|
26164
|
1011 for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
|
17052
|
1012 {
|
28223
|
1013 int c, charset;
|
17052
|
1014
|
28223
|
1015 tem = XCAR (tail);
|
17052
|
1016 if (!CONSP (tem)
|
26164
|
1017 || (charset = get_charset_id (XCAR (tem))) < 0
|
36370
|
1018 || (!STRINGP (XCDR (tem)) && !CONSP (XCDR (tem))))
|
|
1019 error ("Elements of fontlist must be a cons of charset and font name pattern");
|
28223
|
1020
|
36370
|
1021 tem = XCDR (tem);
|
|
1022 if (STRINGP (tem))
|
|
1023 tem = Fdowncase (tem);
|
|
1024 else
|
|
1025 tem = Fcons (Fdowncase (Fcar (tem)), Fdowncase (Fcdr (tem)));
|
28223
|
1026 if (charset == CHARSET_ASCII)
|
|
1027 ascii_font = tem;
|
|
1028 else
|
|
1029 {
|
|
1030 c = MAKE_CHAR (charset, 0, 0);
|
|
1031 elements = Fcons (Fcons (make_number (c), tem), elements);
|
|
1032 }
|
17052
|
1033 }
|
|
1034
|
28223
|
1035 if (NILP (ascii_font))
|
|
1036 error ("No ASCII font in the fontlist");
|
17052
|
1037
|
28223
|
1038 fontset = make_fontset (Qnil, name, Qnil);
|
|
1039 FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font);
|
|
1040 for (; CONSP (elements); elements = XCDR (elements))
|
|
1041 {
|
|
1042 elt = XCAR (elements);
|
36370
|
1043 tem = XCDR (elt);
|
|
1044 if (STRINGP (tem))
|
|
1045 tem = font_family_registry (tem, 0);
|
|
1046 tem = Fcons (XCAR (elt), tem);
|
28223
|
1047 FONTSET_SET (fontset, XINT (XCAR (elt)), tem);
|
|
1048 }
|
17052
|
1049
|
|
1050 return Qnil;
|
|
1051 }
|
|
1052
|
28223
|
1053
|
|
1054 /* Clear all elements of FONTSET for multibyte characters. */
|
|
1055
|
|
1056 static void
|
|
1057 clear_fontset_elements (fontset)
|
|
1058 Lisp_Object fontset;
|
|
1059 {
|
|
1060 int i;
|
|
1061
|
|
1062 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
|
|
1063 XCHAR_TABLE (fontset)->contents[i] = Qnil;
|
|
1064 }
|
|
1065
|
|
1066
|
|
1067 /* Check validity of NAME as a fontset name and return the
|
|
1068 corresponding fontset. If not valid, signal an error.
|
49874
|
1069 If NAME is nil, return Vdefault_fontset. */
|
28223
|
1070
|
|
1071 static Lisp_Object
|
|
1072 check_fontset_name (name)
|
|
1073 Lisp_Object name;
|
|
1074 {
|
|
1075 int id;
|
|
1076
|
49874
|
1077 if (EQ (name, Qnil))
|
28223
|
1078 return Vdefault_fontset;
|
|
1079
|
40656
|
1080 CHECK_STRING (name);
|
58025
|
1081 /* First try NAME as literal. */
|
|
1082 id = fs_query_fontset (name, 2);
|
|
1083 if (id < 0)
|
|
1084 /* For backward compatibility, try again NAME as pattern. */
|
|
1085 id = fs_query_fontset (name, 0);
|
28223
|
1086 if (id < 0)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1087 error ("Fontset `%s' does not exist", SDATA (name));
|
28223
|
1088 return FONTSET_FROM_ID (id);
|
|
1089 }
|
17052
|
1090
|
53353
|
1091 /* Downcase FONTNAME or car and cdr of FONTNAME. If FONTNAME is a
|
|
1092 string, maybe change FONTNAME to (FAMILY . REGISTRY). */
|
|
1093
|
|
1094 static Lisp_Object
|
54995
|
1095 regularize_fontname (Lisp_Object fontname)
|
53353
|
1096 {
|
|
1097 Lisp_Object family, registry;
|
|
1098
|
|
1099 if (STRINGP (fontname))
|
|
1100 return font_family_registry (Fdowncase (fontname), 0);
|
|
1101
|
|
1102 CHECK_CONS (fontname);
|
|
1103 family = XCAR (fontname);
|
|
1104 registry = XCDR (fontname);
|
|
1105 if (!NILP (family))
|
|
1106 {
|
|
1107 CHECK_STRING (family);
|
|
1108 family = Fdowncase (family);
|
|
1109 }
|
|
1110 if (!NILP (registry))
|
|
1111 {
|
|
1112 CHECK_STRING (registry);
|
|
1113 registry = Fdowncase (registry);
|
|
1114 }
|
|
1115 return Fcons (family, registry);
|
|
1116 }
|
|
1117
|
49884
|
1118 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
|
41001
|
1119 doc: /* Modify fontset NAME to use FONTNAME for CHARACTER.
|
|
1120
|
49881
|
1121 If NAME is nil, modify the default fontset.
|
41001
|
1122 CHARACTER may be a cons; (FROM . TO), where FROM and TO are
|
|
1123 non-generic characters. In that case, use FONTNAME
|
|
1124 for all characters in the range FROM and TO (inclusive).
|
47277
|
1125 CHARACTER may be a charset. In that case, use FONTNAME
|
41001
|
1126 for all character in the charsets.
|
|
1127
|
|
1128 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family
|
41987
|
1129 name of a font, REGISTRY is a registry name of a font. */)
|
41001
|
1130 (name, character, fontname, frame)
|
28676
|
1131 Lisp_Object name, character, fontname, frame;
|
17052
|
1132 {
|
28223
|
1133 Lisp_Object fontset, elt;
|
|
1134 Lisp_Object realized;
|
|
1135 int from, to;
|
|
1136 int id;
|
|
1137
|
|
1138 fontset = check_fontset_name (name);
|
17052
|
1139
|
28676
|
1140 if (CONSP (character))
|
28223
|
1141 {
|
|
1142 /* CH should be (FROM . TO) where FROM and TO are non-generic
|
|
1143 characters. */
|
40656
|
1144 CHECK_NUMBER_CAR (character);
|
|
1145 CHECK_NUMBER_CDR (character);
|
28676
|
1146 from = XINT (XCAR (character));
|
|
1147 to = XINT (XCDR (character));
|
28223
|
1148 if (!char_valid_p (from, 0) || !char_valid_p (to, 0))
|
53072
|
1149 error ("Character range should be by non-generic characters");
|
28223
|
1150 if (!NILP (name)
|
|
1151 && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to)))
|
|
1152 error ("Can't change font for a single byte character");
|
|
1153 }
|
29501
|
1154 else if (SYMBOLP (character))
|
|
1155 {
|
|
1156 elt = Fget (character, Qcharset);
|
|
1157 if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0)))
|
46440
|
1158 error ("Invalid charset: %s", SDATA (SYMBOL_NAME (character)));
|
29501
|
1159 from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0);
|
|
1160 to = from;
|
|
1161 }
|
28223
|
1162 else
|
|
1163 {
|
40656
|
1164 CHECK_NUMBER (character);
|
28676
|
1165 from = XINT (character);
|
28223
|
1166 to = from;
|
|
1167 }
|
|
1168 if (!char_valid_p (from, 1))
|
|
1169 invalid_character (from);
|
|
1170 if (SINGLE_BYTE_CHAR_P (from))
|
|
1171 error ("Can't change font for a single byte character");
|
|
1172 if (from < to)
|
|
1173 {
|
|
1174 if (!char_valid_p (to, 1))
|
|
1175 invalid_character (to);
|
|
1176 if (SINGLE_BYTE_CHAR_P (to))
|
|
1177 error ("Can't change font for a single byte character");
|
|
1178 }
|
17052
|
1179
|
28223
|
1180 /* The arg FRAME is kept for backward compatibility. We only check
|
|
1181 the validity. */
|
17052
|
1182 if (!NILP (frame))
|
40656
|
1183 CHECK_LIVE_FRAME (frame);
|
17052
|
1184
|
54995
|
1185 elt = Fcons (make_number (from), regularize_fontname (fontname));
|
28223
|
1186 for (; from <= to; from++)
|
|
1187 FONTSET_SET (fontset, from, elt);
|
|
1188 Foptimize_char_table (fontset);
|
17052
|
1189
|
28223
|
1190 /* If there's a realized fontset REALIZED whose parent is FONTSET,
|
|
1191 clear all the elements of REALIZED and free all multibyte faces
|
|
1192 whose fontset is REALIZED. This way, the specified character(s)
|
|
1193 are surely redisplayed by a correct font. */
|
|
1194 for (id = 0; id < ASIZE (Vfontset_table); id++)
|
|
1195 {
|
|
1196 realized = AREF (Vfontset_table, id);
|
|
1197 if (!NILP (realized)
|
|
1198 && !BASE_FONTSET_P (realized)
|
|
1199 && EQ (FONTSET_BASE (realized), fontset))
|
17052
|
1200 {
|
28223
|
1201 FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));
|
|
1202 clear_fontset_elements (realized);
|
|
1203 free_realized_multibyte_face (f, id);
|
17052
|
1204 }
|
28223
|
1205 }
|
17052
|
1206
|
|
1207 return Qnil;
|
|
1208 }
|
|
1209
|
|
1210 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
|
41001
|
1211 doc: /* Return information about a font named NAME on frame FRAME.
|
|
1212 If FRAME is omitted or nil, use the selected frame.
|
|
1213 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
|
|
1214 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
|
|
1215 where
|
|
1216 OPENED-NAME is the name used for opening the font,
|
|
1217 FULL-NAME is the full name of the font,
|
|
1218 SIZE is the maximum bound width of the font,
|
|
1219 HEIGHT is the height of the font,
|
|
1220 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
|
|
1221 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
|
|
1222 how to compose characters.
|
|
1223 If the named font is not yet loaded, return nil. */)
|
|
1224 (name, frame)
|
17052
|
1225 Lisp_Object name, frame;
|
|
1226 {
|
|
1227 FRAME_PTR f;
|
|
1228 struct font_info *fontp;
|
|
1229 Lisp_Object info;
|
|
1230
|
|
1231 (*check_window_system_func) ();
|
|
1232
|
40656
|
1233 CHECK_STRING (name);
|
28223
|
1234 name = Fdowncase (name);
|
17052
|
1235 if (NILP (frame))
|
25668
|
1236 frame = selected_frame;
|
40656
|
1237 CHECK_LIVE_FRAME (frame);
|
25668
|
1238 f = XFRAME (frame);
|
17052
|
1239
|
|
1240 if (!query_font_func)
|
|
1241 error ("Font query function is not supported");
|
|
1242
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1243 fontp = (*query_font_func) (f, SDATA (name));
|
17052
|
1244 if (!fontp)
|
|
1245 return Qnil;
|
|
1246
|
28223
|
1247 info = Fmake_vector (make_number (7), Qnil);
|
17052
|
1248
|
|
1249 XVECTOR (info)->contents[0] = build_string (fontp->name);
|
|
1250 XVECTOR (info)->contents[1] = build_string (fontp->full_name);
|
28223
|
1251 XVECTOR (info)->contents[2] = make_number (fontp->size);
|
|
1252 XVECTOR (info)->contents[3] = make_number (fontp->height);
|
|
1253 XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset);
|
|
1254 XVECTOR (info)->contents[5] = make_number (fontp->relative_compose);
|
|
1255 XVECTOR (info)->contents[6] = make_number (fontp->default_ascent);
|
17052
|
1256
|
|
1257 return info;
|
|
1258 }
|
|
1259
|
28963
|
1260
|
52654
|
1261 /* Return a cons (FONT-NAME . GLYPH-CODE).
|
|
1262 FONT-NAME is the font name for the character at POSITION in the current
|
28963
|
1263 buffer. This is computed from all the text properties and overlays
|
55094
|
1264 that apply to POSITION. POSTION may be nil, in which case,
|
|
1265 FONT-NAME is the font name for display the character CH with the
|
|
1266 default face.
|
|
1267
|
52654
|
1268 GLYPH-CODE is the glyph code in the font to use for the character.
|
|
1269
|
|
1270 If the 2nd optional arg CH is non-nil, it is a character to check
|
|
1271 the font instead of the character at POSITION.
|
|
1272
|
|
1273 It returns nil in the following cases:
|
28963
|
1274
|
|
1275 (1) The window system doesn't have a font for the character (thus
|
|
1276 it is displayed by an empty box).
|
|
1277
|
|
1278 (2) The character code is invalid.
|
|
1279
|
55094
|
1280 (3) If POSITION is not nil, and the current buffer is not displayed
|
|
1281 in any window.
|
28963
|
1282
|
|
1283 In addition, the returned font name may not take into account of
|
|
1284 such redisplay engine hooks as what used in jit-lock-mode if
|
|
1285 POSITION is currently not visible. */
|
|
1286
|
|
1287
|
52654
|
1288 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
|
41001
|
1289 doc: /* For internal use only. */)
|
52654
|
1290 (position, ch)
|
|
1291 Lisp_Object position, ch;
|
28963
|
1292 {
|
|
1293 int pos, pos_byte, dummy;
|
|
1294 int face_id;
|
52654
|
1295 int c, code;
|
28963
|
1296 struct frame *f;
|
|
1297 struct face *face;
|
|
1298
|
55094
|
1299 if (NILP (position))
|
52654
|
1300 {
|
|
1301 CHECK_NATNUM (ch);
|
|
1302 c = XINT (ch);
|
55094
|
1303 f = XFRAME (selected_frame);
|
|
1304 face_id = DEFAULT_FACE_ID;
|
|
1305 }
|
|
1306 else
|
|
1307 {
|
|
1308 Lisp_Object window;
|
|
1309 struct window *w;
|
|
1310
|
|
1311 CHECK_NUMBER_COERCE_MARKER (position);
|
|
1312 pos = XINT (position);
|
|
1313 if (pos < BEGV || pos >= ZV)
|
|
1314 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
|
|
1315 pos_byte = CHAR_TO_BYTE (pos);
|
|
1316 if (NILP (ch))
|
|
1317 c = FETCH_CHAR (pos_byte);
|
|
1318 else
|
|
1319 {
|
|
1320 CHECK_NATNUM (ch);
|
|
1321 c = XINT (ch);
|
|
1322 }
|
|
1323 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
|
|
1324 if (NILP (window))
|
|
1325 return Qnil;
|
|
1326 w = XWINDOW (window);
|
|
1327 f = XFRAME (w->frame);
|
|
1328 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
|
52654
|
1329 }
|
28963
|
1330 if (! CHAR_VALID_P (c, 0))
|
|
1331 return Qnil;
|
|
1332 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
|
|
1333 face = FACE_FROM_ID (f, face_id);
|
52654
|
1334 if (! face->font || ! face->font_name)
|
|
1335 return Qnil;
|
|
1336
|
|
1337 {
|
|
1338 struct font_info *fontp = (*get_font_info_func) (f, face->font_info_id);
|
|
1339 XChar2b char2b;
|
|
1340 int c1, c2, charset;
|
|
1341
|
|
1342 SPLIT_CHAR (c, charset, c1, c2);
|
|
1343 if (c2 > 0)
|
|
1344 STORE_XCHAR2B (&char2b, c1, c2);
|
|
1345 else
|
|
1346 STORE_XCHAR2B (&char2b, 0, c1);
|
|
1347 rif->encode_char (c, &char2b, fontp, NULL);
|
|
1348 code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b);
|
|
1349 }
|
|
1350 return Fcons (build_string (face->font_name), make_number (code));
|
28963
|
1351 }
|
|
1352
|
|
1353
|
|
1354 /* Called from Ffontset_info via map_char_table on each leaf of
|
49874
|
1355 fontset. ARG is a copy of the default fontset. The current leaf
|
|
1356 is indexed by CHARACTER and has value ELT. This function override
|
|
1357 the copy by ELT if ELT is not nil. */
|
|
1358
|
|
1359 static void
|
|
1360 override_font_info (fontset, character, elt)
|
|
1361 Lisp_Object fontset, character, elt;
|
|
1362 {
|
|
1363 if (! NILP (elt))
|
|
1364 Faset (fontset, character, elt);
|
|
1365 }
|
|
1366
|
|
1367 /* Called from Ffontset_info via map_char_table on each leaf of
|
28963
|
1368 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
|
|
1369 ARG)' and FONT-INFOs have this form:
|
|
1370 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
|
|
1371 The current leaf is indexed by CHARACTER and has value ELT. This
|
|
1372 function add the information of the current leaf to ARG by
|
49874
|
1373 appending a new element or modifying the last element. */
|
28963
|
1374
|
|
1375 static void
|
|
1376 accumulate_font_info (arg, character, elt)
|
|
1377 Lisp_Object arg, character, elt;
|
|
1378 {
|
34975
|
1379 Lisp_Object last, last_char, last_elt;
|
28963
|
1380
|
29767
|
1381 if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))
|
|
1382 elt = FONTSET_REF (Vdefault_fontset, XINT (character));
|
28963
|
1383 if (!CONSP (elt))
|
|
1384 return;
|
|
1385 last = XCAR (arg);
|
|
1386 last_char = XCAR (XCAR (last));
|
|
1387 last_elt = XCAR (XCDR (XCAR (last)));
|
|
1388 elt = XCDR (elt);
|
|
1389 if (!NILP (Fequal (elt, last_elt)))
|
|
1390 {
|
|
1391 int this_charset = CHAR_CHARSET (XINT (character));
|
|
1392
|
|
1393 if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */
|
|
1394 {
|
|
1395 if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char))))
|
|
1396 {
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1397 XSETCDR (last_char, character);
|
28963
|
1398 return;
|
|
1399 }
|
|
1400 }
|
29767
|
1401 else if (XINT (last_char) == XINT (character))
|
|
1402 return;
|
|
1403 else if (this_charset == CHAR_CHARSET (XINT (last_char)))
|
28963
|
1404 {
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1405 XSETCAR (XCAR (last), Fcons (last_char, character));
|
29767
|
1406 return;
|
28963
|
1407 }
|
|
1408 }
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1409 XSETCDR (last, Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil));
|
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1410 XSETCAR (arg, XCDR (last));
|
28963
|
1411 }
|
|
1412
|
|
1413
|
17052
|
1414 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
|
41001
|
1415 doc: /* Return information about a fontset named NAME on frame FRAME.
|
49881
|
1416 If NAME is nil, return information about the default fontset.
|
41001
|
1417 The value is a vector:
|
|
1418 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],
|
|
1419 where,
|
|
1420 SIZE is the maximum bound width of ASCII font in the fontset,
|
|
1421 HEIGHT is the maximum bound height of ASCII font in the fontset,
|
|
1422 CHARSET-OR-RANGE is a charset, a character (may be a generic character)
|
|
1423 or a cons of two characters specifying the range of characters.
|
|
1424 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),
|
|
1425 where FAMILY is a `FAMILY' field of a XLFD font name,
|
41987
|
1426 REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name.
|
|
1427 FAMILY may contain a `FOUNDRY' field at the head.
|
41001
|
1428 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.
|
|
1429 OPENEDs are names of fonts actually opened.
|
|
1430 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.
|
|
1431 If FRAME is omitted, it defaults to the currently selected frame. */)
|
|
1432 (name, frame)
|
17052
|
1433 Lisp_Object name, frame;
|
|
1434 {
|
28963
|
1435 Lisp_Object fontset;
|
17052
|
1436 FRAME_PTR f;
|
28963
|
1437 Lisp_Object indices[3];
|
|
1438 Lisp_Object val, tail, elt;
|
|
1439 Lisp_Object *realized;
|
30124
|
1440 struct font_info *fontp = NULL;
|
28963
|
1441 int n_realized = 0;
|
17052
|
1442 int i;
|
41987
|
1443
|
17052
|
1444 (*check_window_system_func) ();
|
|
1445
|
28223
|
1446 fontset = check_fontset_name (name);
|
|
1447
|
17052
|
1448 if (NILP (frame))
|
25668
|
1449 frame = selected_frame;
|
40656
|
1450 CHECK_LIVE_FRAME (frame);
|
25668
|
1451 f = XFRAME (frame);
|
17052
|
1452
|
29767
|
1453 /* Recode realized fontsets whose base is FONTSET in the table
|
28963
|
1454 `realized'. */
|
|
1455 realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
|
|
1456 * ASIZE (Vfontset_table));
|
28223
|
1457 for (i = 0; i < ASIZE (Vfontset_table); i++)
|
|
1458 {
|
28963
|
1459 elt = FONTSET_FROM_ID (i);
|
|
1460 if (!NILP (elt)
|
|
1461 && EQ (FONTSET_BASE (elt), fontset))
|
|
1462 realized[n_realized++] = elt;
|
28223
|
1463 }
|
|
1464
|
49874
|
1465 if (! EQ (fontset, Vdefault_fontset))
|
|
1466 {
|
|
1467 /* Merge FONTSET onto the default fontset. */
|
|
1468 val = Fcopy_sequence (Vdefault_fontset);
|
51033
|
1469 map_char_table (override_font_info, Qnil, fontset, fontset, val, 0, indices);
|
49874
|
1470 fontset = val;
|
|
1471 }
|
|
1472
|
28963
|
1473 /* Accumulate information of the fontset in VAL. The format is
|
|
1474 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
|
|
1475 FONT-SPEC). See the comment for accumulate_font_info for the
|
|
1476 detail. */
|
|
1477 val = Fcons (Fcons (make_number (0),
|
|
1478 Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)),
|
|
1479 Qnil);
|
|
1480 val = Fcons (val, val);
|
51033
|
1481 map_char_table (accumulate_font_info, Qnil, fontset, fontset, val, 0, indices);
|
28963
|
1482 val = XCDR (val);
|
28223
|
1483
|
28963
|
1484 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
|
29767
|
1485 character for a charset, replace it with the charset symbol. If
|
28963
|
1486 fonts are opened for FONT-SPEC, append the names of the fonts to
|
|
1487 FONT-SPEC. */
|
|
1488 for (tail = val; CONSP (tail); tail = XCDR (tail))
|
28223
|
1489 {
|
28963
|
1490 int c;
|
|
1491 elt = XCAR (tail);
|
|
1492 if (INTEGERP (XCAR (elt)))
|
28223
|
1493 {
|
28963
|
1494 int charset, c1, c2;
|
|
1495 c = XINT (XCAR (elt));
|
|
1496 SPLIT_CHAR (c, charset, c1, c2);
|
|
1497 if (c1 == 0)
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1498 XSETCAR (elt, CHARSET_SYMBOL (charset));
|
28963
|
1499 }
|
|
1500 else
|
|
1501 c = XINT (XCAR (XCAR (elt)));
|
|
1502 for (i = 0; i < n_realized; i++)
|
|
1503 {
|
|
1504 Lisp_Object face_id, font;
|
28223
|
1505 struct face *face;
|
17052
|
1506
|
28963
|
1507 face_id = FONTSET_REF_VIA_BASE (realized[i], c);
|
|
1508 if (INTEGERP (face_id))
|
28223
|
1509 {
|
28963
|
1510 face = FACE_FROM_ID (f, XINT (face_id));
|
37744
|
1511 if (face && face->font && face->font_name)
|
28963
|
1512 {
|
|
1513 font = build_string (face->font_name);
|
|
1514 if (NILP (Fmember (font, XCDR (XCDR (elt)))))
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1515 XSETCDR (XCDR (elt), Fcons (font, XCDR (XCDR (elt))));
|
28963
|
1516 }
|
28223
|
1517 }
|
|
1518 }
|
|
1519 }
|
30124
|
1520
|
|
1521 elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val)));
|
|
1522 if (CONSP (elt))
|
|
1523 {
|
|
1524 elt = XCAR (elt);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1525 fontp = (*query_font_func) (f, SDATA (elt));
|
30124
|
1526 }
|
|
1527 val = Fmake_vector (make_number (3), val);
|
|
1528 AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0);
|
|
1529 AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0);
|
|
1530 return val;
|
17052
|
1531 }
|
|
1532
|
28223
|
1533 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
|
41001
|
1534 doc: /* Return a font name pattern for character CH in fontset NAME.
|
49881
|
1535 If NAME is nil, find a font name pattern in the default fontset. */)
|
41001
|
1536 (name, ch)
|
28223
|
1537 Lisp_Object name, ch;
|
|
1538 {
|
34975
|
1539 int c;
|
28223
|
1540 Lisp_Object fontset, elt;
|
|
1541
|
|
1542 fontset = check_fontset_name (name);
|
|
1543
|
40656
|
1544 CHECK_NUMBER (ch);
|
28223
|
1545 c = XINT (ch);
|
|
1546 if (!char_valid_p (c, 1))
|
|
1547 invalid_character (c);
|
|
1548
|
|
1549 elt = FONTSET_REF (fontset, c);
|
|
1550 if (CONSP (elt))
|
|
1551 elt = XCDR (elt);
|
|
1552
|
|
1553 return elt;
|
|
1554 }
|
|
1555
|
|
1556 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
|
41001
|
1557 doc: /* Return a list of all defined fontset names. */)
|
|
1558 ()
|
28223
|
1559 {
|
|
1560 Lisp_Object fontset, list;
|
|
1561 int i;
|
|
1562
|
|
1563 list = Qnil;
|
|
1564 for (i = 0; i < ASIZE (Vfontset_table); i++)
|
|
1565 {
|
|
1566 fontset = FONTSET_FROM_ID (i);
|
|
1567 if (!NILP (fontset)
|
|
1568 && BASE_FONTSET_P (fontset))
|
|
1569 list = Fcons (FONTSET_NAME (fontset), list);
|
|
1570 }
|
28963
|
1571
|
28223
|
1572 return list;
|
|
1573 }
|
|
1574
|
53353
|
1575 DEFUN ("set-overriding-fontspec-internal", Fset_overriding_fontspec_internal,
|
|
1576 Sset_overriding_fontspec_internal, 1, 1, 0,
|
|
1577 doc: /* Internal use only.
|
|
1578
|
|
1579 FONTLIST is an alist of TARGET vs FONTNAME, where TARGET is a charset
|
|
1580 or a char-table, FONTNAME have the same meanings as in
|
|
1581 `set-fontset-font'.
|
|
1582
|
|
1583 It overrides the font specifications for each TARGET in the default
|
|
1584 fontset by the corresponding FONTNAME.
|
|
1585
|
|
1586 If TARGET is a charset, targets are all characters in the charset. If
|
|
1587 TARGET is a char-table, targets are characters whose value is non-nil
|
|
1588 in the table.
|
|
1589
|
|
1590 It is intended that this function is called only from
|
|
1591 `set-language-environment'. */)
|
|
1592 (fontlist)
|
|
1593 Lisp_Object fontlist;
|
|
1594 {
|
|
1595 Lisp_Object tail;
|
|
1596
|
|
1597 fontlist = Fcopy_sequence (fontlist);
|
|
1598 /* Now FONTLIST is ((TARGET . FONTNAME) ...). Reform it to ((TARGET
|
|
1599 nil nil nil FONTSPEC) ...), where TARGET is a charset-id or a
|
|
1600 char-table. */
|
|
1601 for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
|
|
1602 {
|
|
1603 Lisp_Object elt, target;
|
|
1604
|
|
1605 elt = XCAR (tail);
|
|
1606 target = Fcar (elt);
|
54995
|
1607 elt = Fcons (Qnil, regularize_fontname (Fcdr (elt)));
|
53353
|
1608 if (! CHAR_TABLE_P (target))
|
|
1609 {
|
|
1610 int charset, c;
|
|
1611
|
|
1612 CHECK_SYMBOL (target);
|
|
1613 charset = get_charset_id (target);
|
|
1614 if (charset < 0)
|
|
1615 error ("Invalid charset %s", SDATA (SYMBOL_NAME (target)));
|
|
1616 target = make_number (charset);
|
|
1617 c = MAKE_CHAR (charset, 0, 0);
|
|
1618 XSETCAR (elt, make_number (c));
|
|
1619 }
|
|
1620 elt = Fcons (target, Fcons (Qnil, Fcons (Qnil, elt)));
|
|
1621 XSETCAR (tail, elt);
|
|
1622 }
|
|
1623 Voverriding_fontspec_alist = fontlist;
|
|
1624 clear_face_cache (0);
|
|
1625 ++windows_or_buffers_changed;
|
|
1626 return Qnil;
|
|
1627 }
|
|
1628
|
21514
|
1629 void
|
17052
|
1630 syms_of_fontset ()
|
|
1631 {
|
|
1632 if (!load_font_func)
|
|
1633 /* Window system initializer should have set proper functions. */
|
|
1634 abort ();
|
|
1635
|
17112
|
1636 Qfontset = intern ("fontset");
|
17052
|
1637 staticpro (&Qfontset);
|
28223
|
1638 Fput (Qfontset, Qchar_table_extra_slots, make_number (3));
|
17052
|
1639
|
|
1640 Vcached_fontset_data = Qnil;
|
|
1641 staticpro (&Vcached_fontset_data);
|
|
1642
|
28223
|
1643 Vfontset_table = Fmake_vector (make_number (32), Qnil);
|
|
1644 staticpro (&Vfontset_table);
|
|
1645
|
|
1646 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
|
|
1647 staticpro (&Vdefault_fontset);
|
28963
|
1648 FONTSET_ID (Vdefault_fontset) = make_number (0);
|
|
1649 FONTSET_NAME (Vdefault_fontset)
|
|
1650 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
|
|
1651 AREF (Vfontset_table, 0) = Vdefault_fontset;
|
|
1652 next_fontset_id = 1;
|
17052
|
1653
|
53353
|
1654 Voverriding_fontspec_alist = Qnil;
|
|
1655 staticpro (&Voverriding_fontspec_alist);
|
|
1656
|
17052
|
1657 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
|
41001
|
1658 doc: /* Alist of fontname patterns vs corresponding encoding info.
|
|
1659 Each element looks like (REGEXP . ENCODING-INFO),
|
|
1660 where ENCODING-INFO is an alist of CHARSET vs ENCODING.
|
|
1661 ENCODING is one of the following integer values:
|
|
1662 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,
|
|
1663 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,
|
|
1664 2: code points 0x20A0..0x7FFF are used,
|
|
1665 3: code points 0xA020..0xFF7F are used. */);
|
17052
|
1666 Vfont_encoding_alist = Qnil;
|
49286
|
1667 Vfont_encoding_alist
|
|
1668 = Fcons (Fcons (build_string ("JISX0201"),
|
|
1669 Fcons (Fcons (intern ("latin-jisx0201"), make_number (0)),
|
|
1670 Qnil)),
|
|
1671 Vfont_encoding_alist);
|
|
1672 Vfont_encoding_alist
|
|
1673 = Fcons (Fcons (build_string ("ISO8859-1"),
|
|
1674 Fcons (Fcons (intern ("ascii"), make_number (0)),
|
|
1675 Qnil)),
|
|
1676 Vfont_encoding_alist);
|
17052
|
1677
|
17112
|
1678 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
|
41001
|
1679 doc: /* Char table of characters whose ascent values should be ignored.
|
|
1680 If an entry for a character is non-nil, the ascent value of the glyph
|
|
1681 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
|
|
1682
|
|
1683 This affects how a composite character which contains
|
|
1684 such a character is displayed on screen. */);
|
19282
|
1685 Vuse_default_ascent = Qnil;
|
|
1686
|
|
1687 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
|
41001
|
1688 doc: /* Char table of characters which is not composed relatively.
|
|
1689 If an entry for a character is non-nil, a composition sequence
|
|
1690 which contains that character is displayed so that
|
|
1691 the glyph of that character is put without considering
|
|
1692 an ascent and descent value of a previous character. */);
|
26858
|
1693 Vignore_relative_composition = Qnil;
|
17112
|
1694
|
19450
|
1695 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
|
41001
|
1696 doc: /* Alist of fontname vs list of the alternate fontnames.
|
|
1697 When a specified font name is not found, the corresponding
|
|
1698 alternate fontnames (if any) are tried instead. */);
|
19450
|
1699 Valternate_fontname_alist = Qnil;
|
17193
|
1700
|
17730
|
1701 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
|
41001
|
1702 doc: /* Alist of fontset names vs the aliases. */);
|
28963
|
1703 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
|
|
1704 build_string ("fontset-default")),
|
|
1705 Qnil);
|
17730
|
1706
|
26858
|
1707 DEFVAR_LISP ("vertical-centering-font-regexp",
|
|
1708 &Vvertical_centering_font_regexp,
|
41001
|
1709 doc: /* *Regexp matching font names that require vertical centering on display.
|
|
1710 When a character is displayed with such fonts, the character is displayed
|
41987
|
1711 at the vertical center of lines. */);
|
26858
|
1712 Vvertical_centering_font_regexp = Qnil;
|
|
1713
|
17052
|
1714 defsubr (&Squery_fontset);
|
|
1715 defsubr (&Snew_fontset);
|
|
1716 defsubr (&Sset_fontset_font);
|
|
1717 defsubr (&Sfont_info);
|
28963
|
1718 defsubr (&Sinternal_char_font);
|
17052
|
1719 defsubr (&Sfontset_info);
|
28223
|
1720 defsubr (&Sfontset_font);
|
|
1721 defsubr (&Sfontset_list);
|
53353
|
1722 defsubr (&Sset_overriding_fontspec_internal);
|
17052
|
1723 }
|
52401
|
1724
|
|
1725 /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
|
|
1726 (do not change this comment) */
|