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