*** empty log message ***
[emacs.git] / src / fontset.c
blob6ed1efff092503951d1f8f84f2ffcdc66d9515a2
1 /* Fontset handler.
2 Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
5 This file is part of GNU Emacs.
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.
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.
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. */
22 /* #define FONTSET_DEBUG */
24 #include <config.h>
26 #ifdef FONTSET_DEBUG
27 #include <stdio.h>
28 #endif
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 #ifdef HAVE_X_WINDOWS
40 #include "xterm.h"
41 #endif
42 #ifdef WINDOWSNT
43 #include "w32term.h"
44 #endif
45 #ifdef MAC_OS
46 #include "macterm.h"
47 #endif
49 #ifdef FONTSET_DEBUG
50 #undef xassert
51 #define xassert(X) do {if (!(X)) abort ();} while (0)
52 #undef INLINE
53 #define INLINE
54 #endif
57 /* FONTSET
59 A fontset is a collection of font related information to give
60 similar appearance (style, size, etc) of characters. There are two
61 kinds of fontsets; base and realized. A base fontset is created by
62 new-fontset from Emacs Lisp explicitly. A realized fontset is
63 created implicitly when a face is realized for ASCII characters. A
64 face is also realized for multibyte characters based on an ASCII
65 face. All of the multibyte faces based on the same ASCII face
66 share the same realized fontset.
68 A fontset object is implemented by a char-table.
70 An element of a base fontset is:
71 (INDEX . FONTNAME) or
72 (INDEX . (FOUNDRY . REGISTRY ))
73 FONTNAME is a font name pattern for the corresponding character.
74 FOUNDRY and REGISTRY are respectively foundry and registry fields of
75 a font name for the corresponding character. INDEX specifies for
76 which character (or generic character) the element is defined. It
77 may be different from an index to access this element. For
78 instance, if a fontset defines some font for all characters of
79 charset `japanese-jisx0208', INDEX is the generic character of this
80 charset. REGISTRY is the
82 An element of a realized fontset is FACE-ID which is a face to use
83 for displaying the corresponding character.
85 All single byte characters (ASCII and 8bit-unibyte) share the same
86 element in a fontset. The element is stored in the first element
87 of the fontset.
89 To access or set each element, use macros FONTSET_REF and
90 FONTSET_SET respectively for efficiency.
92 A fontset has 3 extra slots.
94 The 1st slot is an ID number of the fontset.
96 The 2nd slot is a name of the fontset. This is nil for a realized
97 face.
99 The 3rd slot is a frame that the fontset belongs to. This is nil
100 for a default face.
102 A parent of a base fontset is nil. A parent of a realized fontset
103 is a base fontset.
105 All fontsets are recorded in Vfontset_table.
108 DEFAULT FONTSET
110 There's a special fontset named `default fontset' which defines a
111 default fontname pattern. When a base fontset doesn't specify a
112 font for a specific character, the corresponding value in the
113 default fontset is used. The format is the same as a base fontset.
115 The parent of a realized fontset created for such a face that has
116 no fontset is the default fontset.
119 These structures are hidden from the other codes than this file.
120 The other codes handle fontsets only by their ID numbers. They
121 usually use variable name `fontset' for IDs. But, in this file, we
122 always use variable name `id' for IDs, and name `fontset' for the
123 actual fontset objects.
127 /********** VARIABLES and FUNCTION PROTOTYPES **********/
129 extern Lisp_Object Qfont;
130 Lisp_Object Qfontset;
132 /* Vector containing all fontsets. */
133 static Lisp_Object Vfontset_table;
135 /* Next possibly free fontset ID. Usually this keeps the minimum
136 fontset ID not yet used. */
137 static int next_fontset_id;
139 /* The default fontset. This gives default FAMILY and REGISTRY of
140 font for each characters. */
141 static Lisp_Object Vdefault_fontset;
143 /* Alist of font specifications. It override the font specification
144 in the default fontset. */
145 static Lisp_Object Voverriding_fontspec_alist;
147 Lisp_Object Vfont_encoding_alist;
148 Lisp_Object Vuse_default_ascent;
149 Lisp_Object Vignore_relative_composition;
150 Lisp_Object Valternate_fontname_alist;
151 Lisp_Object Vfontset_alias_alist;
152 Lisp_Object Vvertical_centering_font_regexp;
154 /* The following six are declarations of callback functions depending
155 on window system. See the comments in src/fontset.h for more
156 detail. */
158 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
159 struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx));
161 /* Return a list of font names which matches PATTERN. See the documentation
162 of `x-list-fonts' for more details. */
163 Lisp_Object (*list_fonts_func) P_ ((struct frame *f,
164 Lisp_Object pattern,
165 int size,
166 int maxnames));
168 /* Load a font named NAME for frame F and return a pointer to the
169 information of the loaded font. If loading is failed, return 0. */
170 struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int));
172 /* Return a pointer to struct font_info of a font named NAME for frame F. */
173 struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name));
175 /* Additional function for setting fontset or changing fontset
176 contents of frame F. */
177 void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg,
178 Lisp_Object oldval));
180 /* To find a CCL program, fs_load_font calls this function.
181 The argument is a pointer to the struct font_info.
182 This function set the member `encoder' of the structure. */
183 void (*find_ccl_program_func) P_ ((struct font_info *));
185 /* Check if any window system is used now. */
186 void (*check_window_system_func) P_ ((void));
189 /* Prototype declarations for static functions. */
190 static Lisp_Object fontset_ref P_ ((Lisp_Object, int));
191 static Lisp_Object lookup_overriding_fontspec P_ ((Lisp_Object, int));
192 static void fontset_set P_ ((Lisp_Object, int, Lisp_Object));
193 static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
194 static int fontset_id_valid_p P_ ((int));
195 static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
196 static Lisp_Object font_family_registry P_ ((Lisp_Object, int));
197 static Lisp_Object regulalize_fontname P_ ((Lisp_Object));
200 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
202 /* Return the fontset with ID. No check of ID's validness. */
203 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
205 /* Macros to access special values of FONTSET. */
206 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
207 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
208 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
209 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0]
210 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
212 #define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
215 /* Return the element of FONTSET (char-table) at index C (character). */
217 #define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
219 static Lisp_Object
220 fontset_ref (fontset, c)
221 Lisp_Object fontset;
222 int c;
224 int charset, c1, c2;
225 Lisp_Object elt, defalt;
227 if (SINGLE_BYTE_CHAR_P (c))
228 return FONTSET_ASCII (fontset);
230 SPLIT_CHAR (c, charset, c1, c2);
231 elt = XCHAR_TABLE (fontset)->contents[charset + 128];
232 if (!SUB_CHAR_TABLE_P (elt))
233 return elt;
234 defalt = XCHAR_TABLE (elt)->defalt;
235 if (c1 < 32
236 || (elt = XCHAR_TABLE (elt)->contents[c1],
237 NILP (elt)))
238 return defalt;
239 if (!SUB_CHAR_TABLE_P (elt))
240 return elt;
241 defalt = XCHAR_TABLE (elt)->defalt;
242 if (c2 < 32
243 || (elt = XCHAR_TABLE (elt)->contents[c2],
244 NILP (elt)))
245 return defalt;
246 return elt;
250 static Lisp_Object
251 lookup_overriding_fontspec (frame, c)
252 Lisp_Object frame;
253 int c;
255 Lisp_Object tail;
257 for (tail = Voverriding_fontspec_alist; CONSP (tail); tail = XCDR (tail))
259 Lisp_Object val, target, elt;
261 val = XCAR (tail);
262 target = XCAR (val);
263 val = XCDR (val);
264 /* Now VAL is (NO-FRAME-LIST OK-FRAME-LIST CHAR FONTNAME). */
265 if (NILP (Fmemq (frame, XCAR (val)))
266 && (CHAR_TABLE_P (target)
267 ? ! NILP (CHAR_TABLE_REF (target, c))
268 : XINT (target) == CHAR_CHARSET (c)))
270 val = XCDR (val);
271 elt = XCDR (val);
272 if (NILP (Fmemq (frame, XCAR (val))))
274 if (! face_font_available_p (XFRAME (frame), XCDR (elt)))
276 val = XCDR (XCAR (tail));
277 XSETCAR (val, Fcons (frame, XCAR (val)));
278 continue;
280 XSETCAR (val, Fcons (frame, XCAR (val)));
282 if (NILP (XCAR (elt)))
283 XSETCAR (elt, make_number (c));
284 return elt;
287 return Qnil;
290 #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
292 static Lisp_Object
293 fontset_ref_via_base (fontset, c)
294 Lisp_Object fontset;
295 int *c;
297 int charset, c1, c2;
298 Lisp_Object elt;
300 if (SINGLE_BYTE_CHAR_P (*c))
301 return FONTSET_ASCII (fontset);
303 elt = Qnil;
304 if (! EQ (FONTSET_BASE (fontset), Vdefault_fontset))
305 elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
306 if (NILP (elt))
307 elt = lookup_overriding_fontspec (FONTSET_FRAME (fontset), *c);
308 if (NILP (elt))
309 elt = FONTSET_REF (Vdefault_fontset, *c);
310 if (NILP (elt))
311 return Qnil;
313 *c = XINT (XCAR (elt));
314 SPLIT_CHAR (*c, charset, c1, c2);
315 elt = XCHAR_TABLE (fontset)->contents[charset + 128];
316 if (c1 < 32)
317 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
318 if (!SUB_CHAR_TABLE_P (elt))
319 return Qnil;
320 elt = XCHAR_TABLE (elt)->contents[c1];
321 if (c2 < 32)
322 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
323 if (!SUB_CHAR_TABLE_P (elt))
324 return Qnil;
325 elt = XCHAR_TABLE (elt)->contents[c2];
326 return elt;
330 /* Store into the element of FONTSET at index C the value NEWELT. */
331 #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
333 static void
334 fontset_set (fontset, c, newelt)
335 Lisp_Object fontset;
336 int c;
337 Lisp_Object newelt;
339 int charset, code[3];
340 Lisp_Object *elt;
341 int i;
343 if (SINGLE_BYTE_CHAR_P (c))
345 FONTSET_ASCII (fontset) = newelt;
346 return;
349 SPLIT_CHAR (c, charset, code[0], code[1]);
350 code[2] = 0; /* anchor */
351 elt = &XCHAR_TABLE (fontset)->contents[charset + 128];
352 for (i = 0; code[i] > 0; i++)
354 if (!SUB_CHAR_TABLE_P (*elt))
355 *elt = make_sub_char_table (*elt);
356 elt = &XCHAR_TABLE (*elt)->contents[code[i]];
358 if (SUB_CHAR_TABLE_P (*elt))
359 XCHAR_TABLE (*elt)->defalt = newelt;
360 else
361 *elt = newelt;
365 /* Return a newly created fontset with NAME. If BASE is nil, make a
366 base fontset. Otherwise make a realized fontset whose parent is
367 BASE. */
369 static Lisp_Object
370 make_fontset (frame, name, base)
371 Lisp_Object frame, name, base;
373 Lisp_Object fontset;
374 int size = ASIZE (Vfontset_table);
375 int id = next_fontset_id;
377 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
378 the next available fontset ID. So it is expected that this loop
379 terminates quickly. In addition, as the last element of
380 Vfontset_table is always nil, we don't have to check the range of
381 id. */
382 while (!NILP (AREF (Vfontset_table, id))) id++;
384 if (id + 1 == size)
386 Lisp_Object tem;
387 int i;
389 tem = Fmake_vector (make_number (size + 8), Qnil);
390 for (i = 0; i < size; i++)
391 AREF (tem, i) = AREF (Vfontset_table, i);
392 Vfontset_table = tem;
395 fontset = Fmake_char_table (Qfontset, Qnil);
397 FONTSET_ID (fontset) = make_number (id);
398 FONTSET_NAME (fontset) = name;
399 FONTSET_FRAME (fontset) = frame;
400 FONTSET_BASE (fontset) = base;
402 AREF (Vfontset_table, id) = fontset;
403 next_fontset_id = id + 1;
404 return fontset;
408 /* Return 1 if ID is a valid fontset id, else return 0. */
410 static INLINE int
411 fontset_id_valid_p (id)
412 int id;
414 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
418 /* Extract `family' and `registry' string from FONTNAME and a cons of
419 them. Actually, `family' may also contain `foundry', `registry'
420 may also contain `encoding' of FONTNAME. But, if FONTNAME doesn't
421 conform to XLFD nor explicitely specifies the other fields
422 (i.e. not using wildcard `*'), return FONTNAME. If FORCE is
423 nonzero, specifications of the other fields are ignored, and return
424 a cons as far as FONTNAME conform to XLFD. */
426 static Lisp_Object
427 font_family_registry (fontname, force)
428 Lisp_Object fontname;
429 int force;
431 Lisp_Object family, registry;
432 const char *p = SDATA (fontname);
433 const char *sep[15];
434 int i = 0;
436 while (*p && i < 15)
437 if (*p++ == '-')
439 if (!force && i >= 2 && i <= 11 && *p != '*' && p[1] != '-')
440 return fontname;
441 sep[i++] = p;
443 if (i != 14)
444 return fontname;
446 family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);
447 registry = make_unibyte_string (sep[12], p - sep[12]);
448 return Fcons (family, registry);
452 /********** INTERFACES TO xfaces.c and dispextern.h **********/
454 /* Return name of the fontset with ID. */
456 Lisp_Object
457 fontset_name (id)
458 int id;
460 Lisp_Object fontset;
461 fontset = FONTSET_FROM_ID (id);
462 return FONTSET_NAME (fontset);
466 /* Return ASCII font name of the fontset with ID. */
468 Lisp_Object
469 fontset_ascii (id)
470 int id;
472 Lisp_Object fontset, elt;
473 fontset= FONTSET_FROM_ID (id);
474 elt = FONTSET_ASCII (fontset);
475 return XCDR (elt);
479 /* Free fontset of FACE. Called from free_realized_face. */
481 void
482 free_face_fontset (f, face)
483 FRAME_PTR f;
484 struct face *face;
486 if (fontset_id_valid_p (face->fontset))
488 AREF (Vfontset_table, face->fontset) = Qnil;
489 if (face->fontset < next_fontset_id)
490 next_fontset_id = face->fontset;
495 /* Return 1 iff FACE is suitable for displaying character C.
496 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
497 when C is not a single byte character.. */
500 face_suitable_for_char_p (face, c)
501 struct face *face;
502 int c;
504 Lisp_Object fontset, elt;
506 if (SINGLE_BYTE_CHAR_P (c))
507 return (face == face->ascii_face);
509 xassert (fontset_id_valid_p (face->fontset));
510 fontset = FONTSET_FROM_ID (face->fontset);
511 xassert (!BASE_FONTSET_P (fontset));
513 elt = FONTSET_REF_VIA_BASE (fontset, c);
514 return (!NILP (elt) && face->id == XFASTINT (elt));
518 /* Return ID of face suitable for displaying character C on frame F.
519 The selection of face is done based on the fontset of FACE. FACE
520 should already have been realized for ASCII characters. Called
521 from the macro FACE_FOR_CHAR when C is not a single byte character. */
524 face_for_char (f, face, c)
525 FRAME_PTR f;
526 struct face *face;
527 int c;
529 Lisp_Object fontset, elt;
530 int face_id;
532 xassert (fontset_id_valid_p (face->fontset));
533 fontset = FONTSET_FROM_ID (face->fontset);
534 xassert (!BASE_FONTSET_P (fontset));
536 elt = FONTSET_REF_VIA_BASE (fontset, c);
537 if (!NILP (elt))
538 return XINT (elt);
540 /* No face is recorded for C in the fontset of FACE. Make a new
541 realized face for C that has the same fontset. */
542 face_id = lookup_face (f, face->lface, c, face);
544 /* Record the face ID in FONTSET at the same index as the
545 information in the base fontset. */
546 FONTSET_SET (fontset, c, make_number (face_id));
547 return face_id;
551 /* Make a realized fontset for ASCII face FACE on frame F from the
552 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
553 default fontset as the base. Value is the id of the new fontset.
554 Called from realize_x_face. */
557 make_fontset_for_ascii_face (f, base_fontset_id)
558 FRAME_PTR f;
559 int base_fontset_id;
561 Lisp_Object base_fontset, fontset, frame;
563 XSETFRAME (frame, f);
564 if (base_fontset_id >= 0)
566 base_fontset = FONTSET_FROM_ID (base_fontset_id);
567 if (!BASE_FONTSET_P (base_fontset))
568 base_fontset = FONTSET_BASE (base_fontset);
569 xassert (BASE_FONTSET_P (base_fontset));
571 else
572 base_fontset = Vdefault_fontset;
574 fontset = make_fontset (frame, Qnil, base_fontset);
575 return XINT (FONTSET_ID (fontset));
579 /* Return the font name pattern for C that is recorded in the fontset
580 with ID. If a font name pattern is specified (instead of a cons of
581 family and registry), check if a font can be opened by that pattern
582 to get the fullname. If a font is opened, return that name.
583 Otherwise, return nil. If ID is -1, or the fontset doesn't contain
584 information about C, get the registry and encoding of C from the
585 default fontset. Called from choose_face_font. */
587 Lisp_Object
588 fontset_font_pattern (f, id, c)
589 FRAME_PTR f;
590 int id, c;
592 Lisp_Object fontset, elt;
593 struct font_info *fontp;
595 elt = Qnil;
596 if (fontset_id_valid_p (id))
598 fontset = FONTSET_FROM_ID (id);
599 xassert (!BASE_FONTSET_P (fontset));
600 fontset = FONTSET_BASE (fontset);
601 if (! EQ (fontset, Vdefault_fontset))
602 elt = FONTSET_REF (fontset, c);
604 if (NILP (elt))
606 Lisp_Object frame;
608 XSETFRAME (frame, f);
609 elt = lookup_overriding_fontspec (frame, c);
611 if (NILP (elt))
612 elt = FONTSET_REF (Vdefault_fontset, c);
614 if (!CONSP (elt))
615 return Qnil;
616 if (CONSP (XCDR (elt)))
617 return XCDR (elt);
619 /* The fontset specifies only a font name pattern (not cons of
620 family and registry). If a font can be opened by that pattern,
621 return the name of opened font. Otherwise return nil. The
622 exception is a font for single byte characters. In that case, we
623 return a cons of FAMILY and REGISTRY extracted from the opened
624 font name. */
625 elt = XCDR (elt);
626 xassert (STRINGP (elt));
627 fontp = FS_LOAD_FONT (f, c, SDATA (elt), -1);
628 if (!fontp)
629 return Qnil;
631 return font_family_registry (build_string (fontp->full_name),
632 SINGLE_BYTE_CHAR_P (c));
636 #if defined(WINDOWSNT) && defined (_MSC_VER)
637 #pragma optimize("", off)
638 #endif
640 /* Load a font named FONTNAME to display character C on frame F.
641 Return a pointer to the struct font_info of the loaded font. If
642 loading fails, return NULL. If FACE is non-zero and a fontset is
643 assigned to it, record FACE->id in the fontset for C. If FONTNAME
644 is NULL, the name is taken from the fontset of FACE or what
645 specified by ID. */
647 struct font_info *
648 fs_load_font (f, c, fontname, id, face)
649 FRAME_PTR f;
650 int c;
651 char *fontname;
652 int id;
653 struct face *face;
655 Lisp_Object fontset;
656 Lisp_Object list, elt;
657 int size = 0;
658 struct font_info *fontp;
659 int charset = CHAR_CHARSET (c);
661 if (face)
662 id = face->fontset;
663 if (id < 0)
664 fontset = Qnil;
665 else
666 fontset = FONTSET_FROM_ID (id);
668 if (!NILP (fontset)
669 && !BASE_FONTSET_P (fontset))
671 elt = FONTSET_REF_VIA_BASE (fontset, c);
672 if (!NILP (elt))
674 /* A suitable face for C is already recorded, which means
675 that a proper font is already loaded. */
676 int face_id = XINT (elt);
678 xassert (face_id == face->id);
679 face = FACE_FROM_ID (f, face_id);
680 return (*get_font_info_func) (f, face->font_info_id);
683 if (!fontname && charset == CHARSET_ASCII)
685 elt = FONTSET_ASCII (fontset);
686 fontname = SDATA (XCDR (elt));
690 if (!fontname)
691 /* No way to get fontname. */
692 return 0;
694 fontp = (*load_font_func) (f, fontname, size);
695 if (!fontp)
696 return 0;
698 /* Fill in members (charset, vertical_centering, encoding, etc) of
699 font_info structure that are not set by (*load_font_func). */
700 fontp->charset = charset;
702 fontp->vertical_centering
703 = (STRINGP (Vvertical_centering_font_regexp)
704 && (fast_c_string_match_ignore_case
705 (Vvertical_centering_font_regexp, fontp->full_name) >= 0));
707 if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
709 /* The font itself tells which code points to be used. Use this
710 encoding for all other charsets. */
711 int i;
713 fontp->encoding[0] = fontp->encoding[1];
714 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
715 fontp->encoding[i] = fontp->encoding[1];
717 else
719 /* The font itself doesn't have information about encoding. */
720 int i;
722 fontname = fontp->full_name;
723 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
724 others is 1 (i.e. 0x80..0xFF). */
725 fontp->encoding[0] = 0;
726 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
727 fontp->encoding[i] = 1;
728 /* Then override them by a specification in Vfont_encoding_alist. */
729 for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list))
731 elt = XCAR (list);
732 if (CONSP (elt)
733 && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
734 && (fast_c_string_match_ignore_case (XCAR (elt), fontname)
735 >= 0))
737 Lisp_Object tmp;
739 for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp))
740 if (CONSP (XCAR (tmp))
741 && ((i = get_charset_id (XCAR (XCAR (tmp))))
742 >= 0)
743 && INTEGERP (XCDR (XCAR (tmp)))
744 && XFASTINT (XCDR (XCAR (tmp))) < 4)
745 fontp->encoding[i]
746 = XFASTINT (XCDR (XCAR (tmp)));
751 if (! fontp->font_encoder && find_ccl_program_func)
752 (*find_ccl_program_func) (fontp);
754 /* If we loaded a font for a face that has fontset, record the face
755 ID in the fontset for C. */
756 if (face
757 && !NILP (fontset)
758 && !BASE_FONTSET_P (fontset))
759 FONTSET_SET (fontset, c, make_number (face->id));
760 return fontp;
763 #if defined(WINDOWSNT) && defined (_MSC_VER)
764 #pragma optimize("", on)
765 #endif
768 /* Cache data used by fontset_pattern_regexp. The car part is a
769 pattern string containing at least one wild card, the cdr part is
770 the corresponding regular expression. */
771 static Lisp_Object Vcached_fontset_data;
773 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
774 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
776 /* If fontset name PATTERN contains any wild card, return regular
777 expression corresponding to PATTERN. */
779 static Lisp_Object
780 fontset_pattern_regexp (pattern)
781 Lisp_Object pattern;
783 if (!index (SDATA (pattern), '*')
784 && !index (SDATA (pattern), '?'))
785 /* PATTERN does not contain any wild cards. */
786 return Qnil;
788 if (!CONSP (Vcached_fontset_data)
789 || strcmp (SDATA (pattern), CACHED_FONTSET_NAME))
791 /* We must at first update the cached data. */
792 char *regex = (char *) alloca (SCHARS (pattern) * 2 + 3);
793 char *p0, *p1 = regex;
795 /* Convert "*" to ".*", "?" to ".". */
796 *p1++ = '^';
797 for (p0 = (char *) SDATA (pattern); *p0; p0++)
799 if (*p0 == '*')
801 *p1++ = '.';
802 *p1++ = '*';
804 else if (*p0 == '?')
805 *p1++ = '.';
806 else
807 *p1++ = *p0;
809 *p1++ = '$';
810 *p1++ = 0;
812 Vcached_fontset_data = Fcons (build_string (SDATA (pattern)),
813 build_string (regex));
816 return CACHED_FONTSET_REGEX;
819 /* Return ID of the base fontset named NAME. If there's no such
820 fontset, return -1. */
823 fs_query_fontset (name, regexpp)
824 Lisp_Object name;
825 int regexpp;
827 Lisp_Object tem;
828 int i;
830 name = Fdowncase (name);
831 if (!regexpp)
833 tem = Frassoc (name, Vfontset_alias_alist);
834 if (CONSP (tem) && STRINGP (XCAR (tem)))
835 name = XCAR (tem);
836 else
838 tem = fontset_pattern_regexp (name);
839 if (STRINGP (tem))
841 name = tem;
842 regexpp = 1;
847 for (i = 0; i < ASIZE (Vfontset_table); i++)
849 Lisp_Object fontset;
850 const unsigned char *this_name;
852 fontset = FONTSET_FROM_ID (i);
853 if (NILP (fontset)
854 || !BASE_FONTSET_P (fontset))
855 continue;
857 this_name = SDATA (FONTSET_NAME (fontset));
858 if (regexpp
859 ? fast_c_string_match_ignore_case (name, this_name) >= 0
860 : !strcmp (SDATA (name), this_name))
861 return i;
863 return -1;
867 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
868 doc: /* Return the name of a fontset that matches PATTERN.
869 The value is nil if there is no matching fontset.
870 PATTERN can contain `*' or `?' as a wildcard
871 just as X font name matching algorithm allows.
872 If REGEXPP is non-nil, PATTERN is a regular expression. */)
873 (pattern, regexpp)
874 Lisp_Object pattern, regexpp;
876 Lisp_Object fontset;
877 int id;
879 (*check_window_system_func) ();
881 CHECK_STRING (pattern);
883 if (SCHARS (pattern) == 0)
884 return Qnil;
886 id = fs_query_fontset (pattern, !NILP (regexpp));
887 if (id < 0)
888 return Qnil;
890 fontset = FONTSET_FROM_ID (id);
891 return FONTSET_NAME (fontset);
894 /* Return a list of base fontset names matching PATTERN on frame F.
895 If SIZE is not 0, it is the size (maximum bound width) of fontsets
896 to be listed. */
898 Lisp_Object
899 list_fontsets (f, pattern, size)
900 FRAME_PTR f;
901 Lisp_Object pattern;
902 int size;
904 Lisp_Object frame, regexp, val;
905 int id;
907 XSETFRAME (frame, f);
909 regexp = fontset_pattern_regexp (pattern);
910 val = Qnil;
912 for (id = 0; id < ASIZE (Vfontset_table); id++)
914 Lisp_Object fontset;
915 const unsigned char *name;
917 fontset = FONTSET_FROM_ID (id);
918 if (NILP (fontset)
919 || !BASE_FONTSET_P (fontset)
920 || !EQ (frame, FONTSET_FRAME (fontset)))
921 continue;
922 name = SDATA (FONTSET_NAME (fontset));
924 if (!NILP (regexp)
925 ? (fast_c_string_match_ignore_case (regexp, name) < 0)
926 : strcmp (SDATA (pattern), name))
927 continue;
929 if (size)
931 struct font_info *fontp;
932 fontp = FS_LOAD_FONT (f, 0, NULL, id);
933 if (!fontp || size != fontp->size)
934 continue;
936 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
939 return val;
942 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
943 doc: /* Create a new fontset NAME that contains font information in FONTLIST.
944 FONTLIST is an alist of charsets vs corresponding font name patterns. */)
945 (name, fontlist)
946 Lisp_Object name, fontlist;
948 Lisp_Object fontset, elements, ascii_font;
949 Lisp_Object tem, tail, elt;
951 (*check_window_system_func) ();
953 CHECK_STRING (name);
954 CHECK_LIST (fontlist);
956 name = Fdowncase (name);
957 tem = Fquery_fontset (name, Qnil);
958 if (!NILP (tem))
959 error ("Fontset `%s' matches the existing fontset `%s'",
960 SDATA (name), SDATA (tem));
962 /* Check the validity of FONTLIST while creating a template for
963 fontset elements. */
964 elements = ascii_font = Qnil;
965 for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
967 int c, charset;
969 tem = XCAR (tail);
970 if (!CONSP (tem)
971 || (charset = get_charset_id (XCAR (tem))) < 0
972 || (!STRINGP (XCDR (tem)) && !CONSP (XCDR (tem))))
973 error ("Elements of fontlist must be a cons of charset and font name pattern");
975 tem = XCDR (tem);
976 if (STRINGP (tem))
977 tem = Fdowncase (tem);
978 else
979 tem = Fcons (Fdowncase (Fcar (tem)), Fdowncase (Fcdr (tem)));
980 if (charset == CHARSET_ASCII)
981 ascii_font = tem;
982 else
984 c = MAKE_CHAR (charset, 0, 0);
985 elements = Fcons (Fcons (make_number (c), tem), elements);
989 if (NILP (ascii_font))
990 error ("No ASCII font in the fontlist");
992 fontset = make_fontset (Qnil, name, Qnil);
993 FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font);
994 for (; CONSP (elements); elements = XCDR (elements))
996 elt = XCAR (elements);
997 tem = XCDR (elt);
998 if (STRINGP (tem))
999 tem = font_family_registry (tem, 0);
1000 tem = Fcons (XCAR (elt), tem);
1001 FONTSET_SET (fontset, XINT (XCAR (elt)), tem);
1004 return Qnil;
1008 /* Clear all elements of FONTSET for multibyte characters. */
1010 static void
1011 clear_fontset_elements (fontset)
1012 Lisp_Object fontset;
1014 int i;
1016 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
1017 XCHAR_TABLE (fontset)->contents[i] = Qnil;
1021 /* Check validity of NAME as a fontset name and return the
1022 corresponding fontset. If not valid, signal an error.
1023 If NAME is nil, return Vdefault_fontset. */
1025 static Lisp_Object
1026 check_fontset_name (name)
1027 Lisp_Object name;
1029 int id;
1031 if (EQ (name, Qnil))
1032 return Vdefault_fontset;
1034 CHECK_STRING (name);
1035 id = fs_query_fontset (name, 0);
1036 if (id < 0)
1037 error ("Fontset `%s' does not exist", SDATA (name));
1038 return FONTSET_FROM_ID (id);
1041 /* Downcase FONTNAME or car and cdr of FONTNAME. If FONTNAME is a
1042 string, maybe change FONTNAME to (FAMILY . REGISTRY). */
1044 static Lisp_Object
1045 regulalize_fontname (Lisp_Object fontname)
1047 Lisp_Object family, registry;
1049 if (STRINGP (fontname))
1050 return font_family_registry (Fdowncase (fontname), 0);
1052 CHECK_CONS (fontname);
1053 family = XCAR (fontname);
1054 registry = XCDR (fontname);
1055 if (!NILP (family))
1057 CHECK_STRING (family);
1058 family = Fdowncase (family);
1060 if (!NILP (registry))
1062 CHECK_STRING (registry);
1063 registry = Fdowncase (registry);
1065 return Fcons (family, registry);
1068 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
1069 doc: /* Modify fontset NAME to use FONTNAME for CHARACTER.
1071 If NAME is nil, modify the default fontset.
1072 CHARACTER may be a cons; (FROM . TO), where FROM and TO are
1073 non-generic characters. In that case, use FONTNAME
1074 for all characters in the range FROM and TO (inclusive).
1075 CHARACTER may be a charset. In that case, use FONTNAME
1076 for all character in the charsets.
1078 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family
1079 name of a font, REGISTRY is a registry name of a font. */)
1080 (name, character, fontname, frame)
1081 Lisp_Object name, character, fontname, frame;
1083 Lisp_Object fontset, elt;
1084 Lisp_Object realized;
1085 int from, to;
1086 int id;
1087 Lisp_Object family, registry;
1089 fontset = check_fontset_name (name);
1091 if (CONSP (character))
1093 /* CH should be (FROM . TO) where FROM and TO are non-generic
1094 characters. */
1095 CHECK_NUMBER_CAR (character);
1096 CHECK_NUMBER_CDR (character);
1097 from = XINT (XCAR (character));
1098 to = XINT (XCDR (character));
1099 if (!char_valid_p (from, 0) || !char_valid_p (to, 0))
1100 error ("Character range should be by non-generic characters");
1101 if (!NILP (name)
1102 && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to)))
1103 error ("Can't change font for a single byte character");
1105 else if (SYMBOLP (character))
1107 elt = Fget (character, Qcharset);
1108 if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0)))
1109 error ("Invalid charset: %s", SDATA (SYMBOL_NAME (character)));
1110 from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0);
1111 to = from;
1113 else
1115 CHECK_NUMBER (character);
1116 from = XINT (character);
1117 to = from;
1119 if (!char_valid_p (from, 1))
1120 invalid_character (from);
1121 if (SINGLE_BYTE_CHAR_P (from))
1122 error ("Can't change font for a single byte character");
1123 if (from < to)
1125 if (!char_valid_p (to, 1))
1126 invalid_character (to);
1127 if (SINGLE_BYTE_CHAR_P (to))
1128 error ("Can't change font for a single byte character");
1131 /* The arg FRAME is kept for backward compatibility. We only check
1132 the validity. */
1133 if (!NILP (frame))
1134 CHECK_LIVE_FRAME (frame);
1136 elt = Fcons (make_number (from), regulalize_fontname (fontname));
1137 for (; from <= to; from++)
1138 FONTSET_SET (fontset, from, elt);
1139 Foptimize_char_table (fontset);
1141 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1142 clear all the elements of REALIZED and free all multibyte faces
1143 whose fontset is REALIZED. This way, the specified character(s)
1144 are surely redisplayed by a correct font. */
1145 for (id = 0; id < ASIZE (Vfontset_table); id++)
1147 realized = AREF (Vfontset_table, id);
1148 if (!NILP (realized)
1149 && !BASE_FONTSET_P (realized)
1150 && EQ (FONTSET_BASE (realized), fontset))
1152 FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));
1153 clear_fontset_elements (realized);
1154 free_realized_multibyte_face (f, id);
1158 return Qnil;
1161 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
1162 doc: /* Return information about a font named NAME on frame FRAME.
1163 If FRAME is omitted or nil, use the selected frame.
1164 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1165 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1166 where
1167 OPENED-NAME is the name used for opening the font,
1168 FULL-NAME is the full name of the font,
1169 SIZE is the maximum bound width of the font,
1170 HEIGHT is the height of the font,
1171 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1172 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1173 how to compose characters.
1174 If the named font is not yet loaded, return nil. */)
1175 (name, frame)
1176 Lisp_Object name, frame;
1178 FRAME_PTR f;
1179 struct font_info *fontp;
1180 Lisp_Object info;
1182 (*check_window_system_func) ();
1184 CHECK_STRING (name);
1185 name = Fdowncase (name);
1186 if (NILP (frame))
1187 frame = selected_frame;
1188 CHECK_LIVE_FRAME (frame);
1189 f = XFRAME (frame);
1191 if (!query_font_func)
1192 error ("Font query function is not supported");
1194 fontp = (*query_font_func) (f, SDATA (name));
1195 if (!fontp)
1196 return Qnil;
1198 info = Fmake_vector (make_number (7), Qnil);
1200 XVECTOR (info)->contents[0] = build_string (fontp->name);
1201 XVECTOR (info)->contents[1] = build_string (fontp->full_name);
1202 XVECTOR (info)->contents[2] = make_number (fontp->size);
1203 XVECTOR (info)->contents[3] = make_number (fontp->height);
1204 XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset);
1205 XVECTOR (info)->contents[5] = make_number (fontp->relative_compose);
1206 XVECTOR (info)->contents[6] = make_number (fontp->default_ascent);
1208 return info;
1212 /* Return a cons (FONT-NAME . GLYPH-CODE).
1213 FONT-NAME is the font name for the character at POSITION in the current
1214 buffer. This is computed from all the text properties and overlays
1215 that apply to POSITION.
1216 GLYPH-CODE is the glyph code in the font to use for the character.
1218 If the 2nd optional arg CH is non-nil, it is a character to check
1219 the font instead of the character at POSITION.
1221 It returns nil in the following cases:
1223 (1) The window system doesn't have a font for the character (thus
1224 it is displayed by an empty box).
1226 (2) The character code is invalid.
1228 (3) The current buffer is not displayed in any window.
1230 In addition, the returned font name may not take into account of
1231 such redisplay engine hooks as what used in jit-lock-mode if
1232 POSITION is currently not visible. */
1235 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
1236 doc: /* For internal use only. */)
1237 (position, ch)
1238 Lisp_Object position, ch;
1240 int pos, pos_byte, dummy;
1241 int face_id;
1242 int c, code;
1243 Lisp_Object window;
1244 struct window *w;
1245 struct frame *f;
1246 struct face *face;
1248 CHECK_NUMBER_COERCE_MARKER (position);
1249 pos = XINT (position);
1250 if (pos < BEGV || pos >= ZV)
1251 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1252 pos_byte = CHAR_TO_BYTE (pos);
1253 if (NILP (ch))
1254 c = FETCH_CHAR (pos_byte);
1255 else
1257 CHECK_NATNUM (ch);
1258 c = XINT (ch);
1260 if (! CHAR_VALID_P (c, 0))
1261 return Qnil;
1262 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1263 if (NILP (window))
1264 return Qnil;
1265 w = XWINDOW (window);
1266 f = XFRAME (w->frame);
1267 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
1268 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
1269 face = FACE_FROM_ID (f, face_id);
1270 if (! face->font || ! face->font_name)
1271 return Qnil;
1274 struct font_info *fontp = (*get_font_info_func) (f, face->font_info_id);
1275 XChar2b char2b;
1276 int c1, c2, charset;
1278 SPLIT_CHAR (c, charset, c1, c2);
1279 if (c2 > 0)
1280 STORE_XCHAR2B (&char2b, c1, c2);
1281 else
1282 STORE_XCHAR2B (&char2b, 0, c1);
1283 rif->encode_char (c, &char2b, fontp, NULL);
1284 code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b);
1286 return Fcons (build_string (face->font_name), make_number (code));
1290 /* Called from Ffontset_info via map_char_table on each leaf of
1291 fontset. ARG is a copy of the default fontset. The current leaf
1292 is indexed by CHARACTER and has value ELT. This function override
1293 the copy by ELT if ELT is not nil. */
1295 static void
1296 override_font_info (fontset, character, elt)
1297 Lisp_Object fontset, character, elt;
1299 if (! NILP (elt))
1300 Faset (fontset, character, elt);
1303 /* Called from Ffontset_info via map_char_table on each leaf of
1304 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1305 ARG)' and FONT-INFOs have this form:
1306 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1307 The current leaf is indexed by CHARACTER and has value ELT. This
1308 function add the information of the current leaf to ARG by
1309 appending a new element or modifying the last element. */
1311 static void
1312 accumulate_font_info (arg, character, elt)
1313 Lisp_Object arg, character, elt;
1315 Lisp_Object last, last_char, last_elt;
1317 if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))
1318 elt = FONTSET_REF (Vdefault_fontset, XINT (character));
1319 if (!CONSP (elt))
1320 return;
1321 last = XCAR (arg);
1322 last_char = XCAR (XCAR (last));
1323 last_elt = XCAR (XCDR (XCAR (last)));
1324 elt = XCDR (elt);
1325 if (!NILP (Fequal (elt, last_elt)))
1327 int this_charset = CHAR_CHARSET (XINT (character));
1329 if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */
1331 if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char))))
1333 XSETCDR (last_char, character);
1334 return;
1337 else if (XINT (last_char) == XINT (character))
1338 return;
1339 else if (this_charset == CHAR_CHARSET (XINT (last_char)))
1341 XSETCAR (XCAR (last), Fcons (last_char, character));
1342 return;
1345 XSETCDR (last, Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil));
1346 XSETCAR (arg, XCDR (last));
1350 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1351 doc: /* Return information about a fontset named NAME on frame FRAME.
1352 If NAME is nil, return information about the default fontset.
1353 The value is a vector:
1354 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],
1355 where,
1356 SIZE is the maximum bound width of ASCII font in the fontset,
1357 HEIGHT is the maximum bound height of ASCII font in the fontset,
1358 CHARSET-OR-RANGE is a charset, a character (may be a generic character)
1359 or a cons of two characters specifying the range of characters.
1360 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),
1361 where FAMILY is a `FAMILY' field of a XLFD font name,
1362 REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name.
1363 FAMILY may contain a `FOUNDRY' field at the head.
1364 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.
1365 OPENEDs are names of fonts actually opened.
1366 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.
1367 If FRAME is omitted, it defaults to the currently selected frame. */)
1368 (name, frame)
1369 Lisp_Object name, frame;
1371 Lisp_Object fontset;
1372 FRAME_PTR f;
1373 Lisp_Object indices[3];
1374 Lisp_Object val, tail, elt;
1375 Lisp_Object *realized;
1376 struct font_info *fontp = NULL;
1377 int n_realized = 0;
1378 int i;
1380 (*check_window_system_func) ();
1382 fontset = check_fontset_name (name);
1384 if (NILP (frame))
1385 frame = selected_frame;
1386 CHECK_LIVE_FRAME (frame);
1387 f = XFRAME (frame);
1389 /* Recode realized fontsets whose base is FONTSET in the table
1390 `realized'. */
1391 realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1392 * ASIZE (Vfontset_table));
1393 for (i = 0; i < ASIZE (Vfontset_table); i++)
1395 elt = FONTSET_FROM_ID (i);
1396 if (!NILP (elt)
1397 && EQ (FONTSET_BASE (elt), fontset))
1398 realized[n_realized++] = elt;
1401 if (! EQ (fontset, Vdefault_fontset))
1403 /* Merge FONTSET onto the default fontset. */
1404 val = Fcopy_sequence (Vdefault_fontset);
1405 map_char_table (override_font_info, Qnil, fontset, fontset, val, 0, indices);
1406 fontset = val;
1409 /* Accumulate information of the fontset in VAL. The format is
1410 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1411 FONT-SPEC). See the comment for accumulate_font_info for the
1412 detail. */
1413 val = Fcons (Fcons (make_number (0),
1414 Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)),
1415 Qnil);
1416 val = Fcons (val, val);
1417 map_char_table (accumulate_font_info, Qnil, fontset, fontset, val, 0, indices);
1418 val = XCDR (val);
1420 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1421 character for a charset, replace it with the charset symbol. If
1422 fonts are opened for FONT-SPEC, append the names of the fonts to
1423 FONT-SPEC. */
1424 for (tail = val; CONSP (tail); tail = XCDR (tail))
1426 int c;
1427 elt = XCAR (tail);
1428 if (INTEGERP (XCAR (elt)))
1430 int charset, c1, c2;
1431 c = XINT (XCAR (elt));
1432 SPLIT_CHAR (c, charset, c1, c2);
1433 if (c1 == 0)
1434 XSETCAR (elt, CHARSET_SYMBOL (charset));
1436 else
1437 c = XINT (XCAR (XCAR (elt)));
1438 for (i = 0; i < n_realized; i++)
1440 Lisp_Object face_id, font;
1441 struct face *face;
1443 face_id = FONTSET_REF_VIA_BASE (realized[i], c);
1444 if (INTEGERP (face_id))
1446 face = FACE_FROM_ID (f, XINT (face_id));
1447 if (face && face->font && face->font_name)
1449 font = build_string (face->font_name);
1450 if (NILP (Fmember (font, XCDR (XCDR (elt)))))
1451 XSETCDR (XCDR (elt), Fcons (font, XCDR (XCDR (elt))));
1457 elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val)));
1458 if (CONSP (elt))
1460 elt = XCAR (elt);
1461 fontp = (*query_font_func) (f, SDATA (elt));
1463 val = Fmake_vector (make_number (3), val);
1464 AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0);
1465 AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0);
1466 return val;
1469 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
1470 doc: /* Return a font name pattern for character CH in fontset NAME.
1471 If NAME is nil, find a font name pattern in the default fontset. */)
1472 (name, ch)
1473 Lisp_Object name, ch;
1475 int c;
1476 Lisp_Object fontset, elt;
1478 fontset = check_fontset_name (name);
1480 CHECK_NUMBER (ch);
1481 c = XINT (ch);
1482 if (!char_valid_p (c, 1))
1483 invalid_character (c);
1485 elt = FONTSET_REF (fontset, c);
1486 if (CONSP (elt))
1487 elt = XCDR (elt);
1489 return elt;
1492 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
1493 doc: /* Return a list of all defined fontset names. */)
1496 Lisp_Object fontset, list;
1497 int i;
1499 list = Qnil;
1500 for (i = 0; i < ASIZE (Vfontset_table); i++)
1502 fontset = FONTSET_FROM_ID (i);
1503 if (!NILP (fontset)
1504 && BASE_FONTSET_P (fontset))
1505 list = Fcons (FONTSET_NAME (fontset), list);
1508 return list;
1511 DEFUN ("set-overriding-fontspec-internal", Fset_overriding_fontspec_internal,
1512 Sset_overriding_fontspec_internal, 1, 1, 0,
1513 doc: /* Internal use only.
1515 FONTLIST is an alist of TARGET vs FONTNAME, where TARGET is a charset
1516 or a char-table, FONTNAME have the same meanings as in
1517 `set-fontset-font'.
1519 It overrides the font specifications for each TARGET in the default
1520 fontset by the corresponding FONTNAME.
1522 If TARGET is a charset, targets are all characters in the charset. If
1523 TARGET is a char-table, targets are characters whose value is non-nil
1524 in the table.
1526 It is intended that this function is called only from
1527 `set-language-environment'. */)
1528 (fontlist)
1529 Lisp_Object fontlist;
1531 Lisp_Object tail;
1533 fontlist = Fcopy_sequence (fontlist);
1534 /* Now FONTLIST is ((TARGET . FONTNAME) ...). Reform it to ((TARGET
1535 nil nil nil FONTSPEC) ...), where TARGET is a charset-id or a
1536 char-table. */
1537 for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
1539 Lisp_Object elt, target;
1541 elt = XCAR (tail);
1542 target = Fcar (elt);
1543 elt = Fcons (Qnil, regulalize_fontname (Fcdr (elt)));
1544 if (! CHAR_TABLE_P (target))
1546 int charset, c;
1548 CHECK_SYMBOL (target);
1549 charset = get_charset_id (target);
1550 if (charset < 0)
1551 error ("Invalid charset %s", SDATA (SYMBOL_NAME (target)));
1552 target = make_number (charset);
1553 c = MAKE_CHAR (charset, 0, 0);
1554 XSETCAR (elt, make_number (c));
1556 elt = Fcons (target, Fcons (Qnil, Fcons (Qnil, elt)));
1557 XSETCAR (tail, elt);
1559 Voverriding_fontspec_alist = fontlist;
1560 clear_face_cache (0);
1561 ++windows_or_buffers_changed;
1562 return Qnil;
1565 void
1566 syms_of_fontset ()
1568 if (!load_font_func)
1569 /* Window system initializer should have set proper functions. */
1570 abort ();
1572 Qfontset = intern ("fontset");
1573 staticpro (&Qfontset);
1574 Fput (Qfontset, Qchar_table_extra_slots, make_number (3));
1576 Vcached_fontset_data = Qnil;
1577 staticpro (&Vcached_fontset_data);
1579 Vfontset_table = Fmake_vector (make_number (32), Qnil);
1580 staticpro (&Vfontset_table);
1582 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
1583 staticpro (&Vdefault_fontset);
1584 FONTSET_ID (Vdefault_fontset) = make_number (0);
1585 FONTSET_NAME (Vdefault_fontset)
1586 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1587 #if defined (MAC_OS)
1588 FONTSET_ASCII (Vdefault_fontset)
1589 = Fcons (make_number (0),
1590 build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));
1591 #elif defined (WINDOWSNT)
1592 FONTSET_ASCII (Vdefault_fontset)
1593 = Fcons (make_number (0),
1594 build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
1595 #else
1596 FONTSET_ASCII (Vdefault_fontset)
1597 = Fcons (make_number (0),
1598 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1599 #endif
1600 AREF (Vfontset_table, 0) = Vdefault_fontset;
1601 next_fontset_id = 1;
1603 Voverriding_fontspec_alist = Qnil;
1604 staticpro (&Voverriding_fontspec_alist);
1606 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
1607 doc: /* Alist of fontname patterns vs corresponding encoding info.
1608 Each element looks like (REGEXP . ENCODING-INFO),
1609 where ENCODING-INFO is an alist of CHARSET vs ENCODING.
1610 ENCODING is one of the following integer values:
1611 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,
1612 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,
1613 2: code points 0x20A0..0x7FFF are used,
1614 3: code points 0xA020..0xFF7F are used. */);
1615 Vfont_encoding_alist = Qnil;
1616 Vfont_encoding_alist
1617 = Fcons (Fcons (build_string ("JISX0201"),
1618 Fcons (Fcons (intern ("latin-jisx0201"), make_number (0)),
1619 Qnil)),
1620 Vfont_encoding_alist);
1621 Vfont_encoding_alist
1622 = Fcons (Fcons (build_string ("ISO8859-1"),
1623 Fcons (Fcons (intern ("ascii"), make_number (0)),
1624 Qnil)),
1625 Vfont_encoding_alist);
1627 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
1628 doc: /* Char table of characters whose ascent values should be ignored.
1629 If an entry for a character is non-nil, the ascent value of the glyph
1630 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
1632 This affects how a composite character which contains
1633 such a character is displayed on screen. */);
1634 Vuse_default_ascent = Qnil;
1636 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
1637 doc: /* Char table of characters which is not composed relatively.
1638 If an entry for a character is non-nil, a composition sequence
1639 which contains that character is displayed so that
1640 the glyph of that character is put without considering
1641 an ascent and descent value of a previous character. */);
1642 Vignore_relative_composition = Qnil;
1644 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
1645 doc: /* Alist of fontname vs list of the alternate fontnames.
1646 When a specified font name is not found, the corresponding
1647 alternate fontnames (if any) are tried instead. */);
1648 Valternate_fontname_alist = Qnil;
1650 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
1651 doc: /* Alist of fontset names vs the aliases. */);
1652 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
1653 build_string ("fontset-default")),
1654 Qnil);
1656 DEFVAR_LISP ("vertical-centering-font-regexp",
1657 &Vvertical_centering_font_regexp,
1658 doc: /* *Regexp matching font names that require vertical centering on display.
1659 When a character is displayed with such fonts, the character is displayed
1660 at the vertical center of lines. */);
1661 Vvertical_centering_font_regexp = Qnil;
1663 defsubr (&Squery_fontset);
1664 defsubr (&Snew_fontset);
1665 defsubr (&Sset_fontset_font);
1666 defsubr (&Sfont_info);
1667 defsubr (&Sinternal_char_font);
1668 defsubr (&Sfontset_info);
1669 defsubr (&Sfontset_font);
1670 defsubr (&Sfontset_list);
1671 defsubr (&Sset_overriding_fontspec_internal);
1674 /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
1675 (do not change this comment) */