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