Patch for building Emacs on Mac OS X. April 26, 2002. See ChangeLog,
[bpt/emacs.git] / 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 char *p = XSTRING (fontname)->data;
374 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, XSTRING (elt)->data, -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 = XSTRING (XCDR (elt))->data;
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 (XSTRING (XCAR (Vcached_fontset_data))->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 (XSTRING (pattern)->data, '*')
719 && !index (XSTRING (pattern)->data, '?'))
720 /* PATTERN does not contain any wild cards. */
721 return Qnil;
722
723 if (!CONSP (Vcached_fontset_data)
724 || strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME))
725 {
726 /* We must at first update the cached data. */
727 char *regex = (char *) alloca (XSTRING (pattern)->size * 2 + 3);
728 char *p0, *p1 = regex;
729
730 /* Convert "*" to ".*", "?" to ".". */
731 *p1++ = '^';
732 for (p0 = (char *) XSTRING (pattern)->data; *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 (XSTRING (pattern)->data),
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 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 = XSTRING (FONTSET_NAME (fontset))->data;
793 if (regexpp
794 ? fast_c_string_match_ignore_case (name, this_name) >= 0
795 : !strcmp (XSTRING (name)->data, 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 (XSTRING (pattern)->size == 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 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 = XSTRING (FONTSET_NAME (fontset))->data;
858
859 if (!NILP (regexp)
860 ? (fast_c_string_match_ignore_case (regexp, name) < 0)
861 : strcmp (XSTRING (pattern)->data, 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 XSTRING (name)->data, XSTRING (tem)->data);
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 t, 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, Qt))
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", XSTRING (name)->data);
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 CHARACTER may be a cons; (FROM . TO), where FROM and TO are
980 non-generic characters. In that case, use FONTNAME
981 for all characters in the range FROM and TO (inclusive).
982 CHARACTER may be a charset. In that case, use FONTNAME
983 for all character in the charsets.
984
985 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family
986 name of a font, REGISTRY is a registry name of a font. */)
987 (name, character, fontname, frame)
988 Lisp_Object name, character, fontname, frame;
989 {
990 Lisp_Object fontset, elt;
991 Lisp_Object realized;
992 int from, to;
993 int id;
994 Lisp_Object family, registry;
995
996 fontset = check_fontset_name (name);
997
998 if (CONSP (character))
999 {
1000 /* CH should be (FROM . TO) where FROM and TO are non-generic
1001 characters. */
1002 CHECK_NUMBER_CAR (character);
1003 CHECK_NUMBER_CDR (character);
1004 from = XINT (XCAR (character));
1005 to = XINT (XCDR (character));
1006 if (!char_valid_p (from, 0) || !char_valid_p (to, 0))
1007 error ("Character range should be by non-generic characters.");
1008 if (!NILP (name)
1009 && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to)))
1010 error ("Can't change font for a single byte character");
1011 }
1012 else if (SYMBOLP (character))
1013 {
1014 elt = Fget (character, Qcharset);
1015 if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0)))
1016 error ("Invalid charset: %s", (XSYMBOL (character)->name)->data);
1017 from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0);
1018 to = from;
1019 }
1020 else
1021 {
1022 CHECK_NUMBER (character);
1023 from = XINT (character);
1024 to = from;
1025 }
1026 if (!char_valid_p (from, 1))
1027 invalid_character (from);
1028 if (SINGLE_BYTE_CHAR_P (from))
1029 error ("Can't change font for a single byte character");
1030 if (from < to)
1031 {
1032 if (!char_valid_p (to, 1))
1033 invalid_character (to);
1034 if (SINGLE_BYTE_CHAR_P (to))
1035 error ("Can't change font for a single byte character");
1036 }
1037
1038 if (STRINGP (fontname))
1039 {
1040 fontname = Fdowncase (fontname);
1041 elt = Fcons (make_number (from), font_family_registry (fontname, 0));
1042 }
1043 else
1044 {
1045 CHECK_CONS (fontname);
1046 family = XCAR (fontname);
1047 registry = XCDR (fontname);
1048 if (!NILP (family))
1049 {
1050 CHECK_STRING (family);
1051 family = Fdowncase (family);
1052 }
1053 if (!NILP (registry))
1054 {
1055 CHECK_STRING (registry);
1056 registry = Fdowncase (registry);
1057 }
1058 elt = Fcons (make_number (from), Fcons (family, registry));
1059 }
1060
1061 /* The arg FRAME is kept for backward compatibility. We only check
1062 the validity. */
1063 if (!NILP (frame))
1064 CHECK_LIVE_FRAME (frame);
1065
1066 for (; from <= to; from++)
1067 FONTSET_SET (fontset, from, elt);
1068 Foptimize_char_table (fontset);
1069
1070 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1071 clear all the elements of REALIZED and free all multibyte faces
1072 whose fontset is REALIZED. This way, the specified character(s)
1073 are surely redisplayed by a correct font. */
1074 for (id = 0; id < ASIZE (Vfontset_table); id++)
1075 {
1076 realized = AREF (Vfontset_table, id);
1077 if (!NILP (realized)
1078 && !BASE_FONTSET_P (realized)
1079 && EQ (FONTSET_BASE (realized), fontset))
1080 {
1081 FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));
1082 clear_fontset_elements (realized);
1083 free_realized_multibyte_face (f, id);
1084 }
1085 }
1086
1087 return Qnil;
1088 }
1089
1090 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
1091 doc: /* Return information about a font named NAME on frame FRAME.
1092 If FRAME is omitted or nil, use the selected frame.
1093 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1094 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1095 where
1096 OPENED-NAME is the name used for opening the font,
1097 FULL-NAME is the full name of the font,
1098 SIZE is the maximum bound width of the font,
1099 HEIGHT is the height of the font,
1100 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1101 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1102 how to compose characters.
1103 If the named font is not yet loaded, return nil. */)
1104 (name, frame)
1105 Lisp_Object name, frame;
1106 {
1107 FRAME_PTR f;
1108 struct font_info *fontp;
1109 Lisp_Object info;
1110
1111 (*check_window_system_func) ();
1112
1113 CHECK_STRING (name);
1114 name = Fdowncase (name);
1115 if (NILP (frame))
1116 frame = selected_frame;
1117 CHECK_LIVE_FRAME (frame);
1118 f = XFRAME (frame);
1119
1120 if (!query_font_func)
1121 error ("Font query function is not supported");
1122
1123 fontp = (*query_font_func) (f, XSTRING (name)->data);
1124 if (!fontp)
1125 return Qnil;
1126
1127 info = Fmake_vector (make_number (7), Qnil);
1128
1129 XVECTOR (info)->contents[0] = build_string (fontp->name);
1130 XVECTOR (info)->contents[1] = build_string (fontp->full_name);
1131 XVECTOR (info)->contents[2] = make_number (fontp->size);
1132 XVECTOR (info)->contents[3] = make_number (fontp->height);
1133 XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset);
1134 XVECTOR (info)->contents[5] = make_number (fontp->relative_compose);
1135 XVECTOR (info)->contents[6] = make_number (fontp->default_ascent);
1136
1137 return info;
1138 }
1139
1140
1141 /* Return the font name for the character at POSITION in the current
1142 buffer. This is computed from all the text properties and overlays
1143 that apply to POSITION. It returns nil in the following cases:
1144
1145 (1) The window system doesn't have a font for the character (thus
1146 it is displayed by an empty box).
1147
1148 (2) The character code is invalid.
1149
1150 (3) The current buffer is not displayed in any window.
1151
1152 In addition, the returned font name may not take into account of
1153 such redisplay engine hooks as what used in jit-lock-mode if
1154 POSITION is currently not visible. */
1155
1156
1157 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 1, 0,
1158 doc: /* For internal use only. */)
1159 (position)
1160 Lisp_Object position;
1161 {
1162 int pos, pos_byte, dummy;
1163 int face_id;
1164 int c;
1165 Lisp_Object window;
1166 struct window *w;
1167 struct frame *f;
1168 struct face *face;
1169
1170 CHECK_NUMBER_COERCE_MARKER (position);
1171 pos = XINT (position);
1172 if (pos < BEGV || pos >= ZV)
1173 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1174 pos_byte = CHAR_TO_BYTE (pos);
1175 c = FETCH_CHAR (pos_byte);
1176 if (! CHAR_VALID_P (c, 0))
1177 return Qnil;
1178 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1179 if (NILP (window))
1180 return Qnil;
1181 w = XWINDOW (window);
1182 f = XFRAME (w->frame);
1183 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
1184 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
1185 face = FACE_FROM_ID (f, face_id);
1186 return (face->font && face->font_name
1187 ? build_string (face->font_name)
1188 : Qnil);
1189 }
1190
1191
1192 /* Called from Ffontset_info via map_char_table on each leaf of
1193 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1194 ARG)' and FONT-INFOs have this form:
1195 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1196 The current leaf is indexed by CHARACTER and has value ELT. This
1197 function add the information of the current leaf to ARG by
1198 appending a new element or modifying the last element.. */
1199
1200 static void
1201 accumulate_font_info (arg, character, elt)
1202 Lisp_Object arg, character, elt;
1203 {
1204 Lisp_Object last, last_char, last_elt;
1205
1206 if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))
1207 elt = FONTSET_REF (Vdefault_fontset, XINT (character));
1208 if (!CONSP (elt))
1209 return;
1210 last = XCAR (arg);
1211 last_char = XCAR (XCAR (last));
1212 last_elt = XCAR (XCDR (XCAR (last)));
1213 elt = XCDR (elt);
1214 if (!NILP (Fequal (elt, last_elt)))
1215 {
1216 int this_charset = CHAR_CHARSET (XINT (character));
1217
1218 if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */
1219 {
1220 if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char))))
1221 {
1222 XSETCDR (last_char, character);
1223 return;
1224 }
1225 }
1226 else if (XINT (last_char) == XINT (character))
1227 return;
1228 else if (this_charset == CHAR_CHARSET (XINT (last_char)))
1229 {
1230 XSETCAR (XCAR (last), Fcons (last_char, character));
1231 return;
1232 }
1233 }
1234 XSETCDR (last, Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil));
1235 XSETCAR (arg, XCDR (last));
1236 }
1237
1238
1239 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1240 doc: /* Return information about a fontset named NAME on frame FRAME.
1241 The value is a vector:
1242 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],
1243 where,
1244 SIZE is the maximum bound width of ASCII font in the fontset,
1245 HEIGHT is the maximum bound height of ASCII font in the fontset,
1246 CHARSET-OR-RANGE is a charset, a character (may be a generic character)
1247 or a cons of two characters specifying the range of characters.
1248 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),
1249 where FAMILY is a `FAMILY' field of a XLFD font name,
1250 REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name.
1251 FAMILY may contain a `FOUNDRY' field at the head.
1252 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.
1253 OPENEDs are names of fonts actually opened.
1254 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.
1255 If FRAME is omitted, it defaults to the currently selected frame. */)
1256 (name, frame)
1257 Lisp_Object name, frame;
1258 {
1259 Lisp_Object fontset;
1260 FRAME_PTR f;
1261 Lisp_Object indices[3];
1262 Lisp_Object val, tail, elt;
1263 Lisp_Object *realized;
1264 struct font_info *fontp = NULL;
1265 int n_realized = 0;
1266 int i;
1267
1268 (*check_window_system_func) ();
1269
1270 fontset = check_fontset_name (name);
1271
1272 if (NILP (frame))
1273 frame = selected_frame;
1274 CHECK_LIVE_FRAME (frame);
1275 f = XFRAME (frame);
1276
1277 /* Recode realized fontsets whose base is FONTSET in the table
1278 `realized'. */
1279 realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1280 * ASIZE (Vfontset_table));
1281 for (i = 0; i < ASIZE (Vfontset_table); i++)
1282 {
1283 elt = FONTSET_FROM_ID (i);
1284 if (!NILP (elt)
1285 && EQ (FONTSET_BASE (elt), fontset))
1286 realized[n_realized++] = elt;
1287 }
1288
1289 /* Accumulate information of the fontset in VAL. The format is
1290 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1291 FONT-SPEC). See the comment for accumulate_font_info for the
1292 detail. */
1293 val = Fcons (Fcons (make_number (0),
1294 Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)),
1295 Qnil);
1296 val = Fcons (val, val);
1297 map_char_table (accumulate_font_info, Qnil, fontset, val, 0, indices);
1298 val = XCDR (val);
1299
1300 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1301 character for a charset, replace it with the charset symbol. If
1302 fonts are opened for FONT-SPEC, append the names of the fonts to
1303 FONT-SPEC. */
1304 for (tail = val; CONSP (tail); tail = XCDR (tail))
1305 {
1306 int c;
1307 elt = XCAR (tail);
1308 if (INTEGERP (XCAR (elt)))
1309 {
1310 int charset, c1, c2;
1311 c = XINT (XCAR (elt));
1312 SPLIT_CHAR (c, charset, c1, c2);
1313 if (c1 == 0)
1314 XSETCAR (elt, CHARSET_SYMBOL (charset));
1315 }
1316 else
1317 c = XINT (XCAR (XCAR (elt)));
1318 for (i = 0; i < n_realized; i++)
1319 {
1320 Lisp_Object face_id, font;
1321 struct face *face;
1322
1323 face_id = FONTSET_REF_VIA_BASE (realized[i], c);
1324 if (INTEGERP (face_id))
1325 {
1326 face = FACE_FROM_ID (f, XINT (face_id));
1327 if (face && face->font && face->font_name)
1328 {
1329 font = build_string (face->font_name);
1330 if (NILP (Fmember (font, XCDR (XCDR (elt)))))
1331 XSETCDR (XCDR (elt), Fcons (font, XCDR (XCDR (elt))));
1332 }
1333 }
1334 }
1335 }
1336
1337 elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val)));
1338 if (CONSP (elt))
1339 {
1340 elt = XCAR (elt);
1341 fontp = (*query_font_func) (f, XSTRING (elt)->data);
1342 }
1343 val = Fmake_vector (make_number (3), val);
1344 AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0);
1345 AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0);
1346 return val;
1347 }
1348
1349 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
1350 doc: /* Return a font name pattern for character CH in fontset NAME.
1351 If NAME is t, find a font name pattern in the default fontset. */)
1352 (name, ch)
1353 Lisp_Object name, ch;
1354 {
1355 int c;
1356 Lisp_Object fontset, elt;
1357
1358 fontset = check_fontset_name (name);
1359
1360 CHECK_NUMBER (ch);
1361 c = XINT (ch);
1362 if (!char_valid_p (c, 1))
1363 invalid_character (c);
1364
1365 elt = FONTSET_REF (fontset, c);
1366 if (CONSP (elt))
1367 elt = XCDR (elt);
1368
1369 return elt;
1370 }
1371
1372 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
1373 doc: /* Return a list of all defined fontset names. */)
1374 ()
1375 {
1376 Lisp_Object fontset, list;
1377 int i;
1378
1379 list = Qnil;
1380 for (i = 0; i < ASIZE (Vfontset_table); i++)
1381 {
1382 fontset = FONTSET_FROM_ID (i);
1383 if (!NILP (fontset)
1384 && BASE_FONTSET_P (fontset))
1385 list = Fcons (FONTSET_NAME (fontset), list);
1386 }
1387
1388 return list;
1389 }
1390
1391 void
1392 syms_of_fontset ()
1393 {
1394 if (!load_font_func)
1395 /* Window system initializer should have set proper functions. */
1396 abort ();
1397
1398 Qfontset = intern ("fontset");
1399 staticpro (&Qfontset);
1400 Fput (Qfontset, Qchar_table_extra_slots, make_number (3));
1401
1402 Vcached_fontset_data = Qnil;
1403 staticpro (&Vcached_fontset_data);
1404
1405 Vfontset_table = Fmake_vector (make_number (32), Qnil);
1406 staticpro (&Vfontset_table);
1407
1408 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
1409 staticpro (&Vdefault_fontset);
1410 FONTSET_ID (Vdefault_fontset) = make_number (0);
1411 FONTSET_NAME (Vdefault_fontset)
1412 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1413 #if defined (MAC_OS)
1414 FONTSET_ASCII (Vdefault_fontset)
1415 = Fcons (make_number (0),
1416 build_string ("-ETL-fixed-medium-r-*--*-160-*-*-*-*-iso8859-1"));
1417 #elif defined (WINDOWSNT)
1418 FONTSET_ASCII (Vdefault_fontset)
1419 = Fcons (make_number (0),
1420 build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
1421 #else
1422 FONTSET_ASCII (Vdefault_fontset)
1423 = Fcons (make_number (0),
1424 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1425 #endif
1426 AREF (Vfontset_table, 0) = Vdefault_fontset;
1427 next_fontset_id = 1;
1428
1429 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
1430 doc: /* Alist of fontname patterns vs corresponding encoding info.
1431 Each element looks like (REGEXP . ENCODING-INFO),
1432 where ENCODING-INFO is an alist of CHARSET vs ENCODING.
1433 ENCODING is one of the following integer values:
1434 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,
1435 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,
1436 2: code points 0x20A0..0x7FFF are used,
1437 3: code points 0xA020..0xFF7F are used. */);
1438 Vfont_encoding_alist = Qnil;
1439
1440 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
1441 doc: /* Char table of characters whose ascent values should be ignored.
1442 If an entry for a character is non-nil, the ascent value of the glyph
1443 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
1444
1445 This affects how a composite character which contains
1446 such a character is displayed on screen. */);
1447 Vuse_default_ascent = Qnil;
1448
1449 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
1450 doc: /* Char table of characters which is not composed relatively.
1451 If an entry for a character is non-nil, a composition sequence
1452 which contains that character is displayed so that
1453 the glyph of that character is put without considering
1454 an ascent and descent value of a previous character. */);
1455 Vignore_relative_composition = Qnil;
1456
1457 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
1458 doc: /* Alist of fontname vs list of the alternate fontnames.
1459 When a specified font name is not found, the corresponding
1460 alternate fontnames (if any) are tried instead. */);
1461 Valternate_fontname_alist = Qnil;
1462
1463 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
1464 doc: /* Alist of fontset names vs the aliases. */);
1465 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
1466 build_string ("fontset-default")),
1467 Qnil);
1468
1469 DEFVAR_LISP ("vertical-centering-font-regexp",
1470 &Vvertical_centering_font_regexp,
1471 doc: /* *Regexp matching font names that require vertical centering on display.
1472 When a character is displayed with such fonts, the character is displayed
1473 at the vertical center of lines. */);
1474 Vvertical_centering_font_regexp = Qnil;
1475
1476 defsubr (&Squery_fontset);
1477 defsubr (&Snew_fontset);
1478 defsubr (&Sset_fontset_font);
1479 defsubr (&Sfont_info);
1480 defsubr (&Sinternal_char_font);
1481 defsubr (&Sfontset_info);
1482 defsubr (&Sfontset_font);
1483 defsubr (&Sfontset_list);
1484 }