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