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