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