(window_scroll_pixel_based): Don't recenter if
[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)) && !CONSP (XCDR (tem))))
903 error ("Elements of fontlist must be a cons of charset and font name pattern");
904
905 tem = XCDR (tem);
906 if (STRINGP (tem))
907 tem = Fdowncase (tem);
908 else
909 tem = Fcons (Fdowncase (Fcar (tem)), Fdowncase (Fcdr (tem)));
910 if (charset == CHARSET_ASCII)
911 ascii_font = tem;
912 else
913 {
914 c = MAKE_CHAR (charset, 0, 0);
915 elements = Fcons (Fcons (make_number (c), tem), elements);
916 }
917 }
918
919 if (NILP (ascii_font))
920 error ("No ASCII font in the fontlist");
921
922 fontset = make_fontset (Qnil, name, Qnil);
923 FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font);
924 for (; CONSP (elements); elements = XCDR (elements))
925 {
926 elt = XCAR (elements);
927 tem = XCDR (elt);
928 if (STRINGP (tem))
929 tem = font_family_registry (tem, 0);
930 tem = Fcons (XCAR (elt), tem);
931 FONTSET_SET (fontset, XINT (XCAR (elt)), tem);
932 }
933
934 return Qnil;
935 }
936
937
938 /* Clear all elements of FONTSET for multibyte characters. */
939
940 static void
941 clear_fontset_elements (fontset)
942 Lisp_Object fontset;
943 {
944 int i;
945
946 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
947 XCHAR_TABLE (fontset)->contents[i] = Qnil;
948 }
949
950
951 /* Check validity of NAME as a fontset name and return the
952 corresponding fontset. If not valid, signal an error.
953 If NAME is t, return Vdefault_fontset. */
954
955 static Lisp_Object
956 check_fontset_name (name)
957 Lisp_Object name;
958 {
959 int id;
960
961 if (EQ (name, Qt))
962 return Vdefault_fontset;
963
964 CHECK_STRING (name, 0);
965 id = fs_query_fontset (name, 0);
966 if (id < 0)
967 error ("Fontset `%s' does not exist", XSTRING (name)->data);
968 return FONTSET_FROM_ID (id);
969 }
970
971 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
972 "Modify fontset NAME to use FONTNAME for CHARACTER.\n\
973 \n\
974 CHARACTER may be a cons; (FROM . TO), where FROM and TO are\n\
975 non-generic characters. In that case, use FONTNAME\n\
976 for all characters in the range FROM and TO (inclusive).\n\
977 CHARACTER may be a charset. In that case, use FONTNAME\n\
978 for all character in the charsets.\n\
979 \n\
980 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family\n\
981 name of a font, REGSITRY is a registry name of a font.")
982 (name, character, fontname, frame)
983 Lisp_Object name, character, fontname, frame;
984 {
985 Lisp_Object fontset, elt;
986 Lisp_Object realized;
987 int from, to;
988 int id;
989 Lisp_Object family, registry;
990
991 fontset = check_fontset_name (name);
992
993 if (CONSP (character))
994 {
995 /* CH should be (FROM . TO) where FROM and TO are non-generic
996 characters. */
997 CHECK_NUMBER (XCAR (character), 1);
998 CHECK_NUMBER (XCDR (character), 1);
999 from = XINT (XCAR (character));
1000 to = XINT (XCDR (character));
1001 if (!char_valid_p (from, 0) || !char_valid_p (to, 0))
1002 error ("Character range should be by non-generic characters.");
1003 if (!NILP (name)
1004 && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to)))
1005 error ("Can't change font for a single byte character");
1006 }
1007 else if (SYMBOLP (character))
1008 {
1009 elt = Fget (character, Qcharset);
1010 if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0)))
1011 error ("Invalid charset: %s", (XSYMBOL (character)->name)->data);
1012 from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0);
1013 to = from;
1014 }
1015 else
1016 {
1017 CHECK_NUMBER (character, 1);
1018 from = XINT (character);
1019 to = from;
1020 }
1021 if (!char_valid_p (from, 1))
1022 invalid_character (from);
1023 if (SINGLE_BYTE_CHAR_P (from))
1024 error ("Can't change font for a single byte character");
1025 if (from < to)
1026 {
1027 if (!char_valid_p (to, 1))
1028 invalid_character (to);
1029 if (SINGLE_BYTE_CHAR_P (to))
1030 error ("Can't change font for a single byte character");
1031 }
1032
1033 if (STRINGP (fontname))
1034 {
1035 fontname = Fdowncase (fontname);
1036 elt = Fcons (make_number (from), font_family_registry (fontname, 0));
1037 }
1038 else
1039 {
1040 CHECK_CONS (fontname, 2);
1041 family = XCAR (fontname);
1042 registry = XCDR (fontname);
1043 if (!NILP (family))
1044 {
1045 CHECK_STRING (family, 2);
1046 family = Fdowncase (family);
1047 }
1048 if (!NILP (registry))
1049 {
1050 CHECK_STRING (registry, 2);
1051 registry = Fdowncase (registry);
1052 }
1053 elt = Fcons (make_number (from), Fcons (family, registry));
1054 }
1055
1056 /* The arg FRAME is kept for backward compatibility. We only check
1057 the validity. */
1058 if (!NILP (frame))
1059 CHECK_LIVE_FRAME (frame, 3);
1060
1061 for (; from <= to; from++)
1062 FONTSET_SET (fontset, from, elt);
1063 Foptimize_char_table (fontset);
1064
1065 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1066 clear all the elements of REALIZED and free all multibyte faces
1067 whose fontset is REALIZED. This way, the specified character(s)
1068 are surely redisplayed by a correct font. */
1069 for (id = 0; id < ASIZE (Vfontset_table); id++)
1070 {
1071 realized = AREF (Vfontset_table, id);
1072 if (!NILP (realized)
1073 && !BASE_FONTSET_P (realized)
1074 && EQ (FONTSET_BASE (realized), fontset))
1075 {
1076 FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));
1077 clear_fontset_elements (realized);
1078 free_realized_multibyte_face (f, id);
1079 }
1080 }
1081
1082 return Qnil;
1083 }
1084
1085 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
1086 "Return information about a font named NAME on frame FRAME.\n\
1087 If FRAME is omitted or nil, use the selected frame.\n\
1088 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
1089 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
1090 where\n\
1091 OPENED-NAME is the name used for opening the font,\n\
1092 FULL-NAME is the full name of the font,\n\
1093 SIZE is the maximum bound width of the font,\n\
1094 HEIGHT is the height of the font,\n\
1095 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
1096 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
1097 how to compose characters.\n\
1098 If the named font is not yet loaded, return nil.")
1099 (name, frame)
1100 Lisp_Object name, frame;
1101 {
1102 FRAME_PTR f;
1103 struct font_info *fontp;
1104 Lisp_Object info;
1105
1106 (*check_window_system_func) ();
1107
1108 CHECK_STRING (name, 0);
1109 name = Fdowncase (name);
1110 if (NILP (frame))
1111 frame = selected_frame;
1112 CHECK_LIVE_FRAME (frame, 1);
1113 f = XFRAME (frame);
1114
1115 if (!query_font_func)
1116 error ("Font query function is not supported");
1117
1118 fontp = (*query_font_func) (f, XSTRING (name)->data);
1119 if (!fontp)
1120 return Qnil;
1121
1122 info = Fmake_vector (make_number (7), Qnil);
1123
1124 XVECTOR (info)->contents[0] = build_string (fontp->name);
1125 XVECTOR (info)->contents[1] = build_string (fontp->full_name);
1126 XVECTOR (info)->contents[2] = make_number (fontp->size);
1127 XVECTOR (info)->contents[3] = make_number (fontp->height);
1128 XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset);
1129 XVECTOR (info)->contents[5] = make_number (fontp->relative_compose);
1130 XVECTOR (info)->contents[6] = make_number (fontp->default_ascent);
1131
1132 return info;
1133 }
1134
1135
1136 /* Return the font name for the character at POSITION in the current
1137 buffer. This is computed from all the text properties and overlays
1138 that apply to POSITION. It returns nil in the following cases:
1139
1140 (1) The window system doesn't have a font for the character (thus
1141 it is displayed by an empty box).
1142
1143 (2) The character code is invalid.
1144
1145 (3) The current buffer is not displayed in any window.
1146
1147 In addition, the returned font name may not take into account of
1148 such redisplay engine hooks as what used in jit-lock-mode if
1149 POSITION is currently not visible. */
1150
1151
1152 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 1, 0,
1153 "For internal use only.")
1154 (position)
1155 Lisp_Object position;
1156 {
1157 int pos, pos_byte, dummy;
1158 int face_id;
1159 int c;
1160 Lisp_Object window;
1161 struct window *w;
1162 struct frame *f;
1163 struct face *face;
1164
1165 CHECK_NUMBER_COERCE_MARKER (position, 0);
1166 pos = XINT (position);
1167 if (pos < BEGV || pos >= ZV)
1168 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1169 pos_byte = CHAR_TO_BYTE (pos);
1170 c = FETCH_CHAR (pos_byte);
1171 if (! CHAR_VALID_P (c, 0))
1172 return Qnil;
1173 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1174 if (NILP (window))
1175 return Qnil;
1176 w = XWINDOW (window);
1177 f = XFRAME (w->frame);
1178 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
1179 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
1180 face = FACE_FROM_ID (f, face_id);
1181 return (face->font && face->font_name
1182 ? build_string (face->font_name)
1183 : Qnil);
1184 }
1185
1186
1187 /* Called from Ffontset_info via map_char_table on each leaf of
1188 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1189 ARG)' and FONT-INFOs have this form:
1190 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1191 The current leaf is indexed by CHARACTER and has value ELT. This
1192 function add the information of the current leaf to ARG by
1193 appending a new element or modifying the last element.. */
1194
1195 static void
1196 accumulate_font_info (arg, character, elt)
1197 Lisp_Object arg, character, elt;
1198 {
1199 Lisp_Object last, last_char, last_elt;
1200
1201 if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))
1202 elt = FONTSET_REF (Vdefault_fontset, XINT (character));
1203 if (!CONSP (elt))
1204 return;
1205 last = XCAR (arg);
1206 last_char = XCAR (XCAR (last));
1207 last_elt = XCAR (XCDR (XCAR (last)));
1208 elt = XCDR (elt);
1209 if (!NILP (Fequal (elt, last_elt)))
1210 {
1211 int this_charset = CHAR_CHARSET (XINT (character));
1212
1213 if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */
1214 {
1215 if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char))))
1216 {
1217 XCDR (last_char) = character;
1218 return;
1219 }
1220 }
1221 else if (XINT (last_char) == XINT (character))
1222 return;
1223 else if (this_charset == CHAR_CHARSET (XINT (last_char)))
1224 {
1225 XCAR (XCAR (last)) = Fcons (last_char, character);
1226 return;
1227 }
1228 }
1229 XCDR (last) = Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil);
1230 XCAR (arg) = XCDR (last);
1231 }
1232
1233
1234 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1235 "Return information about a fontset named NAME on frame FRAME.\n\
1236 The value is a vector:\n\
1237 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],\n\
1238 where,\n\
1239 SIZE is the maximum bound width of ASCII font in the fontset,\n\
1240 HEIGHT is the maximum bound height of ASCII font in the fontset,\n\
1241 CHARSET-OR-RANGE is a charset, a character (may be a generic character)\n\
1242 or a cons of two characters specifying the range of characters.\n\
1243 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),\n\
1244 where FAMILY is a `FAMILY' field of a XLFD font name,\n\
1245 REGISTRY is a `CHARSET_REGISTRY' field of a XLDF font name.\n\
1246 FAMILY may contain a `FOUNDARY' field at the head.\n\
1247 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.\n\
1248 OPENEDs are names of fonts actually opened.\n\
1249 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.\n\
1250 If FRAME is omitted, it defaults to the currently selected frame.")
1251 (name, frame)
1252 Lisp_Object name, frame;
1253 {
1254 Lisp_Object fontset;
1255 FRAME_PTR f;
1256 Lisp_Object indices[3];
1257 Lisp_Object val, tail, elt;
1258 Lisp_Object *realized;
1259 struct font_info *fontp = NULL;
1260 int n_realized = 0;
1261 int i;
1262
1263 (*check_window_system_func) ();
1264
1265 fontset = check_fontset_name (name);
1266
1267 if (NILP (frame))
1268 frame = selected_frame;
1269 CHECK_LIVE_FRAME (frame, 1);
1270 f = XFRAME (frame);
1271
1272 /* Recode realized fontsets whose base is FONTSET in the table
1273 `realized'. */
1274 realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1275 * ASIZE (Vfontset_table));
1276 for (i = 0; i < ASIZE (Vfontset_table); i++)
1277 {
1278 elt = FONTSET_FROM_ID (i);
1279 if (!NILP (elt)
1280 && EQ (FONTSET_BASE (elt), fontset))
1281 realized[n_realized++] = elt;
1282 }
1283
1284 /* Accumulate information of the fontset in VAL. The format is
1285 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1286 FONT-SPEC). See the comment for accumulate_font_info for the
1287 detail. */
1288 val = Fcons (Fcons (make_number (0),
1289 Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)),
1290 Qnil);
1291 val = Fcons (val, val);
1292 map_char_table (accumulate_font_info, Qnil, fontset, val, 0, indices);
1293 val = XCDR (val);
1294
1295 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1296 character for a charset, replace it with the charset symbol. If
1297 fonts are opened for FONT-SPEC, append the names of the fonts to
1298 FONT-SPEC. */
1299 for (tail = val; CONSP (tail); tail = XCDR (tail))
1300 {
1301 int c;
1302 elt = XCAR (tail);
1303 if (INTEGERP (XCAR (elt)))
1304 {
1305 int charset, c1, c2;
1306 c = XINT (XCAR (elt));
1307 SPLIT_CHAR (c, charset, c1, c2);
1308 if (c1 == 0)
1309 XCAR (elt) = CHARSET_SYMBOL (charset);
1310 }
1311 else
1312 c = XINT (XCAR (XCAR (elt)));
1313 for (i = 0; i < n_realized; i++)
1314 {
1315 Lisp_Object face_id, font;
1316 struct face *face;
1317
1318 face_id = FONTSET_REF_VIA_BASE (realized[i], c);
1319 if (INTEGERP (face_id))
1320 {
1321 face = FACE_FROM_ID (f, XINT (face_id));
1322 if (face && face->font && face->font_name)
1323 {
1324 font = build_string (face->font_name);
1325 if (NILP (Fmember (font, XCDR (XCDR (elt)))))
1326 XCDR (XCDR (elt)) = Fcons (font, XCDR (XCDR (elt)));
1327 }
1328 }
1329 }
1330 }
1331
1332 elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val)));
1333 if (CONSP (elt))
1334 {
1335 elt = XCAR (elt);
1336 fontp = (*query_font_func) (f, XSTRING (elt)->data);
1337 }
1338 val = Fmake_vector (make_number (3), val);
1339 AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0);
1340 AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0);
1341 return val;
1342 }
1343
1344 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
1345 "Return a font name pattern for character CH in fontset NAME.\n\
1346 If NAME is t, find a font name pattern in the default fontset.")
1347 (name, ch)
1348 Lisp_Object name, ch;
1349 {
1350 int c;
1351 Lisp_Object fontset, elt;
1352
1353 fontset = check_fontset_name (name);
1354
1355 CHECK_NUMBER (ch, 1);
1356 c = XINT (ch);
1357 if (!char_valid_p (c, 1))
1358 invalid_character (c);
1359
1360 elt = FONTSET_REF (fontset, c);
1361 if (CONSP (elt))
1362 elt = XCDR (elt);
1363
1364 return elt;
1365 }
1366
1367
1368 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
1369 "Return a list of all defined fontset names.")
1370 ()
1371 {
1372 Lisp_Object fontset, list;
1373 int i;
1374
1375 list = Qnil;
1376 for (i = 0; i < ASIZE (Vfontset_table); i++)
1377 {
1378 fontset = FONTSET_FROM_ID (i);
1379 if (!NILP (fontset)
1380 && BASE_FONTSET_P (fontset))
1381 list = Fcons (FONTSET_NAME (fontset), list);
1382 }
1383
1384 return list;
1385 }
1386
1387 void
1388 syms_of_fontset ()
1389 {
1390 if (!load_font_func)
1391 /* Window system initializer should have set proper functions. */
1392 abort ();
1393
1394 Qfontset = intern ("fontset");
1395 staticpro (&Qfontset);
1396 Fput (Qfontset, Qchar_table_extra_slots, make_number (3));
1397
1398 Vcached_fontset_data = Qnil;
1399 staticpro (&Vcached_fontset_data);
1400
1401 Vfontset_table = Fmake_vector (make_number (32), Qnil);
1402 staticpro (&Vfontset_table);
1403
1404 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
1405 staticpro (&Vdefault_fontset);
1406 FONTSET_ID (Vdefault_fontset) = make_number (0);
1407 FONTSET_NAME (Vdefault_fontset)
1408 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1409 #if defined (macintosh)
1410 FONTSET_ASCII (Vdefault_fontset)
1411 = Fcons (make_number (0),
1412 build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));
1413 #elif defined (WINDOWSNT)
1414 FONTSET_ASCII (Vdefault_fontset)
1415 = Fcons (make_number (0),
1416 build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
1417 #else
1418 FONTSET_ASCII (Vdefault_fontset)
1419 = Fcons (make_number (0),
1420 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1421 #endif
1422 AREF (Vfontset_table, 0) = Vdefault_fontset;
1423 next_fontset_id = 1;
1424
1425 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
1426 "Alist of fontname patterns vs corresponding encoding info.\n\
1427 Each element looks like (REGEXP . ENCODING-INFO),\n\
1428 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
1429 ENCODING is one of the following integer values:\n\
1430 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
1431 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
1432 2: code points 0x20A0..0x7FFF are used,\n\
1433 3: code points 0xA020..0xFF7F are used.");
1434 Vfont_encoding_alist = Qnil;
1435
1436 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
1437 "Char table of characters whose ascent values should be ignored.\n\
1438 If an entry for a character is non-nil, the ascent value of the glyph\n\
1439 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
1440 \n\
1441 This affects how a composite character which contains\n\
1442 such a character is displayed on screen.");
1443 Vuse_default_ascent = Qnil;
1444
1445 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
1446 "Char table of characters which is not composed relatively.\n\
1447 If an entry for a character is non-nil, a composition sequence\n\
1448 which contains that character is displayed so that\n\
1449 the glyph of that character is put without considering\n\
1450 an ascent and descent value of a previous character.");
1451 Vignore_relative_composition = Qnil;
1452
1453 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
1454 "Alist of fontname vs list of the alternate fontnames.\n\
1455 When a specified font name is not found, the corresponding\n\
1456 alternate fontnames (if any) are tried instead.");
1457 Valternate_fontname_alist = Qnil;
1458
1459 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
1460 "Alist of fontset names vs the aliases.");
1461 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
1462 build_string ("fontset-default")),
1463 Qnil);
1464
1465 DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font,
1466 "*This variable is obsolete.");
1467 Vhighlight_wrong_size_font = Qnil;
1468
1469 DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font,
1470 "*This variable is obsolete.");
1471 Vclip_large_size_font = Qt;
1472
1473 DEFVAR_LISP ("vertical-centering-font-regexp",
1474 &Vvertical_centering_font_regexp,
1475 "*Regexp matching font names that require vertical centering on display.\n\
1476 When a character is displayed with such fonts, the character is displayed\n\
1477 at the vertival center of lines.");
1478 Vvertical_centering_font_regexp = Qnil;
1479
1480 defsubr (&Squery_fontset);
1481 defsubr (&Snew_fontset);
1482 defsubr (&Sset_fontset_font);
1483 defsubr (&Sfont_info);
1484 defsubr (&Sinternal_char_font);
1485 defsubr (&Sfontset_info);
1486 defsubr (&Sfontset_font);
1487 defsubr (&Sfontset_list);
1488 }