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