Mercurial > emacs
comparison src/fontset.c @ 28223:b888c69e8bf0
All codes rewritten or adjusted for the change of
fontset implementation. Now fontset is represented by char table.
(Vglobal_fontset_alist, font_idx_temp, my_strcasetbl): Variables
removed.
(my_strcasecmp): Function removed.
(Vfontset_table, next_fontset_id, Vdefault_fontset): New
variables.
(AREF, ASIZE): New macros.
(FONTSET_FROM_ID, FONTSET_ID, FONTSET_NAME, FONTSET_FRAME,
FONTSET_ASCII, FONTSET_BASE, BASE_FONTSET_P, FONTSET_REF,
FONTSET_REF_VIA_BASE, FONTSET_SET): New macros.
(fontset_ref, fontset_ref_via_base, fontset_set, make_fontset,
fontset_id_valid_p, font_family_registry, fontset_name,
fontset_ascii, free_face_fontset, face_suitable_for_char_p,
face_for_char, make_fontset_for_ascii_face, fontset_font_pattern):
New functions.
(fs_load_font): New arg FACE. Caller changed.
(fs_query_fontset): Argument changed. Caller changed.
(Fquery_fontset): call fs_query_fontset.
(fs_register_fontset, alloc_fontset_data, free_fontset_data):
Functions removed.
(clear_fontset_elements, check_registry_encoding,
check_fontset_name): New functions.
(syms_of_fontset): Set char-table-extra-slots property of fontset
to 3. Staticpro and initialize Vfontset_table and
Vdefault_fontset. Defsubr fontset_font and fontset_list.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Tue, 21 Mar 2000 00:38:14 +0000 |
parents | 7cc081b4e084 |
children | df61a12bd266 |
comparison
equal
deleted
inserted
replaced
28222:33f6a8ee4733 | 28223:b888c69e8bf0 |
---|---|
1 /* Fontset handler. | 1 /* Fontset handler. |
2 Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. | 2 Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN. |
3 Licensed to the Free Software Foundation. | 3 Licensed to the Free Software Foundation. |
4 | 4 |
5 This file is part of GNU Emacs. | 5 This file is part of GNU Emacs. |
6 | 6 |
7 GNU Emacs is free software; you can redistribute it and/or modify | 7 GNU Emacs is free software; you can redistribute it and/or modify |
17 You should have received a copy of the GNU General Public License | 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 | 18 along with GNU Emacs; see the file COPYING. If not, write to |
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
20 Boston, MA 02111-1307, USA. */ | 20 Boston, MA 02111-1307, USA. */ |
21 | 21 |
22 /* #define FONTSET_DEBUG */ | |
23 | |
22 #include <config.h> | 24 #include <config.h> |
23 #if HAVE_ALLOCA_H | 25 |
24 #include <alloca.h> | 26 #ifdef FONTSET_DEBUG |
25 #endif /* HAVE_ALLOCA_H */ | 27 #include <stdio.h> |
28 #endif | |
29 | |
26 #include "lisp.h" | 30 #include "lisp.h" |
27 #include "charset.h" | 31 #include "charset.h" |
28 #include "ccl.h" | 32 #include "ccl.h" |
29 #include "frame.h" | 33 #include "frame.h" |
34 #include "dispextern.h" | |
30 #include "fontset.h" | 35 #include "fontset.h" |
31 | 36 #include "window.h" |
32 Lisp_Object Vglobal_fontset_alist; | 37 |
38 #ifdef FONTSET_DEBUG | |
39 #undef xassert | |
40 #define xassert(X) do {if (!(X)) abort ();} while (0) | |
41 #undef INLINE | |
42 #define INLINE | |
43 #endif | |
44 | |
45 | |
46 /* FONTSET | |
47 | |
48 A fontset is a collection of font related information to give | |
49 similar appearance (style, size, etc) of characters. There are two | |
50 kinds of fontsets; base and realized. A base fontset is created by | |
51 new-fontset from Emacs Lisp explicitly. A realized fontset is | |
52 created implicitly when a face is realized for ASCII characters. A | |
53 face is also realized for multibyte characters based on an ASCII | |
54 face. All of the multibyte faces based on the same ASCII face | |
55 share the same realized fontset. | |
56 | |
57 A fontset object is implemented by a char-table. | |
58 | |
59 An element of a base fontset is: | |
60 (INDEX . FONTNAME) or | |
61 (INDEX . (FOUNDRY . REGISTRY )) | |
62 FONTNAME is a font name pattern for the corresponding character. | |
63 FOUNDRY and REGISTRY are respectively foundy and regisry fields of | |
64 a font name for the corresponding character. INDEX specifies for | |
65 which character (or generic character) the element is defined. It | |
66 may be different from an index to access this element. For | |
67 instance, if a fontset defines some font for all characters of | |
68 charset `japanese-jisx0208', INDEX is the generic character of this | |
69 charset. REGISTRY is the | |
70 | |
71 An element of a realized fontset is FACE-ID which is a face to use | |
72 for displaying the correspnding character. | |
73 | |
74 All single byte charaters (ASCII and 8bit-unibyte) share the same | |
75 element in a fontset. The element is stored in `defalt' slot of | |
76 the fontset. And this slot is never used as a default value of | |
77 multibyte characters. That means that the first 256 elements of a | |
78 fontset set is always nil (as this is not efficient, we may | |
79 implement a fontset in a different way in the future). | |
80 | |
81 To access or set each element, use macros FONTSET_REF and | |
82 FONTSET_SET respectively for efficiency. | |
83 | |
84 A fontset has 3 extra slots. | |
85 | |
86 The 1st slot is an ID number of the fontset. | |
87 | |
88 The 2nd slot is a name of the fontset. This is nil for a realized | |
89 face. | |
90 | |
91 The 3rd slot is a frame that the fontset belongs to. This is nil | |
92 for a default face. | |
93 | |
94 A parent of a base fontset is nil. A parent of a realized fontset | |
95 is a base fontset. | |
96 | |
97 All fontsets (except for the default fontset described below) are | |
98 recorded in Vfontset_table. | |
99 | |
100 | |
101 DEFAULT FONTSET | |
102 | |
103 There's a special fontset named `default fontset' which defines a | |
104 default fontname that contains only REGISTRY field for each | |
105 character. When a base fontset doesn't specify a font for a | |
106 specific character, the corresponding value in the default fontset | |
107 is used. The format is the same as a base fontset. | |
108 | |
109 The parent of realized fontsets created for faces that have no | |
110 fontset is the default fontset. | |
111 | |
112 | |
113 These structures are hidden from the other codes than this file. | |
114 The other codes handle fontsets only by their ID numbers. They | |
115 usually use variable name `fontset' for IDs. But, in this file, we | |
116 always use varialbe name `id' for IDs, and name `fontset' for the | |
117 actual fontset objects. | |
118 | |
119 */ | |
120 | |
121 /********** VARIABLES and FUNCTION PROTOTYPES **********/ | |
122 | |
123 extern Lisp_Object Qfont; | |
124 Lisp_Object Qfontset; | |
125 | |
126 /* Vector containing all fontsets. */ | |
127 static Lisp_Object Vfontset_table; | |
128 | |
129 /* Next possibly free fontset ID. Usually this keeps the mininum | |
130 fontset ID not yet used. */ | |
131 static int next_fontset_id; | |
132 | |
133 /* The default fontset. This gives default FAMILY and REGISTRY of | |
134 font for each characters. */ | |
135 static Lisp_Object Vdefault_fontset; | |
136 | |
33 Lisp_Object Vfont_encoding_alist; | 137 Lisp_Object Vfont_encoding_alist; |
34 Lisp_Object Vuse_default_ascent; | 138 Lisp_Object Vuse_default_ascent; |
35 Lisp_Object Vignore_relative_composition; | 139 Lisp_Object Vignore_relative_composition; |
36 Lisp_Object Valternate_fontname_alist; | 140 Lisp_Object Valternate_fontname_alist; |
37 Lisp_Object Vfontset_alias_alist; | 141 Lisp_Object Vfontset_alias_alist; |
38 Lisp_Object Vhighlight_wrong_size_font; | 142 Lisp_Object Vhighlight_wrong_size_font; |
39 Lisp_Object Vclip_large_size_font; | 143 Lisp_Object Vclip_large_size_font; |
40 Lisp_Object Vvertical_centering_font_regexp; | 144 Lisp_Object Vvertical_centering_font_regexp; |
41 | 145 |
42 /* Used as a temporary in macro FS_LOAD_FONT. */ | 146 /* The following six are declarations of callback functions depending |
43 int font_idx_temp; | 147 on window system. See the comments in src/fontset.h for more |
44 | 148 detail. */ |
45 /* We had better have our own strcasecmp function because some system | |
46 doesn't have it. */ | |
47 static char my_strcasetbl[256]; | |
48 | |
49 /* Compare two strings S0 and S1 while ignoring differences in case. | |
50 Return 1 if they differ, else return 0. */ | |
51 static int | |
52 my_strcasecmp (s0, s1) | |
53 unsigned char *s0, *s1; | |
54 { | |
55 while (*s0) | |
56 if (my_strcasetbl[*s0++] != my_strcasetbl[*s1++]) return 1; | |
57 return (int) *s1; | |
58 } | |
59 | |
60 /* The following six are window system dependent functions. See | |
61 the comments in src/fontset.h for more detail. */ | |
62 | 149 |
63 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */ | 150 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */ |
64 struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx)); | 151 struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx)); |
65 | 152 |
66 /* Return a list of font names which matches PATTERN. See the document of | 153 /* Return a list of font names which matches PATTERN. See the document of |
88 void (*find_ccl_program_func) P_ ((struct font_info *)); | 175 void (*find_ccl_program_func) P_ ((struct font_info *)); |
89 | 176 |
90 /* Check if any window system is used now. */ | 177 /* Check if any window system is used now. */ |
91 void (*check_window_system_func) P_ ((void)); | 178 void (*check_window_system_func) P_ ((void)); |
92 | 179 |
93 struct fontset_data * | 180 |
94 alloc_fontset_data () | 181 /* Prototype declarations for static functions. */ |
95 { | 182 static Lisp_Object fontset_ref P_ ((Lisp_Object, int)); |
96 struct fontset_data *fontset_data | 183 static void fontset_set P_ ((Lisp_Object, int, Lisp_Object)); |
97 = (struct fontset_data *) xmalloc (sizeof (struct fontset_data)); | 184 static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); |
98 | 185 static int fontset_id_valid_p P_ ((int)); |
99 bzero (fontset_data, sizeof (struct fontset_data)); | 186 static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object)); |
100 | 187 static Lisp_Object font_family_registry P_ ((Lisp_Object)); |
101 return fontset_data; | 188 |
102 } | 189 |
190 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/ | |
191 | |
192 /* Macros for Lisp vector. */ | |
193 #define AREF(V, IDX) XVECTOR (V)->contents[IDX] | |
194 #define ASIZE(V) XVECTOR (V)->size | |
195 | |
196 /* Return the fontset with ID. No check of ID's validness. */ | |
197 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id) | |
198 | |
199 /* Macros to access extra, default, and parent slots, of fontset. */ | |
200 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0] | |
201 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1] | |
202 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2] | |
203 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->defalt | |
204 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent | |
205 | |
206 #define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset)) | |
207 | |
208 | |
209 /* Return the element of FONTSET (char-table) at index C (character). */ | |
210 | |
211 #define FONTSET_REF(fontset, c) fontset_ref (fontset, c) | |
212 | |
213 static INLINE Lisp_Object | |
214 fontset_ref (fontset, c) | |
215 Lisp_Object fontset; | |
216 int c; | |
217 { | |
218 int charset, c1, c2; | |
219 Lisp_Object elt, defalt; | |
220 int i; | |
221 | |
222 if (SINGLE_BYTE_CHAR_P (c)) | |
223 return FONTSET_ASCII (fontset); | |
224 | |
225 SPLIT_NON_ASCII_CHAR (c, charset, c1, c2); | |
226 elt = XCHAR_TABLE (fontset)->contents[charset + 128]; | |
227 if (!SUB_CHAR_TABLE_P (elt)) | |
228 return elt; | |
229 defalt = XCHAR_TABLE (elt)->defalt; | |
230 if (c1 < 32 | |
231 || (elt = XCHAR_TABLE (elt)->contents[c1], | |
232 NILP (elt))) | |
233 return defalt; | |
234 if (!SUB_CHAR_TABLE_P (elt)) | |
235 return elt; | |
236 defalt = XCHAR_TABLE (elt)->defalt; | |
237 if (c2 < 32 | |
238 || (elt = XCHAR_TABLE (elt)->contents[c2], | |
239 NILP (elt))) | |
240 return defalt; | |
241 return elt; | |
242 } | |
243 | |
244 | |
245 #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c) | |
246 | |
247 static INLINE Lisp_Object | |
248 fontset_ref_via_base (fontset, c) | |
249 Lisp_Object fontset; | |
250 int *c; | |
251 { | |
252 int charset, c1, c2; | |
253 Lisp_Object elt; | |
254 int i; | |
255 | |
256 if (SINGLE_BYTE_CHAR_P (*c)) | |
257 return FONTSET_ASCII (fontset); | |
258 | |
259 elt = FONTSET_REF (FONTSET_BASE (fontset), *c); | |
260 if (NILP (elt)) | |
261 return Qnil; | |
262 | |
263 *c = XINT (XCAR (elt)); | |
264 SPLIT_NON_ASCII_CHAR (*c, charset, c1, c2); | |
265 elt = XCHAR_TABLE (fontset)->contents[charset + 128]; | |
266 if (c1 < 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[c1]; | |
271 if (c2 < 32) | |
272 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt); | |
273 if (!SUB_CHAR_TABLE_P (elt)) | |
274 return Qnil; | |
275 elt = XCHAR_TABLE (elt)->contents[c2]; | |
276 return elt; | |
277 } | |
278 | |
279 | |
280 /* Store into the element of FONTSET at index C the value NEWETL. */ | |
281 #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt) | |
282 | |
283 static void | |
284 fontset_set (fontset, c, newelt) | |
285 Lisp_Object fontset; | |
286 int c; | |
287 Lisp_Object newelt; | |
288 { | |
289 int charset, code[3]; | |
290 Lisp_Object *elt, tmp; | |
291 int i, j; | |
292 | |
293 if (SINGLE_BYTE_CHAR_P (c)) | |
294 { | |
295 FONTSET_ASCII (fontset) = newelt; | |
296 return; | |
297 } | |
298 | |
299 SPLIT_NON_ASCII_CHAR (c, charset, code[0], code[1]); | |
300 code[2] = 0; /* anchor */ | |
301 elt = &XCHAR_TABLE (fontset)->contents[charset + 128]; | |
302 for (i = 0; code[i] > 0; i++) | |
303 { | |
304 if (!SUB_CHAR_TABLE_P (*elt)) | |
305 *elt = make_sub_char_table (*elt); | |
306 elt = &XCHAR_TABLE (*elt)->contents[code[i]]; | |
307 } | |
308 if (SUB_CHAR_TABLE_P (*elt)) | |
309 XCHAR_TABLE (*elt)->defalt = newelt; | |
310 else | |
311 *elt = newelt; | |
312 } | |
313 | |
314 | |
315 /* Return a newly created fontset with NAME. If BASE is nil, make a | |
316 base fontset. Otherwise make a realized fontset whose parent is | |
317 BASE. */ | |
318 | |
319 static Lisp_Object | |
320 make_fontset (frame, name, base) | |
321 Lisp_Object frame, name, base; | |
322 { | |
323 Lisp_Object fontset, elt, base_elt; | |
324 int size = ASIZE (Vfontset_table); | |
325 int id = next_fontset_id; | |
326 int i, j; | |
327 | |
328 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is | |
329 the next available fontset ID. So it is expected that this loop | |
330 terminates quickly. In addition, as the last element of | |
331 Vfotnset_table is always nil, we don't have to check the range of | |
332 id. */ | |
333 while (!NILP (AREF (Vfontset_table, id))) id++; | |
334 | |
335 if (id + 1 == size) | |
336 { | |
337 Lisp_Object tem; | |
338 int i; | |
339 | |
340 tem = Fmake_vector (make_number (size + 8), Qnil); | |
341 for (i = 0; i < size; i++) | |
342 AREF (tem, i) = AREF (Vfontset_table, i); | |
343 Vfontset_table = tem; | |
344 } | |
345 | |
346 if (NILP (base)) | |
347 fontset = Fcopy_sequence (Vdefault_fontset); | |
348 else | |
349 fontset = Fmake_char_table (Qfontset, Qnil); | |
350 | |
351 FONTSET_ID (fontset) = make_number (id); | |
352 FONTSET_NAME (fontset) = name; | |
353 FONTSET_FRAME (fontset) = frame; | |
354 FONTSET_BASE (fontset) = base; | |
355 | |
356 AREF (Vfontset_table, id) = fontset; | |
357 next_fontset_id = id + 1; | |
358 return fontset; | |
359 } | |
360 | |
361 | |
362 /* Return 1 if ID is a valid fontset id, else return 0. */ | |
363 | |
364 static INLINE int | |
365 fontset_id_valid_p (id) | |
366 int id; | |
367 { | |
368 return (id >= 0 && id < ASIZE (Vfontset_table) - 1); | |
369 } | |
370 | |
371 | |
372 /* Extract `family' and `registry' string from FONTNAME and set in | |
373 *FAMILY and *REGISTRY respectively. Actually, `family' may also | |
374 contain `foundry', `registry' may also contain `encoding' of | |
375 FONTNAME. */ | |
376 | |
377 static Lisp_Object | |
378 font_family_registry (fontname) | |
379 Lisp_Object fontname; | |
380 { | |
381 Lisp_Object family, registry; | |
382 char *p = XSTRING (fontname)->data; | |
383 char *sep[15]; | |
384 int i = 0; | |
385 | |
386 while (*p && i < 15) if (*p++ == '-') sep[i++] = p; | |
387 if (i != 14) | |
388 return fontname; | |
389 | |
390 family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]); | |
391 registry = make_unibyte_string (sep[12], p - sep[12]); | |
392 return Fcons (family, registry); | |
393 } | |
394 | |
395 | |
396 /********** INTERFACES TO xfaces.c and dispextern.h **********/ | |
397 | |
398 /* Return name of the fontset with ID. */ | |
399 | |
400 Lisp_Object | |
401 fontset_name (id) | |
402 int id; | |
403 { | |
404 Lisp_Object fontset; | |
405 fontset = FONTSET_FROM_ID (id); | |
406 return FONTSET_NAME (fontset); | |
407 } | |
408 | |
409 | |
410 /* Return ASCII font name of the fontset with ID. */ | |
411 | |
412 Lisp_Object | |
413 fontset_ascii (id) | |
414 int id; | |
415 { | |
416 Lisp_Object fontset, elt; | |
417 fontset= FONTSET_FROM_ID (id); | |
418 elt = FONTSET_ASCII (fontset); | |
419 return XCDR (elt); | |
420 } | |
421 | |
422 | |
423 /* Free fontset of FACE. Called from free_realized_face. */ | |
103 | 424 |
104 void | 425 void |
105 free_fontset_data (fontset_data) | 426 free_face_fontset (f, face) |
106 struct fontset_data *fontset_data; | 427 FRAME_PTR f; |
107 { | 428 struct face *face; |
108 if (fontset_data->fontset_table) | 429 { |
109 { | 430 if (fontset_id_valid_p (face->fontset)) |
110 int i; | 431 { |
111 | 432 AREF (Vfontset_table, face->fontset) = Qnil; |
112 for (i = 0; i < fontset_data->n_fontsets; i++) | 433 if (face->fontset < next_fontset_id) |
113 { | 434 next_fontset_id = face->fontset; |
114 int j; | 435 } |
115 | 436 } |
116 xfree (fontset_data->fontset_table[i]->name); | 437 |
117 for (j = 0; j <= MAX_CHARSET; j++) | 438 |
118 if (fontset_data->fontset_table[i]->fontname[j]) | 439 /* Return 1 iff FACE is suitable for displaying character C. |
119 xfree (fontset_data->fontset_table[i]->fontname[j]); | 440 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P |
120 xfree (fontset_data->fontset_table[i]); | 441 when C is not a single byte character.. */ |
121 } | 442 |
122 xfree (fontset_data->fontset_table); | 443 int |
123 } | 444 face_suitable_for_char_p (face, c) |
124 | 445 struct face *face; |
125 xfree (fontset_data); | 446 int c; |
126 } | 447 { |
127 | 448 Lisp_Object fontset, elt; |
128 /* Load a font named FONTNAME for displaying CHARSET on frame F. | 449 |
129 All fonts for frame F is stored in a table pointed by FONT_TABLE. | 450 if (SINGLE_BYTE_CHAR_P (c)) |
130 Return a pointer to the struct font_info of the loaded font. | 451 return (face == face->ascii_face); |
131 If loading fails, return 0; | 452 |
132 If FONTNAME is NULL, the name is taken from the information of FONTSET. | 453 xassert (fontset_id_valid_p (face->fontset)); |
133 If FONTSET is given, try to load a font whose size matches that of | 454 fontset = FONTSET_FROM_ID (face->fontset); |
134 FONTSET, and, the font index is stored in the table for FONTSET. | 455 xassert (!BASE_FONTSET_P (fontset)); |
135 | 456 |
136 If you give FONTSET argument, don't call this function directry, | 457 elt = FONTSET_REF_VIA_BASE (fontset, c); |
137 instead call macro FS_LOAD_FONT with the same argument. */ | 458 return (!NILP (elt) && face->id == XFASTINT (elt)); |
459 } | |
460 | |
461 | |
462 /* Return ID of face suitable for displaying character C on frame F. | |
463 The selection of face is done based on the fontset of FACE. FACE | |
464 should already have been realized for ASCII characters. Called | |
465 from the macro FACE_FOR_CHAR when C is not a single byte character. */ | |
466 | |
467 int | |
468 face_for_char (f, face, c) | |
469 FRAME_PTR f; | |
470 struct face *face; | |
471 int c; | |
472 { | |
473 Lisp_Object fontset, elt; | |
474 int face_id; | |
475 | |
476 xassert (fontset_id_valid_p (face->fontset)); | |
477 fontset = FONTSET_FROM_ID (face->fontset); | |
478 xassert (!BASE_FONTSET_P (fontset)); | |
479 | |
480 elt = FONTSET_REF_VIA_BASE (fontset, c); | |
481 if (!NILP (elt)) | |
482 return XINT (elt); | |
483 | |
484 /* No face is recorded for C in the fontset of FACE. Make a new | |
485 realized face for C that has the same fontset. */ | |
486 face_id = lookup_face (f, face->lface, c, face); | |
487 | |
488 /* Record the face ID in FONTSET at the same index as the | |
489 information in the base fontset. */ | |
490 FONTSET_SET (fontset, c, make_number (face_id)); | |
491 return face_id; | |
492 } | |
493 | |
494 | |
495 /* Make a realized fontset for ASCII face FACE on frame F from the | |
496 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the | |
497 default fontset as the base. Value is the id of the new fontset. | |
498 Called from realize_x_face. */ | |
499 | |
500 int | |
501 make_fontset_for_ascii_face (f, base_fontset_id) | |
502 FRAME_PTR f; | |
503 int base_fontset_id; | |
504 { | |
505 Lisp_Object base_fontset, fontset, name, frame; | |
506 | |
507 XSETFRAME (frame, f); | |
508 if (base_fontset_id >= 0) | |
509 { | |
510 base_fontset = FONTSET_FROM_ID (base_fontset_id); | |
511 if (!BASE_FONTSET_P (base_fontset)) | |
512 base_fontset = FONTSET_BASE (base_fontset); | |
513 xassert (BASE_FONTSET_P (base_fontset)); | |
514 } | |
515 else | |
516 base_fontset = Vdefault_fontset; | |
517 | |
518 fontset = make_fontset (frame, Qnil, base_fontset); | |
519 return FONTSET_ID (fontset); | |
520 } | |
521 | |
522 | |
523 /* Return the font name pattern for C that is recorded in the fontset | |
524 with ID. A font is opened by that pattern to get the fullname. If | |
525 the fullname conform to XLFD, extract foundry-family field and | |
526 registry-encoding field, and return the cons of them. Otherwise | |
527 return the fullname. If ID is -1, or the fontset doesn't contain | |
528 information about C, get the registry and encoding of C from the | |
529 default fontset. Called from choose_face_font. */ | |
530 | |
531 Lisp_Object | |
532 fontset_font_pattern (f, id, c) | |
533 FRAME_PTR f; | |
534 int id, c; | |
535 { | |
536 Lisp_Object fontset, elt; | |
537 struct font_info *fontp; | |
538 Lisp_Object family_registry; | |
539 | |
540 elt = Qnil; | |
541 if (fontset_id_valid_p (id)) | |
542 { | |
543 fontset = FONTSET_FROM_ID (id); | |
544 xassert (!BASE_FONTSET_P (fontset)); | |
545 fontset = FONTSET_BASE (fontset); | |
546 elt = FONTSET_REF (fontset, c); | |
547 } | |
548 else | |
549 elt = FONTSET_REF (Vdefault_fontset, c); | |
550 | |
551 if (!CONSP (elt)) | |
552 return Qnil; | |
553 if (CONSP (XCDR (elt))) | |
554 return XCDR (elt); | |
555 | |
556 /* The fontset specifies only a font name pattern (not cons of | |
557 family and registry). Try to open a font by that pattern and get | |
558 a registry from the full name of the opened font. We ignore | |
559 family name here because it should be wild card in the fontset | |
560 specification. */ | |
561 elt = XCDR (elt); | |
562 xassert (STRINGP (elt)); | |
563 fontp = FS_LOAD_FONT (f, c, XSTRING (elt)->data, -1); | |
564 if (!fontp) | |
565 return Qnil; | |
566 | |
567 family_registry = font_family_registry (build_string (fontp->full_name)); | |
568 if (!CONSP (family_registry)) | |
569 return family_registry; | |
570 XCAR (family_registry) = Qnil; | |
571 return family_registry; | |
572 } | |
573 | |
574 | |
575 /* Load a font named FONTNAME to display character C on frame F. | |
576 Return a pointer to the struct font_info of the loaded font. If | |
577 loading fails, return NULL. If FACE is non-zero and a fontset is | |
578 assigned to it, record FACE->id in the fontset for C. If FONTNAME | |
579 is NULL, the name is taken from the fontset of FACE or what | |
580 specified by ID. */ | |
138 | 581 |
139 struct font_info * | 582 struct font_info * |
140 fs_load_font (f, font_table, charset, fontname, fontset) | 583 fs_load_font (f, c, fontname, id, face) |
141 FRAME_PTR f; | 584 FRAME_PTR f; |
142 struct font_info *font_table; | 585 int c; |
143 int charset, fontset; | |
144 char *fontname; | 586 char *fontname; |
145 { | 587 int id; |
146 Lisp_Object font_list; | 588 struct face *face; |
589 { | |
590 Lisp_Object fontset; | |
147 Lisp_Object list, elt; | 591 Lisp_Object list, elt; |
148 int font_idx; | 592 int font_idx; |
149 int size = 0; | 593 int size = 0; |
150 struct fontset_info *fontsetp = 0; | |
151 struct font_info *fontp; | 594 struct font_info *fontp; |
152 | 595 int charset = CHAR_CHARSET (c); |
153 if (fontset >= 0 && fontset < FRAME_FONTSET_DATA (f)->n_fontsets) | 596 |
154 { | 597 if (face) |
155 fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset]; | 598 id = face->fontset; |
156 font_idx = fontsetp->font_indexes[charset]; | 599 if (id < 0) |
157 if (font_idx >= 0) | 600 fontset = Qnil; |
158 /* We have already loaded a font. */ | 601 else |
159 return font_table + font_idx; | 602 fontset = FONTSET_FROM_ID (id); |
160 else if (font_idx == FONT_NOT_FOUND) | 603 |
161 /* We have already tried loading a font and failed. */ | 604 if (!NILP (fontset) |
162 return 0; | 605 && !BASE_FONTSET_P (fontset)) |
163 if (!fontname) | 606 { |
164 fontname = fontsetp->fontname[charset]; | 607 elt = FONTSET_REF_VIA_BASE (fontset, c); |
608 if (!NILP (elt)) | |
609 { | |
610 /* A suitable face for C is already recorded, which means | |
611 that a proper font is already loaded. */ | |
612 int face_id = XINT (elt); | |
613 | |
614 xassert (face_id == face->id); | |
615 face = FACE_FROM_ID (f, face_id); | |
616 return (*get_font_info_func) (f, face->font_info_id); | |
617 } | |
618 | |
619 if (!fontname && charset == CHARSET_ASCII) | |
620 { | |
621 elt = FONTSET_ASCII (fontset); | |
622 fontname = XSTRING (XCDR (elt))->data; | |
623 } | |
165 } | 624 } |
166 | 625 |
167 if (!fontname) | 626 if (!fontname) |
168 /* No way to get fontname. */ | 627 /* No way to get fontname. */ |
169 return 0; | 628 return 0; |
170 | 629 |
171 /* If CHARSET is not ASCII and FONTSET is specified, we must load a | |
172 font of appropriate size to be used with other fonts in this | |
173 fontset. */ | |
174 if (charset != CHARSET_ASCII && fontsetp) | |
175 { | |
176 /* If we have not yet loaded ASCII font of FONTSET, we must load | |
177 it now to decided the size and height of this fontset. */ | |
178 if (fontsetp->size == 0) | |
179 { | |
180 fontp = fs_load_font (f, font_table, CHARSET_ASCII, 0, fontset); | |
181 if (!fontp) | |
182 /* Any fontset should contain available ASCII. */ | |
183 return 0; | |
184 } | |
185 /* Now we have surely decided the size of this fontset. */ | |
186 size = fontsetp->size * CHARSET_WIDTH (charset); | |
187 } | |
188 | |
189 fontp = (*load_font_func) (f, fontname, size); | 630 fontp = (*load_font_func) (f, fontname, size); |
190 | |
191 if (!fontp) | 631 if (!fontp) |
192 { | 632 return 0; |
193 if (fontsetp) | 633 |
194 fontsetp->font_indexes[charset] = FONT_NOT_FOUND; | 634 /* Fill in members (charset, vertical_centering, encoding, etc) of |
195 return 0; | 635 font_info structure that are not set by (*load_font_func). */ |
196 } | |
197 | |
198 /* Fill in fields (charset, vertical_centering, encoding, and | |
199 font_encoder) which are not set by (*load_font_func). */ | |
200 fontp->charset = charset; | 636 fontp->charset = charset; |
201 | 637 |
202 fontp->vertical_centering | 638 fontp->vertical_centering |
203 = (STRINGP (Vvertical_centering_font_regexp) | 639 = (STRINGP (Vvertical_centering_font_regexp) |
204 && (fast_c_string_match_ignore_case | 640 && (fast_c_string_match_ignore_case |
214 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++) | 650 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++) |
215 fontp->encoding[i] = fontp->encoding[1]; | 651 fontp->encoding[i] = fontp->encoding[1]; |
216 } | 652 } |
217 else | 653 else |
218 { | 654 { |
219 /* The font itself doesn't tell which code points to be used. */ | 655 /* The font itself doesn't have information about encoding. */ |
220 int i; | 656 int i; |
221 | 657 |
222 /* At first, set 1 (means 0xA0..0xFF) as the default. */ | 658 /* At first, set 1 (means 0xA0..0xFF) as the default. */ |
223 fontp->encoding[0] = 1; | 659 fontp->encoding[0] = 1; |
224 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++) | 660 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++) |
249 fontp->font_encoder = (struct ccl_program *) 0; | 685 fontp->font_encoder = (struct ccl_program *) 0; |
250 | 686 |
251 if (find_ccl_program_func) | 687 if (find_ccl_program_func) |
252 (*find_ccl_program_func) (fontp); | 688 (*find_ccl_program_func) (fontp); |
253 | 689 |
254 /* If FONTSET is specified, setup various fields of it. */ | |
255 if (fontsetp) | |
256 { | |
257 fontsetp->font_indexes[charset] = fontp->font_idx; | |
258 if (charset == CHARSET_ASCII) | |
259 { | |
260 /* Decide or change the size and height of this fontset. */ | |
261 if (fontsetp->size == 0) | |
262 { | |
263 fontsetp->size = fontp->size; | |
264 fontsetp->height = fontp->height; | |
265 } | |
266 else if (fontsetp->size != fontp->size | |
267 || fontsetp->height != fontp->height) | |
268 { | |
269 /* When loading ASCII font of the different size from | |
270 the size of FONTSET, we have to update the size of | |
271 FONTSET. Since changing the size of FONTSET may make | |
272 some fonts already loaded inappropriate to be used in | |
273 FONTSET, we must delete the record of such fonts. In | |
274 that case, we also have to calculate the height of | |
275 FONTSET from the remaining fonts. */ | |
276 int i; | |
277 | |
278 fontsetp->size = fontp->size; | |
279 fontsetp->height = fontp->height; | |
280 for (i = CHARSET_ASCII + 1; i <= MAX_CHARSET; i++) | |
281 { | |
282 font_idx = fontsetp->font_indexes[i]; | |
283 if (font_idx >= 0) | |
284 { | |
285 struct font_info *fontp2 = font_table + font_idx; | |
286 | |
287 if (fontp2->size != fontp->size * CHARSET_WIDTH (i)) | |
288 fontsetp->font_indexes[i] = FONT_NOT_OPENED; | |
289 /* The following code should be disabled until | |
290 Emacs supports variable height lines. */ | |
291 #if 0 | |
292 else if (fontsetp->height < fontp->height) | |
293 fontsetp->height = fontp->height; | |
294 #endif | |
295 } | |
296 } | |
297 } | |
298 } | |
299 } | |
300 | |
301 return fontp; | 690 return fontp; |
302 } | 691 } |
303 | 692 |
304 /* Return ID of the fontset named NAME on frame F. */ | 693 |
305 | |
306 int | |
307 fs_query_fontset (f, name) | |
308 FRAME_PTR f; | |
309 char *name; | |
310 { | |
311 struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f); | |
312 int i; | |
313 | |
314 for (i = 0; i < fontset_data->n_fontsets; i++) | |
315 if (!my_strcasecmp(name, fontset_data->fontset_table[i]->name)) | |
316 return i; | |
317 return -1; | |
318 } | |
319 | |
320 /* Register a fontset specified by FONTSET_INFO for frame FRAME. | |
321 Return the fontset ID if successfully registered, else return -1. | |
322 FONTSET_INFO is a cons of name of the fontset and FONTLIST, where | |
323 FONTLIST is an alist of charsets vs fontnames. */ | |
324 | |
325 int | |
326 fs_register_fontset (f, fontset_info) | |
327 FRAME_PTR f; | |
328 Lisp_Object fontset_info; | |
329 { | |
330 struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f); | |
331 Lisp_Object name, fontlist; | |
332 int fontset; | |
333 struct fontset_info *fontsetp; | |
334 int i; | |
335 | |
336 if (!CONSP (fontset_info) | |
337 || !STRINGP (XCAR (fontset_info)) | |
338 || !CONSP (XCDR (fontset_info))) | |
339 /* Invalid data in FONTSET_INFO. */ | |
340 return -1; | |
341 | |
342 name = XCAR (fontset_info); | |
343 if ((fontset = fs_query_fontset (f, XSTRING (name)->data)) >= 0) | |
344 /* This fontset already exists on frame F. */ | |
345 return fontset; | |
346 | |
347 fontsetp = (struct fontset_info *) xmalloc (sizeof (struct fontset_info)); | |
348 | |
349 fontsetp->name = (char *) xmalloc (XSTRING (name)->size + 1); | |
350 bcopy(XSTRING (name)->data, fontsetp->name, XSTRING (name)->size + 1); | |
351 | |
352 fontsetp->size = fontsetp->height = 0; | |
353 | |
354 for (i = 0; i <= MAX_CHARSET; i++) | |
355 { | |
356 fontsetp->fontname[i] = (char *) 0; | |
357 fontsetp->font_indexes[i] = FONT_NOT_OPENED; | |
358 } | |
359 | |
360 for (fontlist = XCDR (fontset_info); CONSP (fontlist); | |
361 fontlist = XCDR (fontlist)) | |
362 { | |
363 Lisp_Object tem = Fcar (fontlist); | |
364 int charset; | |
365 | |
366 if (CONSP (tem) | |
367 && (charset = get_charset_id (XCAR (tem))) >= 0 | |
368 && STRINGP (XCDR (tem))) | |
369 { | |
370 fontsetp->fontname[charset] | |
371 = (char *) xmalloc (XSTRING (XCDR (tem))->size + 1); | |
372 bcopy (XSTRING (XCDR (tem))->data, | |
373 fontsetp->fontname[charset], | |
374 XSTRING (XCDR (tem))->size + 1); | |
375 } | |
376 else | |
377 /* Broken or invalid data structure. */ | |
378 return -1; | |
379 } | |
380 | |
381 /* Do we need to create the table? */ | |
382 if (fontset_data->fontset_table_size == 0) | |
383 { | |
384 fontset_data->fontset_table_size = 8; | |
385 fontset_data->fontset_table | |
386 = (struct fontset_info **) xmalloc (fontset_data->fontset_table_size | |
387 * sizeof (struct fontset_info *)); | |
388 } | |
389 /* Do we need to grow the table? */ | |
390 else if (fontset_data->n_fontsets >= fontset_data->fontset_table_size) | |
391 { | |
392 fontset_data->fontset_table_size += 8; | |
393 fontset_data->fontset_table | |
394 = (struct fontset_info **) xrealloc (fontset_data->fontset_table, | |
395 fontset_data->fontset_table_size | |
396 * sizeof (struct fontset_info *)); | |
397 } | |
398 fontset = fontset_data->n_fontsets++; | |
399 fontset_data->fontset_table[fontset] = fontsetp; | |
400 | |
401 return fontset; | |
402 } | |
403 | |
404 /* Cache data used by fontset_pattern_regexp. The car part is a | 694 /* Cache data used by fontset_pattern_regexp. The car part is a |
405 pattern string containing at least one wild card, the cdr part is | 695 pattern string containing at least one wild card, the cdr part is |
406 the corresponding regular expression. */ | 696 the corresponding regular expression. */ |
407 static Lisp_Object Vcached_fontset_data; | 697 static Lisp_Object Vcached_fontset_data; |
408 | 698 |
410 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data)) | 700 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data)) |
411 | 701 |
412 /* If fontset name PATTERN contains any wild card, return regular | 702 /* If fontset name PATTERN contains any wild card, return regular |
413 expression corresponding to PATTERN. */ | 703 expression corresponding to PATTERN. */ |
414 | 704 |
415 Lisp_Object | 705 static Lisp_Object |
416 fontset_pattern_regexp (pattern) | 706 fontset_pattern_regexp (pattern) |
417 Lisp_Object pattern; | 707 Lisp_Object pattern; |
418 { | 708 { |
419 if (!index (XSTRING (pattern)->data, '*') | 709 if (!index (XSTRING (pattern)->data, '*') |
420 && !index (XSTRING (pattern)->data, '?')) | 710 && !index (XSTRING (pattern)->data, '?')) |
450 } | 740 } |
451 | 741 |
452 return CACHED_FONTSET_REGEX; | 742 return CACHED_FONTSET_REGEX; |
453 } | 743 } |
454 | 744 |
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 | |
455 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0, | 793 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0, |
456 "Return the name of an existing fontset which matches PATTERN.\n\ | 794 "Return the name of a fontset that matches PATTERN.\n\ |
457 The value is nil if there is no matching fontset.\n\ | 795 The value is nil if there is no matching fontset.\n\ |
458 PATTERN can contain `*' or `?' as a wildcard\n\ | 796 PATTERN can contain `*' or `?' as a wildcard\n\ |
459 just as X font name matching algorithm allows.\n\ | 797 just as X font name matching algorithm allows.\n\ |
460 If REGEXPP is non-nil, PATTERN is a regular expression.") | 798 If REGEXPP is non-nil, PATTERN is a regular expression.") |
461 (pattern, regexpp) | 799 (pattern, regexpp) |
462 Lisp_Object pattern, regexpp; | 800 Lisp_Object pattern, regexpp; |
463 { | 801 { |
464 Lisp_Object regexp, tem; | 802 Lisp_Object fontset; |
803 int id; | |
465 | 804 |
466 (*check_window_system_func) (); | 805 (*check_window_system_func) (); |
467 | 806 |
468 CHECK_STRING (pattern, 0); | 807 CHECK_STRING (pattern, 0); |
469 | 808 |
470 if (XSTRING (pattern)->size == 0) | 809 if (XSTRING (pattern)->size == 0) |
471 return Qnil; | 810 return Qnil; |
472 | 811 |
473 tem = Frassoc (pattern, Vfontset_alias_alist); | 812 id = fs_query_fontset (pattern, !NILP (regexpp)); |
474 if (!NILP (tem)) | 813 if (id < 0) |
475 return Fcar (tem); | 814 return Qnil; |
476 | 815 |
477 if (NILP (regexpp)) | 816 fontset = FONTSET_FROM_ID (id); |
478 regexp = fontset_pattern_regexp (pattern); | 817 return FONTSET_NAME (fontset); |
479 else | 818 } |
480 regexp = pattern; | 819 |
481 | 820 /* Return a list of base fontset names matching PATTERN on frame F. |
482 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem)) | 821 If SIZE is not 0, it is the size (maximum bound width) of fontsets |
483 { | 822 to be listed. */ |
484 Lisp_Object fontset_name = XCAR (XCAR (tem)); | |
485 if (!NILP (regexp)) | |
486 { | |
487 if (fast_c_string_match_ignore_case (regexp, | |
488 XSTRING (fontset_name)->data) | |
489 >= 0) | |
490 return fontset_name; | |
491 } | |
492 else | |
493 { | |
494 if (!my_strcasecmp (XSTRING (pattern)->data, | |
495 XSTRING (fontset_name)->data)) | |
496 return fontset_name; | |
497 } | |
498 } | |
499 | |
500 return Qnil; | |
501 } | |
502 | |
503 /* Return a list of names of available fontsets matching PATTERN on | |
504 frame F. If SIZE is not 0, it is the size (maximum bound width) of | |
505 fontsets to be listed. */ | |
506 | 823 |
507 Lisp_Object | 824 Lisp_Object |
508 list_fontsets (f, pattern, size) | 825 list_fontsets (f, pattern, size) |
509 FRAME_PTR f; | 826 FRAME_PTR f; |
510 Lisp_Object pattern; | 827 Lisp_Object pattern; |
511 int size; | 828 int size; |
512 { | 829 { |
513 int i; | 830 Lisp_Object frame, regexp, val, tail; |
514 Lisp_Object regexp, val; | 831 int id; |
832 | |
833 XSETFRAME (frame, f); | |
515 | 834 |
516 regexp = fontset_pattern_regexp (pattern); | 835 regexp = fontset_pattern_regexp (pattern); |
517 | |
518 val = Qnil; | 836 val = Qnil; |
519 for (i = 0; i < FRAME_FONTSET_DATA (f)->n_fontsets; i++) | 837 |
520 { | 838 for (id = 0; id < ASIZE (Vfontset_table); id++) |
521 struct fontset_info *fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[i]; | 839 { |
522 int name_matched = 0; | 840 Lisp_Object fontset; |
523 int size_matched = 0; | 841 unsigned char *name; |
524 | 842 |
525 if (!NILP (regexp)) | 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; | |
849 | |
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) | |
526 { | 856 { |
527 if (fast_c_string_match_ignore_case (regexp, fontsetp->name) >= 0) | 857 struct font_info *fontp; |
528 name_matched = 1; | 858 fontp = FS_LOAD_FONT (f, 0, NULL, id); |
859 if (!fontp || size != fontp->size) | |
860 continue; | |
529 } | 861 } |
530 else | 862 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val); |
531 { | |
532 if (!my_strcasecmp (XSTRING (pattern)->data, fontsetp->name)) | |
533 name_matched = 1; | |
534 } | |
535 | |
536 if (name_matched) | |
537 { | |
538 if (!size || fontsetp->size == size) | |
539 size_matched = 1; | |
540 else if (fontsetp->size == 0) | |
541 { | |
542 /* No font of this fontset has loaded yet. Try loading | |
543 one with SIZE. */ | |
544 int j; | |
545 | |
546 for (j = 0; j <= MAX_CHARSET; j++) | |
547 if (fontsetp->fontname[j]) | |
548 { | |
549 if ((*load_font_func) (f, fontsetp->fontname[j], size)) | |
550 size_matched = 1; | |
551 break; | |
552 } | |
553 } | |
554 | |
555 if (size_matched) | |
556 val = Fcons (build_string (fontsetp->name), val); | |
557 } | |
558 } | 863 } |
559 | 864 |
560 return val; | 865 return val; |
561 } | 866 } |
562 | 867 |
563 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0, | 868 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0, |
564 "Create a new fontset NAME which contains fonts in FONTLIST.\n\ | 869 "Create a new fontset NAME that contains font information in FONTLIST.\n\ |
565 FONTLIST is an alist of charsets vs corresponding font names.") | 870 FONTLIST is an alist of charsets vs corresponding font name patterns.") |
566 (name, fontlist) | 871 (name, fontlist) |
567 Lisp_Object name, fontlist; | 872 Lisp_Object name, fontlist; |
568 { | 873 { |
569 Lisp_Object fullname, fontset_info; | 874 Lisp_Object fontset, elements, ascii_font; |
570 Lisp_Object tail; | 875 Lisp_Object tem, tail, elt; |
571 | 876 |
572 (*check_window_system_func) (); | 877 (*check_window_system_func) (); |
573 | 878 |
574 CHECK_STRING (name, 0); | 879 CHECK_STRING (name, 0); |
575 CHECK_LIST (fontlist, 1); | 880 CHECK_LIST (fontlist, 1); |
576 | 881 |
577 fullname = Fquery_fontset (name, Qnil); | 882 name = Fdowncase (name); |
578 if (!NILP (fullname)) | 883 tem = Fquery_fontset (name, Qnil); |
884 if (!NILP (tem)) | |
579 error ("Fontset `%s' matches the existing fontset `%s'", | 885 error ("Fontset `%s' matches the existing fontset `%s'", |
580 XSTRING (name)->data, XSTRING (fullname)->data); | 886 XSTRING (name)->data, XSTRING (tem)->data); |
581 | 887 |
582 /* Check the validity of FONTLIST. */ | 888 /* Check the validity of FONTLIST while creating a template for |
889 fontset elements. */ | |
890 elements = ascii_font = Qnil; | |
583 for (tail = fontlist; CONSP (tail); tail = XCDR (tail)) | 891 for (tail = fontlist; CONSP (tail); tail = XCDR (tail)) |
584 { | 892 { |
585 Lisp_Object tem = XCAR (tail); | 893 Lisp_Object family, registry; |
586 int charset; | 894 int c, charset; |
587 | 895 |
896 tem = XCAR (tail); | |
588 if (!CONSP (tem) | 897 if (!CONSP (tem) |
589 || (charset = get_charset_id (XCAR (tem))) < 0 | 898 || (charset = get_charset_id (XCAR (tem))) < 0 |
590 || !STRINGP (XCDR (tem))) | 899 || !STRINGP (XCDR (tem))) |
591 error ("Elements of fontlist must be a cons of charset and font name"); | 900 error ("Elements of fontlist must be a cons of charset and font name"); |
592 } | 901 |
593 | 902 tem = Fdowncase (XCDR (tem)); |
594 fontset_info = Fcons (name, fontlist); | 903 if (charset == CHARSET_ASCII) |
595 Vglobal_fontset_alist = Fcons (fontset_info, Vglobal_fontset_alist); | 904 ascii_font = tem; |
596 | 905 else |
597 /* Register this fontset for all existing frames. */ | 906 { |
598 { | 907 c = MAKE_CHAR (charset, 0, 0); |
599 Lisp_Object framelist, frame; | 908 elements = Fcons (Fcons (make_number (c), tem), elements); |
600 | 909 } |
601 FOR_EACH_FRAME (framelist, frame) | 910 } |
602 if (!FRAME_TERMCAP_P (XFRAME (frame))) | 911 |
603 fs_register_fontset (XFRAME (frame), fontset_info); | 912 if (NILP (ascii_font)) |
604 } | 913 error ("No ASCII font in the fontlist"); |
914 | |
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 } | |
605 | 923 |
606 return Qnil; | 924 return Qnil; |
607 } | 925 } |
608 | 926 |
609 extern Lisp_Object Qfont; | 927 |
610 Lisp_Object Qfontset; | 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 /* Return 1 iff REGISTRY is a valid string as the font registry and | |
942 encoding. It is valid if it doesn't start with `-' and the number | |
943 of `-' in the string is at most 1. */ | |
944 | |
945 static int | |
946 check_registry_encoding (registry) | |
947 Lisp_Object registry; | |
948 { | |
949 unsigned char *str = XSTRING (registry)->data; | |
950 unsigned char *p = str; | |
951 int i; | |
952 | |
953 if (!*p || *p++ == '-') | |
954 return 0; | |
955 for (i = 0; *p; p++) | |
956 if (*p == '-') i++; | |
957 return (i < 2); | |
958 } | |
959 | |
960 | |
961 /* Check validity of NAME as a fontset name and return the | |
962 corresponding fontset. If not valid, signal an error. | |
963 If NAME is t, return Vdefault_fontset. */ | |
964 | |
965 static Lisp_Object | |
966 check_fontset_name (name) | |
967 Lisp_Object name; | |
968 { | |
969 int id; | |
970 | |
971 if (EQ (name, Qt)) | |
972 return Vdefault_fontset; | |
973 | |
974 CHECK_STRING (name, 0); | |
975 id = fs_query_fontset (name, 0); | |
976 if (id < 0) | |
977 error ("Fontset `%s' does not exist", XSTRING (name)->data); | |
978 return FONTSET_FROM_ID (id); | |
979 } | |
611 | 980 |
612 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0, | 981 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0, |
613 "Set FONTNAME for a font of CHARSET in fontset NAME on frame FRAME.\n\ | 982 "Modify fontset NAME to use FONTNAME for character CHAR. |
614 If FRAME is omitted or nil, all frames are affected.") | 983 |
615 (name, charset_symbol, fontname, frame) | 984 CHAR may be a cons; (FROM . TO), where FROM and TO are |
616 Lisp_Object name, charset_symbol, fontname, frame; | 985 non-generic characters. In that case, use FONTNAME |
617 { | 986 for all characters in the range FROM and TO (inclusive). |
618 int charset; | 987 |
619 Lisp_Object fullname, fontlist; | 988 If NAME is t, an entry in the default fontset is modified. |
620 | 989 In that case, FONTNAME should be a registry and encoding name |
621 (*check_window_system_func) (); | 990 of a font for CHAR.") |
622 | 991 (name, ch, fontname, frame) |
623 CHECK_STRING (name, 0); | 992 Lisp_Object name, ch, fontname, frame; |
624 CHECK_SYMBOL (charset_symbol, 1); | 993 { |
994 Lisp_Object fontset, elt; | |
995 Lisp_Object realized; | |
996 int from, to; | |
997 int id; | |
998 | |
999 fontset = check_fontset_name (name); | |
1000 | |
1001 if (CONSP (ch)) | |
1002 { | |
1003 /* CH should be (FROM . TO) where FROM and TO are non-generic | |
1004 characters. */ | |
1005 CHECK_NUMBER (XCAR (ch), 1); | |
1006 CHECK_NUMBER (XCDR (ch), 1); | |
1007 from = XINT (XCAR (ch)); | |
1008 to = XINT (XCDR (ch)); | |
1009 if (!char_valid_p (from, 0) || !char_valid_p (to, 0)) | |
1010 error ("Character range should be by non-generic characters."); | |
1011 if (!NILP (name) | |
1012 && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to))) | |
1013 error ("Can't change font for a single byte character"); | |
1014 } | |
1015 else | |
1016 { | |
1017 CHECK_NUMBER (ch, 1); | |
1018 from = XINT (ch); | |
1019 to = from; | |
1020 } | |
1021 if (!char_valid_p (from, 1)) | |
1022 invalid_character (from); | |
1023 if (SINGLE_BYTE_CHAR_P (from)) | |
1024 error ("Can't change font for a single byte character"); | |
1025 if (from < to) | |
1026 { | |
1027 if (!char_valid_p (to, 1)) | |
1028 invalid_character (to); | |
1029 if (SINGLE_BYTE_CHAR_P (to)) | |
1030 error ("Can't change font for a single byte character"); | |
1031 } | |
1032 | |
625 CHECK_STRING (fontname, 2); | 1033 CHECK_STRING (fontname, 2); |
1034 fontname = Fdowncase (fontname); | |
1035 if (fontset == Vdefault_fontset) | |
1036 { | |
1037 if (!check_registry_encoding (fontname)) | |
1038 error ("Invalid registry and encoding name: %s", | |
1039 XSTRING (fontname)->data); | |
1040 elt = Fcons (make_number (from), Fcons (Qnil, fontname)); | |
1041 } | |
1042 else | |
1043 elt = Fcons (make_number (from), font_family_registry (fontname)); | |
1044 | |
1045 /* The arg FRAME is kept for backward compatibility. We only check | |
1046 the validity. */ | |
626 if (!NILP (frame)) | 1047 if (!NILP (frame)) |
627 CHECK_LIVE_FRAME (frame, 3); | 1048 CHECK_LIVE_FRAME (frame, 3); |
628 | 1049 |
629 if ((charset = get_charset_id (charset_symbol)) < 0) | 1050 for (; from <= to; from++) |
630 error ("Invalid charset: %s", XSYMBOL (charset_symbol)->name->data); | 1051 FONTSET_SET (fontset, from, elt); |
631 | 1052 Foptimize_char_table (fontset); |
632 fullname = Fquery_fontset (name, Qnil); | 1053 |
633 if (NILP (fullname)) | 1054 /* If there's a realized fontset REALIZED whose parent is FONTSET, |
634 error ("Fontset `%s' does not exist", XSTRING (name)->data); | 1055 clear all the elements of REALIZED and free all multibyte faces |
635 | 1056 whose fontset is REALIZED. This way, the specified character(s) |
636 /* If FRAME is not specified, we must, at first, update contents of | 1057 are surely redisplayed by a correct font. */ |
637 `global-fontset-alist' for a frame created in the future. */ | 1058 for (id = 0; id < ASIZE (Vfontset_table); id++) |
638 if (NILP (frame)) | 1059 { |
639 { | 1060 realized = AREF (Vfontset_table, id); |
640 Lisp_Object fontset_info = Fassoc (fullname, Vglobal_fontset_alist); | 1061 if (!NILP (realized) |
641 Lisp_Object tem = Fassq (charset_symbol, XCDR (fontset_info)); | 1062 && !BASE_FONTSET_P (realized) |
642 | 1063 && EQ (FONTSET_BASE (realized), fontset)) |
643 if (NILP (tem)) | |
644 XCDR (fontset_info) | |
645 = Fcons (Fcons (charset_symbol, fontname), | |
646 XCDR (fontset_info)); | |
647 else | |
648 XCDR (tem) = fontname; | |
649 } | |
650 | |
651 /* Then, update information in the specified frame or all existing | |
652 frames. */ | |
653 { | |
654 Lisp_Object framelist, tem; | |
655 | |
656 FOR_EACH_FRAME (framelist, tem) | |
657 if (!FRAME_TERMCAP_P (XFRAME (tem)) | |
658 && (NILP (frame) || EQ (frame, tem))) | |
659 { | 1064 { |
660 FRAME_PTR f = XFRAME (tem); | 1065 FRAME_PTR f = XFRAME (FONTSET_FRAME (realized)); |
661 int fontset = fs_query_fontset (f, XSTRING (fullname)->data); | 1066 clear_fontset_elements (realized); |
662 struct fontset_info *fontsetp | 1067 free_realized_multibyte_face (f, id); |
663 = FRAME_FONTSET_DATA (f)->fontset_table[fontset]; | |
664 | |
665 if (fontsetp->fontname[charset]) | |
666 xfree (fontsetp->fontname[charset]); | |
667 fontsetp->fontname[charset] | |
668 = (char *) xmalloc (XSTRING (fontname)->size + 1); | |
669 bcopy (XSTRING (fontname)->data, fontsetp->fontname[charset], | |
670 XSTRING (fontname)->size + 1); | |
671 fontsetp->font_indexes[charset] = FONT_NOT_OPENED; | |
672 | |
673 if (charset == CHARSET_ASCII) | |
674 { | |
675 Lisp_Object font_param = Fassq (Qfont, Fframe_parameters (tem)); | |
676 | |
677 if (set_frame_fontset_func | |
678 && !NILP (font_param) | |
679 && !strcmp (XSTRING (fullname)->data, | |
680 XSTRING (XCDR (font_param))->data)) | |
681 /* This fontset is the default fontset on frame TEM. | |
682 We may have to resize this frame because of new | |
683 ASCII font. */ | |
684 (*set_frame_fontset_func) (f, fullname, Qnil); | |
685 } | |
686 } | 1068 } |
687 } | 1069 } |
688 | 1070 |
689 return Qnil; | 1071 return Qnil; |
690 } | 1072 } |
691 | 1073 |
692 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0, | 1074 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0, |
695 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\ | 1077 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\ |
696 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\ | 1078 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\ |
697 where\n\ | 1079 where\n\ |
698 OPENED-NAME is the name used for opening the font,\n\ | 1080 OPENED-NAME is the name used for opening the font,\n\ |
699 FULL-NAME is the full name of the font,\n\ | 1081 FULL-NAME is the full name of the font,\n\ |
700 CHARSET is the charset displayed by the font,\n\ | 1082 SIZE is the maximum bound width of the font,\n\ |
701 SIZE is the minimum bound width of the font,\n\ | |
702 HEIGHT is the height of the font,\n\ | 1083 HEIGHT is the height of the font,\n\ |
703 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\ | 1084 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\ |
704 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\ | 1085 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\ |
705 how to compose characters.\n\ | 1086 how to compose characters.\n\ |
706 If the named font is not yet loaded, return nil.") | 1087 If the named font is not yet loaded, return nil.") |
712 Lisp_Object info; | 1093 Lisp_Object info; |
713 | 1094 |
714 (*check_window_system_func) (); | 1095 (*check_window_system_func) (); |
715 | 1096 |
716 CHECK_STRING (name, 0); | 1097 CHECK_STRING (name, 0); |
1098 name = Fdowncase (name); | |
717 if (NILP (frame)) | 1099 if (NILP (frame)) |
718 frame = selected_frame; | 1100 frame = selected_frame; |
719 CHECK_LIVE_FRAME (frame, 1); | 1101 CHECK_LIVE_FRAME (frame, 1); |
720 f = XFRAME (frame); | 1102 f = XFRAME (frame); |
721 | 1103 |
724 | 1106 |
725 fontp = (*query_font_func) (f, XSTRING (name)->data); | 1107 fontp = (*query_font_func) (f, XSTRING (name)->data); |
726 if (!fontp) | 1108 if (!fontp) |
727 return Qnil; | 1109 return Qnil; |
728 | 1110 |
729 info = Fmake_vector (make_number (8), Qnil); | 1111 info = Fmake_vector (make_number (7), Qnil); |
730 | 1112 |
731 XVECTOR (info)->contents[0] = build_string (fontp->name); | 1113 XVECTOR (info)->contents[0] = build_string (fontp->name); |
732 XVECTOR (info)->contents[1] = build_string (fontp->full_name); | 1114 XVECTOR (info)->contents[1] = build_string (fontp->full_name); |
733 XVECTOR (info)->contents[2] = CHARSET_SYMBOL (fontp->charset); | 1115 XVECTOR (info)->contents[2] = make_number (fontp->size); |
734 XVECTOR (info)->contents[3] = make_number (fontp->size); | 1116 XVECTOR (info)->contents[3] = make_number (fontp->height); |
735 XVECTOR (info)->contents[4] = make_number (fontp->height); | 1117 XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset); |
736 XVECTOR (info)->contents[5] = make_number (fontp->baseline_offset); | 1118 XVECTOR (info)->contents[5] = make_number (fontp->relative_compose); |
737 XVECTOR (info)->contents[6] = make_number (fontp->relative_compose); | 1119 XVECTOR (info)->contents[6] = make_number (fontp->default_ascent); |
738 XVECTOR (info)->contents[7] = make_number (fontp->default_ascent); | |
739 | 1120 |
740 return info; | 1121 return info; |
741 } | 1122 } |
742 | 1123 |
743 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0, | 1124 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0, |
744 "Return information about a fontset named NAME on frame FRAME.\n\ | 1125 "Return information about a fontset named NAME on frame FRAME.\n\ |
745 If FRAME is omitted or nil, use the selected frame.\n\ | 1126 If FRAME is omitted or nil, use the selected frame.\n\ |
746 The returned value is a vector of SIZE, HEIGHT, and FONT-LIST,\n\ | 1127 The returned value is a vector of SIZE, HEIGHT, and FONT-LIST,\n\ |
747 where\n\ | 1128 where\n\ |
748 SIZE is the minimum bound width of ASCII font of the fontset,\n\ | 1129 SIZE is the maximum bound width of ASCII font of the fontset,\n\ |
749 HEIGHT is the height of the tallest font in the fontset, and\n\ | 1130 HEIGHT is the height of the ASCII font in the fontset, and\n\ |
750 FONT-LIST is an alist of the format:\n\ | 1131 FONT-LIST is an alist of the format:\n\ |
751 (CHARSET REQUESTED-FONT-NAME LOADED-FONT-NAME).\n\ | 1132 (CHARSET REQUESTED-FONT-NAME LOADED-FONT-NAME).\n\ |
752 LOADED-FONT-NAME t means the font is not yet loaded, nil means the\n\ | 1133 LOADED-FONT-NAME t means the font is not yet loaded, nil means the\n\ |
753 loading failed.") | 1134 loading failed.") |
754 (name, frame) | 1135 (name, frame) |
755 Lisp_Object name, frame; | 1136 Lisp_Object name, frame; |
756 { | 1137 { |
757 FRAME_PTR f; | 1138 FRAME_PTR f; |
758 int fontset; | 1139 Lisp_Object fontset, realized; |
759 struct fontset_info *fontsetp; | 1140 Lisp_Object info, val, loaded, requested; |
760 Lisp_Object info, val; | |
761 int i; | 1141 int i; |
762 | 1142 |
763 (*check_window_system_func) (); | 1143 (*check_window_system_func) (); |
764 | 1144 |
765 CHECK_STRING(name, 0); | 1145 fontset = check_fontset_name (name); |
1146 | |
766 if (NILP (frame)) | 1147 if (NILP (frame)) |
767 frame = selected_frame; | 1148 frame = selected_frame; |
768 CHECK_LIVE_FRAME (frame, 1); | 1149 CHECK_LIVE_FRAME (frame, 1); |
769 f = XFRAME (frame); | 1150 f = XFRAME (frame); |
770 | 1151 |
771 fontset = fs_query_fontset (f, XSTRING (name)->data); | |
772 if (fontset < 0) | |
773 error ("Fontset `%s' does not exist", XSTRING (name)->data); | |
774 | |
775 info = Fmake_vector (make_number (3), Qnil); | 1152 info = Fmake_vector (make_number (3), Qnil); |
776 | 1153 |
777 fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset]; | 1154 for (i = 0; i < ASIZE (Vfontset_table); i++) |
778 | 1155 { |
779 XVECTOR (info)->contents[0] = make_number (fontsetp->size); | 1156 realized = FONTSET_FROM_ID (i); |
780 XVECTOR (info)->contents[1] = make_number (fontsetp->height); | 1157 if (!NILP (realized) |
781 val = Qnil; | 1158 && EQ (FONTSET_FRAME (realized), frame) |
782 for (i = 0; i <= MAX_CHARSET; i++) | 1159 && EQ (FONTSET_BASE (realized), fontset) |
783 if (fontsetp->fontname[i]) | 1160 && INTEGERP (FONTSET_ASCII (realized))) |
784 { | 1161 break; |
785 int font_idx = fontsetp->font_indexes[i]; | 1162 } |
786 Lisp_Object loaded; | 1163 |
787 | 1164 if (NILP (realized)) |
788 if (font_idx == FONT_NOT_OPENED) | 1165 return Qnil; |
789 loaded = Qt; | 1166 |
790 else if (font_idx == FONT_NOT_FOUND) | 1167 XVECTOR (info)->contents[0] = Qnil; |
791 loaded = Qnil; | 1168 XVECTOR (info)->contents[1] = Qnil; |
792 else | 1169 loaded = Qnil; |
793 loaded | 1170 |
794 = build_string ((*get_font_info_func) (f, font_idx)->full_name); | 1171 val = Fcons (Fcons (CHARSET_SYMBOL (CHARSET_ASCII), |
795 val = Fcons (Fcons (CHARSET_SYMBOL (i), | 1172 Fcons (FONTSET_ASCII (fontset), |
796 Fcons (build_string (fontsetp->fontname[i]), | 1173 Fcons (loaded, Qnil))), |
797 Fcons (loaded, Qnil))), | 1174 Qnil); |
798 val); | 1175 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++) |
799 } | 1176 { |
1177 Lisp_Object elt; | |
1178 elt = XCHAR_TABLE (fontset)->contents[i + 128]; | |
1179 | |
1180 if (VECTORP (elt)) | |
1181 { | |
1182 int face_id; | |
1183 struct face *face; | |
1184 | |
1185 if (INTEGERP (AREF (elt, 2)) | |
1186 && (face_id = XINT (AREF (elt, 2)), | |
1187 face = FACE_FROM_ID (f, face_id))) | |
1188 { | |
1189 struct font_info *fontp; | |
1190 fontp = (*get_font_info_func) (f, face->font_info_id); | |
1191 requested = build_string (fontp->name); | |
1192 loaded = (fontp->full_name | |
1193 ? build_string (fontp->full_name) | |
1194 : Qnil); | |
1195 } | |
1196 else | |
1197 { | |
1198 char *str; | |
1199 int family_len = 0, registry_len = 0; | |
1200 | |
1201 if (STRINGP (AREF (elt, 0))) | |
1202 family_len = STRING_BYTES (XSTRING (AREF (elt, 0))); | |
1203 if (STRINGP (AREF (elt, 1))) | |
1204 registry_len = STRING_BYTES (XSTRING (AREF (elt, 1))); | |
1205 str = (char *) alloca (1 + family_len + 3 + registry_len + 1); | |
1206 str[0] = '-'; | |
1207 str[1] = 0; | |
1208 if (family_len) | |
1209 strcat (str, XSTRING (AREF (elt, 0))->data); | |
1210 strcat (str, "-*-"); | |
1211 if (registry_len) | |
1212 strcat (str, XSTRING (AREF (elt, 1))->data); | |
1213 requested = build_string (str); | |
1214 loaded = Qnil; | |
1215 } | |
1216 val = Fcons (Fcons (CHARSET_SYMBOL (i), | |
1217 Fcons (requested, Fcons (loaded, Qnil))), | |
1218 val); | |
1219 } | |
1220 } | |
800 XVECTOR (info)->contents[2] = val; | 1221 XVECTOR (info)->contents[2] = val; |
801 return info; | 1222 return info; |
802 } | 1223 } |
803 | 1224 |
1225 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0, | |
1226 "Return a font name pattern for character CH in fontset NAME. | |
1227 If NAME is t, find a font name pattern in the default fontset.") | |
1228 (name, ch) | |
1229 Lisp_Object name, ch; | |
1230 { | |
1231 int c, id; | |
1232 Lisp_Object fontset, elt; | |
1233 | |
1234 fontset = check_fontset_name (name); | |
1235 | |
1236 CHECK_NUMBER (ch, 1); | |
1237 c = XINT (ch); | |
1238 if (!char_valid_p (c, 1)) | |
1239 invalid_character (c); | |
1240 | |
1241 elt = FONTSET_REF (fontset, c); | |
1242 if (CONSP (elt)) | |
1243 elt = XCDR (elt); | |
1244 | |
1245 return elt; | |
1246 } | |
1247 | |
1248 | |
1249 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0, | |
1250 "Return a list of all defined fontset names.") | |
1251 () | |
1252 { | |
1253 Lisp_Object fontset, list; | |
1254 int i; | |
1255 | |
1256 list = Qnil; | |
1257 for (i = 0; i < ASIZE (Vfontset_table); i++) | |
1258 { | |
1259 fontset = FONTSET_FROM_ID (i); | |
1260 if (!NILP (fontset) | |
1261 && BASE_FONTSET_P (fontset)) | |
1262 list = Fcons (FONTSET_NAME (fontset), list); | |
1263 } | |
1264 return list; | |
1265 } | |
1266 | |
804 void | 1267 void |
805 syms_of_fontset () | 1268 syms_of_fontset () |
806 { | 1269 { |
807 int i; | 1270 int i; |
808 | |
809 for (i = 0; i < 256; i++) | |
810 my_strcasetbl[i] = (i >= 'A' && i <= 'Z') ? i + 'a' - 'A' : i; | |
811 | 1271 |
812 if (!load_font_func) | 1272 if (!load_font_func) |
813 /* Window system initializer should have set proper functions. */ | 1273 /* Window system initializer should have set proper functions. */ |
814 abort (); | 1274 abort (); |
815 | 1275 |
816 Qfontset = intern ("fontset"); | 1276 Qfontset = intern ("fontset"); |
817 staticpro (&Qfontset); | 1277 staticpro (&Qfontset); |
1278 Fput (Qfontset, Qchar_table_extra_slots, make_number (3)); | |
818 | 1279 |
819 Vcached_fontset_data = Qnil; | 1280 Vcached_fontset_data = Qnil; |
820 staticpro (&Vcached_fontset_data); | 1281 staticpro (&Vcached_fontset_data); |
821 | 1282 |
822 DEFVAR_LISP ("global-fontset-alist", &Vglobal_fontset_alist, | 1283 Vfontset_table = Fmake_vector (make_number (32), Qnil); |
823 "Internal data for fontset. Not for external use.\n\ | 1284 staticpro (&Vfontset_table); |
824 This is an alist associating fontset names with the lists of fonts\n\ | 1285 next_fontset_id = 0; |
825 contained in them.\n\ | 1286 |
826 Newly created frames make their own fontset database from here."); | 1287 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil); |
827 Vglobal_fontset_alist = Qnil; | 1288 staticpro (&Vdefault_fontset); |
1289 FONTSET_ASCII (Vdefault_fontset) | |
1290 = Fcons (make_number (0), Fcons (Qnil, build_string ("iso8859-1"))); | |
828 | 1291 |
829 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist, | 1292 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist, |
830 "Alist of fontname patterns vs corresponding encoding info.\n\ | 1293 "Alist of fontname patterns vs corresponding encoding info.\n\ |
831 Each element looks like (REGEXP . ENCODING-INFO),\n\ | 1294 Each element looks like (REGEXP . ENCODING-INFO),\n\ |
832 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\ | 1295 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\ |
892 defsubr (&Squery_fontset); | 1355 defsubr (&Squery_fontset); |
893 defsubr (&Snew_fontset); | 1356 defsubr (&Snew_fontset); |
894 defsubr (&Sset_fontset_font); | 1357 defsubr (&Sset_fontset_font); |
895 defsubr (&Sfont_info); | 1358 defsubr (&Sfont_info); |
896 defsubr (&Sfontset_info); | 1359 defsubr (&Sfontset_info); |
897 } | 1360 defsubr (&Sfontset_font); |
1361 defsubr (&Sfontset_list); | |
1362 } |