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