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