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)
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 */
36 #include "dispextern.h"
42 #define xassert(X) do {if (!(X)) abort ();} while (0)
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.
59 A fontset object is implemented by a char-table.
61 An element of a base fontset is:
63 (INDEX . (FOUNDRY . REGISTRY ))
64 FONTNAME is a font name pattern for the corresponding character.
65 FOUNDRY and REGISTRY are respectively foundry and registry 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
73 An element of a realized fontset is FACE-ID which is a face to use
74 for displaying the corresponding character.
76 All single byte characters (ASCII and 8bit-unibyte) share the same
77 element in a fontset. The element is stored in the first element
80 To access or set each element, use macros FONTSET_REF and
81 FONTSET_SET respectively for efficiency.
83 A fontset has 3 extra slots.
85 The 1st slot is an ID number of the fontset.
87 The 2nd slot is a name of the fontset. This is nil for a realized
90 The 3rd slot is a frame that the fontset belongs to. This is nil
93 A parent of a base fontset is nil. A parent of a realized fontset
96 All fontsets are recorded in Vfontset_table.
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.
106 The parent of a realized fontset created for such a face that has
107 no fontset is the default fontset.
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 variable name `id' for IDs, and name `fontset' for the
114 actual fontset objects.
118 /********** VARIABLES and FUNCTION PROTOTYPES **********/
120 extern Lisp_Object Qfont
;
121 Lisp_Object Qfontset
;
123 /* Vector containing all fontsets. */
124 static Lisp_Object Vfontset_table
;
126 /* Next possibly free fontset ID. Usually this keeps the minimum
127 fontset ID not yet used. */
128 static int next_fontset_id
;
130 /* The default fontset. This gives default FAMILY and REGISTRY of
131 font for each characters. */
132 static Lisp_Object Vdefault_fontset
;
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 Vvertical_centering_font_regexp
;
141 /* The following six are declarations of callback functions depending
142 on window system. See the comments in src/fontset.h for more
145 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
146 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
148 /* Return a list of font names which matches PATTERN. See the documentation
149 of `x-list-fonts' for more details. */
150 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
155 /* Load a font named NAME for frame F and return a pointer to the
156 information of the loaded font. If loading is failed, return 0. */
157 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
159 /* Return a pointer to struct font_info of a font named NAME for frame F. */
160 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
162 /* Additional function for setting fontset or changing fontset
163 contents of frame F. */
164 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
165 Lisp_Object oldval
));
167 /* To find a CCL program, fs_load_font calls this function.
168 The argument is a pointer to the struct font_info.
169 This function set the member `encoder' of the structure. */
170 void (*find_ccl_program_func
) P_ ((struct font_info
*));
172 /* Check if any window system is used now. */
173 void (*check_window_system_func
) P_ ((void));
176 /* Prototype declarations for static functions. */
177 static Lisp_Object fontset_ref
P_ ((Lisp_Object
, int));
178 static void fontset_set
P_ ((Lisp_Object
, int, Lisp_Object
));
179 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
180 static int fontset_id_valid_p
P_ ((int));
181 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
182 static Lisp_Object font_family_registry
P_ ((Lisp_Object
, int));
185 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
187 /* Return the fontset with ID. No check of ID's validness. */
188 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
190 /* Macros to access special values of FONTSET. */
191 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
192 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
193 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
194 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0]
195 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
197 #define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
200 /* Return the element of FONTSET (char-table) at index C (character). */
202 #define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
205 fontset_ref (fontset
, c
)
210 Lisp_Object elt
, defalt
;
212 if (SINGLE_BYTE_CHAR_P (c
))
213 return FONTSET_ASCII (fontset
);
215 SPLIT_CHAR (c
, charset
, c1
, c2
);
216 elt
= XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
217 if (!SUB_CHAR_TABLE_P (elt
))
219 defalt
= XCHAR_TABLE (elt
)->defalt
;
221 || (elt
= XCHAR_TABLE (elt
)->contents
[c1
],
224 if (!SUB_CHAR_TABLE_P (elt
))
226 defalt
= XCHAR_TABLE (elt
)->defalt
;
228 || (elt
= XCHAR_TABLE (elt
)->contents
[c2
],
235 #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
238 fontset_ref_via_base (fontset
, c
)
245 if (SINGLE_BYTE_CHAR_P (*c
))
246 return FONTSET_ASCII (fontset
);
248 elt
= FONTSET_REF (FONTSET_BASE (fontset
), *c
);
249 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
))
250 elt
= FONTSET_REF (Vdefault_fontset
, *c
);
254 *c
= XINT (XCAR (elt
));
255 SPLIT_CHAR (*c
, charset
, c1
, c2
);
256 elt
= XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
258 return (SUB_CHAR_TABLE_P (elt
) ? XCHAR_TABLE (elt
)->defalt
: elt
);
259 if (!SUB_CHAR_TABLE_P (elt
))
261 elt
= XCHAR_TABLE (elt
)->contents
[c1
];
263 return (SUB_CHAR_TABLE_P (elt
) ? XCHAR_TABLE (elt
)->defalt
: elt
);
264 if (!SUB_CHAR_TABLE_P (elt
))
266 elt
= XCHAR_TABLE (elt
)->contents
[c2
];
271 /* Store into the element of FONTSET at index C the value NEWELT. */
272 #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
275 fontset_set (fontset
, c
, newelt
)
280 int charset
, code
[3];
284 if (SINGLE_BYTE_CHAR_P (c
))
286 FONTSET_ASCII (fontset
) = newelt
;
290 SPLIT_CHAR (c
, charset
, code
[0], code
[1]);
291 code
[2] = 0; /* anchor */
292 elt
= &XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
293 for (i
= 0; code
[i
] > 0; i
++)
295 if (!SUB_CHAR_TABLE_P (*elt
))
296 *elt
= make_sub_char_table (*elt
);
297 elt
= &XCHAR_TABLE (*elt
)->contents
[code
[i
]];
299 if (SUB_CHAR_TABLE_P (*elt
))
300 XCHAR_TABLE (*elt
)->defalt
= newelt
;
306 /* Return a newly created fontset with NAME. If BASE is nil, make a
307 base fontset. Otherwise make a realized fontset whose parent is
311 make_fontset (frame
, name
, base
)
312 Lisp_Object frame
, name
, base
;
315 int size
= ASIZE (Vfontset_table
);
316 int id
= next_fontset_id
;
318 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
319 the next available fontset ID. So it is expected that this loop
320 terminates quickly. In addition, as the last element of
321 Vfontset_table is always nil, we don't have to check the range of
323 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
330 tem
= Fmake_vector (make_number (size
+ 8), Qnil
);
331 for (i
= 0; i
< size
; i
++)
332 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
333 Vfontset_table
= tem
;
336 fontset
= Fmake_char_table (Qfontset
, Qnil
);
338 FONTSET_ID (fontset
) = make_number (id
);
339 FONTSET_NAME (fontset
) = name
;
340 FONTSET_FRAME (fontset
) = frame
;
341 FONTSET_BASE (fontset
) = base
;
343 AREF (Vfontset_table
, id
) = fontset
;
344 next_fontset_id
= id
+ 1;
349 /* Return 1 if ID is a valid fontset id, else return 0. */
352 fontset_id_valid_p (id
)
355 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
359 /* Extract `family' and `registry' string from FONTNAME and a cons of
360 them. Actually, `family' may also contain `foundry', `registry'
361 may also contain `encoding' of FONTNAME. But, if FONTNAME doesn't
362 conform to XLFD nor explicitely specifies the other fields
363 (i.e. not using wildcard `*'), return FONTNAME. If FORCE is
364 nonzero, specifications of the other fields are ignored, and return
365 a cons as far as FONTNAME conform to XLFD. */
368 font_family_registry (fontname
, force
)
369 Lisp_Object fontname
;
372 Lisp_Object family
, registry
;
373 char *p
= XSTRING (fontname
)->data
;
380 if (!force
&& i
>= 2 && i
<= 11 && *p
!= '*' && p
[1] != '-')
387 family
= make_unibyte_string (sep
[0], sep
[2] - 1 - sep
[0]);
388 registry
= make_unibyte_string (sep
[12], p
- sep
[12]);
389 return Fcons (family
, registry
);
393 /********** INTERFACES TO xfaces.c and dispextern.h **********/
395 /* Return name of the fontset with ID. */
402 fontset
= FONTSET_FROM_ID (id
);
403 return FONTSET_NAME (fontset
);
407 /* Return ASCII font name of the fontset with ID. */
413 Lisp_Object fontset
, elt
;
414 fontset
= FONTSET_FROM_ID (id
);
415 elt
= FONTSET_ASCII (fontset
);
420 /* Free fontset of FACE. Called from free_realized_face. */
423 free_face_fontset (f
, face
)
427 if (fontset_id_valid_p (face
->fontset
))
429 AREF (Vfontset_table
, face
->fontset
) = Qnil
;
430 if (face
->fontset
< next_fontset_id
)
431 next_fontset_id
= face
->fontset
;
436 /* Return 1 iff FACE is suitable for displaying character C.
437 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
438 when C is not a single byte character.. */
441 face_suitable_for_char_p (face
, c
)
445 Lisp_Object fontset
, elt
;
447 if (SINGLE_BYTE_CHAR_P (c
))
448 return (face
== face
->ascii_face
);
450 xassert (fontset_id_valid_p (face
->fontset
));
451 fontset
= FONTSET_FROM_ID (face
->fontset
);
452 xassert (!BASE_FONTSET_P (fontset
));
454 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
455 return (!NILP (elt
) && face
->id
== XFASTINT (elt
));
459 /* Return ID of face suitable for displaying character C on frame F.
460 The selection of face is done based on the fontset of FACE. FACE
461 should already have been realized for ASCII characters. Called
462 from the macro FACE_FOR_CHAR when C is not a single byte character. */
465 face_for_char (f
, face
, c
)
470 Lisp_Object fontset
, elt
;
473 xassert (fontset_id_valid_p (face
->fontset
));
474 fontset
= FONTSET_FROM_ID (face
->fontset
);
475 xassert (!BASE_FONTSET_P (fontset
));
477 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
481 /* No face is recorded for C in the fontset of FACE. Make a new
482 realized face for C that has the same fontset. */
483 face_id
= lookup_face (f
, face
->lface
, c
, face
);
485 /* Record the face ID in FONTSET at the same index as the
486 information in the base fontset. */
487 FONTSET_SET (fontset
, c
, make_number (face_id
));
492 /* Make a realized fontset for ASCII face FACE on frame F from the
493 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
494 default fontset as the base. Value is the id of the new fontset.
495 Called from realize_x_face. */
498 make_fontset_for_ascii_face (f
, base_fontset_id
)
502 Lisp_Object base_fontset
, fontset
, frame
;
504 XSETFRAME (frame
, f
);
505 if (base_fontset_id
>= 0)
507 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
508 if (!BASE_FONTSET_P (base_fontset
))
509 base_fontset
= FONTSET_BASE (base_fontset
);
510 xassert (BASE_FONTSET_P (base_fontset
));
513 base_fontset
= Vdefault_fontset
;
515 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
516 return XINT (FONTSET_ID (fontset
));
520 /* Return the font name pattern for C that is recorded in the fontset
521 with ID. If a font name pattern is specified (instead of a cons of
522 family and registry), check if a font can be opened by that pattern
523 to get the fullname. If a font is opened, return that name.
524 Otherwise, return nil. If ID is -1, or the fontset doesn't contain
525 information about C, get the registry and encoding of C from the
526 default fontset. Called from choose_face_font. */
529 fontset_font_pattern (f
, id
, c
)
533 Lisp_Object fontset
, elt
;
534 struct font_info
*fontp
;
537 if (fontset_id_valid_p (id
))
539 fontset
= FONTSET_FROM_ID (id
);
540 xassert (!BASE_FONTSET_P (fontset
));
541 fontset
= FONTSET_BASE (fontset
);
542 elt
= FONTSET_REF (fontset
, c
);
545 elt
= FONTSET_REF (Vdefault_fontset
, c
);
549 if (CONSP (XCDR (elt
)))
552 /* The fontset specifies only a font name pattern (not cons of
553 family and registry). If a font can be opened by that pattern,
554 return the name of opened font. Otherwise return nil. The
555 exception is a font for single byte characters. In that case, we
556 return a cons of FAMILY and REGISTRY extracted from the opened
559 xassert (STRINGP (elt
));
560 fontp
= FS_LOAD_FONT (f
, c
, XSTRING (elt
)->data
, -1);
564 return font_family_registry (build_string (fontp
->full_name
),
565 SINGLE_BYTE_CHAR_P (c
));
569 #if defined(WINDOWSNT) && defined (_MSC_VER)
570 #pragma optimize("", off)
573 /* Load a font named FONTNAME to display character C on frame F.
574 Return a pointer to the struct font_info of the loaded font. If
575 loading fails, return NULL. If FACE is non-zero and a fontset is
576 assigned to it, record FACE->id in the fontset for C. If FONTNAME
577 is NULL, the name is taken from the fontset of FACE or what
581 fs_load_font (f
, c
, fontname
, id
, face
)
589 Lisp_Object list
, elt
;
591 struct font_info
*fontp
;
592 int charset
= CHAR_CHARSET (c
);
599 fontset
= FONTSET_FROM_ID (id
);
602 && !BASE_FONTSET_P (fontset
))
604 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
607 /* A suitable face for C is already recorded, which means
608 that a proper font is already loaded. */
609 int face_id
= XINT (elt
);
611 xassert (face_id
== face
->id
);
612 face
= FACE_FROM_ID (f
, face_id
);
613 return (*get_font_info_func
) (f
, face
->font_info_id
);
616 if (!fontname
&& charset
== CHARSET_ASCII
)
618 elt
= FONTSET_ASCII (fontset
);
619 fontname
= XSTRING (XCDR (elt
))->data
;
624 /* No way to get fontname. */
627 fontp
= (*load_font_func
) (f
, fontname
, size
);
631 /* Fill in members (charset, vertical_centering, encoding, etc) of
632 font_info structure that are not set by (*load_font_func). */
633 fontp
->charset
= charset
;
635 fontp
->vertical_centering
636 = (STRINGP (Vvertical_centering_font_regexp
)
637 && (fast_c_string_match_ignore_case
638 (Vvertical_centering_font_regexp
, fontp
->full_name
) >= 0));
640 if (fontp
->encoding
[1] != FONT_ENCODING_NOT_DECIDED
)
642 /* The font itself tells which code points to be used. Use this
643 encoding for all other charsets. */
646 fontp
->encoding
[0] = fontp
->encoding
[1];
647 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
648 fontp
->encoding
[i
] = fontp
->encoding
[1];
652 /* The font itself doesn't have information about encoding. */
655 fontname
= fontp
->full_name
;
656 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
657 others is 1 (i.e. 0x80..0xFF). */
658 fontp
->encoding
[0] = 0;
659 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
660 fontp
->encoding
[i
] = 1;
661 /* Then override them by a specification in Vfont_encoding_alist. */
662 for (list
= Vfont_encoding_alist
; CONSP (list
); list
= XCDR (list
))
666 && STRINGP (XCAR (elt
)) && CONSP (XCDR (elt
))
667 && (fast_c_string_match_ignore_case (XCAR (elt
), fontname
)
672 for (tmp
= XCDR (elt
); CONSP (tmp
); tmp
= XCDR (tmp
))
673 if (CONSP (XCAR (tmp
))
674 && ((i
= get_charset_id (XCAR (XCAR (tmp
))))
676 && INTEGERP (XCDR (XCAR (tmp
)))
677 && XFASTINT (XCDR (XCAR (tmp
))) < 4)
679 = XFASTINT (XCDR (XCAR (tmp
)));
684 fontp
->font_encoder
= (struct ccl_program
*) 0;
686 if (find_ccl_program_func
)
687 (*find_ccl_program_func
) (fontp
);
689 /* If we loaded a font for a face that has fontset, record the face
690 ID in the fontset for C. */
693 && !BASE_FONTSET_P (fontset
))
694 FONTSET_SET (fontset
, c
, make_number (face
->id
));
698 #if defined(WINDOWSNT) && defined (_MSC_VER)
699 #pragma optimize("", on)
703 /* Cache data used by fontset_pattern_regexp. The car part is a
704 pattern string containing at least one wild card, the cdr part is
705 the corresponding regular expression. */
706 static Lisp_Object Vcached_fontset_data
;
708 #define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
709 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
711 /* If fontset name PATTERN contains any wild card, return regular
712 expression corresponding to PATTERN. */
715 fontset_pattern_regexp (pattern
)
718 if (!index (XSTRING (pattern
)->data
, '*')
719 && !index (XSTRING (pattern
)->data
, '?'))
720 /* PATTERN does not contain any wild cards. */
723 if (!CONSP (Vcached_fontset_data
)
724 || strcmp (XSTRING (pattern
)->data
, CACHED_FONTSET_NAME
))
726 /* We must at first update the cached data. */
727 char *regex
= (char *) alloca (XSTRING (pattern
)->size
* 2 + 3);
728 char *p0
, *p1
= regex
;
730 /* Convert "*" to ".*", "?" to ".". */
732 for (p0
= (char *) XSTRING (pattern
)->data
; *p0
; p0
++)
747 Vcached_fontset_data
= Fcons (build_string (XSTRING (pattern
)->data
),
748 build_string (regex
));
751 return CACHED_FONTSET_REGEX
;
754 /* Return ID of the base fontset named NAME. If there's no such
755 fontset, return -1. */
758 fs_query_fontset (name
, regexpp
)
765 name
= Fdowncase (name
);
768 tem
= Frassoc (name
, Vfontset_alias_alist
);
769 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
773 tem
= fontset_pattern_regexp (name
);
782 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
785 unsigned char *this_name
;
787 fontset
= FONTSET_FROM_ID (i
);
789 || !BASE_FONTSET_P (fontset
))
792 this_name
= XSTRING (FONTSET_NAME (fontset
))->data
;
794 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
795 : !strcmp (XSTRING (name
)->data
, this_name
))
802 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
803 doc
: /* Return the name of a fontset that matches PATTERN.
804 The value is nil if there is no matching fontset.
805 PATTERN can contain `*' or `?' as a wildcard
806 just as X font name matching algorithm allows.
807 If REGEXPP is non-nil, PATTERN is a regular expression. */)
809 Lisp_Object pattern
, regexpp
;
814 (*check_window_system_func
) ();
816 CHECK_STRING (pattern
);
818 if (XSTRING (pattern
)->size
== 0)
821 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
825 fontset
= FONTSET_FROM_ID (id
);
826 return FONTSET_NAME (fontset
);
829 /* Return a list of base fontset names matching PATTERN on frame F.
830 If SIZE is not 0, it is the size (maximum bound width) of fontsets
834 list_fontsets (f
, pattern
, size
)
839 Lisp_Object frame
, regexp
, val
;
842 XSETFRAME (frame
, f
);
844 regexp
= fontset_pattern_regexp (pattern
);
847 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
852 fontset
= FONTSET_FROM_ID (id
);
854 || !BASE_FONTSET_P (fontset
)
855 || !EQ (frame
, FONTSET_FRAME (fontset
)))
857 name
= XSTRING (FONTSET_NAME (fontset
))->data
;
860 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
861 : strcmp (XSTRING (pattern
)->data
, name
))
866 struct font_info
*fontp
;
867 fontp
= FS_LOAD_FONT (f
, 0, NULL
, id
);
868 if (!fontp
|| size
!= fontp
->size
)
871 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
877 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
878 doc
: /* Create a new fontset NAME that contains font information in FONTLIST.
879 FONTLIST is an alist of charsets vs corresponding font name patterns. */)
881 Lisp_Object name
, fontlist
;
883 Lisp_Object fontset
, elements
, ascii_font
;
884 Lisp_Object tem
, tail
, elt
;
886 (*check_window_system_func
) ();
889 CHECK_LIST (fontlist
);
891 name
= Fdowncase (name
);
892 tem
= Fquery_fontset (name
, Qnil
);
894 error ("Fontset `%s' matches the existing fontset `%s'",
895 XSTRING (name
)->data
, XSTRING (tem
)->data
);
897 /* Check the validity of FONTLIST while creating a template for
899 elements
= ascii_font
= Qnil
;
900 for (tail
= fontlist
; CONSP (tail
); tail
= XCDR (tail
))
906 || (charset
= get_charset_id (XCAR (tem
))) < 0
907 || (!STRINGP (XCDR (tem
)) && !CONSP (XCDR (tem
))))
908 error ("Elements of fontlist must be a cons of charset and font name pattern");
912 tem
= Fdowncase (tem
);
914 tem
= Fcons (Fdowncase (Fcar (tem
)), Fdowncase (Fcdr (tem
)));
915 if (charset
== CHARSET_ASCII
)
919 c
= MAKE_CHAR (charset
, 0, 0);
920 elements
= Fcons (Fcons (make_number (c
), tem
), elements
);
924 if (NILP (ascii_font
))
925 error ("No ASCII font in the fontlist");
927 fontset
= make_fontset (Qnil
, name
, Qnil
);
928 FONTSET_ASCII (fontset
) = Fcons (make_number (0), ascii_font
);
929 for (; CONSP (elements
); elements
= XCDR (elements
))
931 elt
= XCAR (elements
);
934 tem
= font_family_registry (tem
, 0);
935 tem
= Fcons (XCAR (elt
), tem
);
936 FONTSET_SET (fontset
, XINT (XCAR (elt
)), tem
);
943 /* Clear all elements of FONTSET for multibyte characters. */
946 clear_fontset_elements (fontset
)
951 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
952 XCHAR_TABLE (fontset
)->contents
[i
] = Qnil
;
956 /* Check validity of NAME as a fontset name and return the
957 corresponding fontset. If not valid, signal an error.
958 If NAME is t, return Vdefault_fontset. */
961 check_fontset_name (name
)
967 return Vdefault_fontset
;
970 id
= fs_query_fontset (name
, 0);
972 error ("Fontset `%s' does not exist", XSTRING (name
)->data
);
973 return FONTSET_FROM_ID (id
);
976 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 4, 0,
977 doc
: /* Modify fontset NAME to use FONTNAME for CHARACTER.
979 CHARACTER may be a cons; (FROM . TO), where FROM and TO are
980 non-generic characters. In that case, use FONTNAME
981 for all characters in the range FROM and TO (inclusive).
982 CHARACTER may be a charset. In that case, use FONTNAME
983 for all character in the charsets.
985 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family
986 name of a font, REGISTRY is a registry name of a font. */)
987 (name
, character
, fontname
, frame
)
988 Lisp_Object name
, character
, fontname
, frame
;
990 Lisp_Object fontset
, elt
;
991 Lisp_Object realized
;
994 Lisp_Object family
, registry
;
996 fontset
= check_fontset_name (name
);
998 if (CONSP (character
))
1000 /* CH should be (FROM . TO) where FROM and TO are non-generic
1002 CHECK_NUMBER_CAR (character
);
1003 CHECK_NUMBER_CDR (character
);
1004 from
= XINT (XCAR (character
));
1005 to
= XINT (XCDR (character
));
1006 if (!char_valid_p (from
, 0) || !char_valid_p (to
, 0))
1007 error ("Character range should be by non-generic characters.");
1009 && (SINGLE_BYTE_CHAR_P (from
) || SINGLE_BYTE_CHAR_P (to
)))
1010 error ("Can't change font for a single byte character");
1012 else if (SYMBOLP (character
))
1014 elt
= Fget (character
, Qcharset
);
1015 if (!VECTORP (elt
) || ASIZE (elt
) < 1 || !NATNUMP (AREF (elt
, 0)))
1016 error ("Invalid charset: %s", (XSTRING (SYMBOL_NAME (character
)))->data
);
1017 from
= MAKE_CHAR (XINT (AREF (elt
, 0)), 0, 0);
1022 CHECK_NUMBER (character
);
1023 from
= XINT (character
);
1026 if (!char_valid_p (from
, 1))
1027 invalid_character (from
);
1028 if (SINGLE_BYTE_CHAR_P (from
))
1029 error ("Can't change font for a single byte character");
1032 if (!char_valid_p (to
, 1))
1033 invalid_character (to
);
1034 if (SINGLE_BYTE_CHAR_P (to
))
1035 error ("Can't change font for a single byte character");
1038 if (STRINGP (fontname
))
1040 fontname
= Fdowncase (fontname
);
1041 elt
= Fcons (make_number (from
), font_family_registry (fontname
, 0));
1045 CHECK_CONS (fontname
);
1046 family
= XCAR (fontname
);
1047 registry
= XCDR (fontname
);
1050 CHECK_STRING (family
);
1051 family
= Fdowncase (family
);
1053 if (!NILP (registry
))
1055 CHECK_STRING (registry
);
1056 registry
= Fdowncase (registry
);
1058 elt
= Fcons (make_number (from
), Fcons (family
, registry
));
1061 /* The arg FRAME is kept for backward compatibility. We only check
1064 CHECK_LIVE_FRAME (frame
);
1066 for (; from
<= to
; from
++)
1067 FONTSET_SET (fontset
, from
, elt
);
1068 Foptimize_char_table (fontset
);
1070 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1071 clear all the elements of REALIZED and free all multibyte faces
1072 whose fontset is REALIZED. This way, the specified character(s)
1073 are surely redisplayed by a correct font. */
1074 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1076 realized
= AREF (Vfontset_table
, id
);
1077 if (!NILP (realized
)
1078 && !BASE_FONTSET_P (realized
)
1079 && EQ (FONTSET_BASE (realized
), fontset
))
1081 FRAME_PTR f
= XFRAME (FONTSET_FRAME (realized
));
1082 clear_fontset_elements (realized
);
1083 free_realized_multibyte_face (f
, id
);
1090 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1091 doc
: /* Return information about a font named NAME on frame FRAME.
1092 If FRAME is omitted or nil, use the selected frame.
1093 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1094 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1096 OPENED-NAME is the name used for opening the font,
1097 FULL-NAME is the full name of the font,
1098 SIZE is the maximum bound width of the font,
1099 HEIGHT is the height of the font,
1100 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1101 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1102 how to compose characters.
1103 If the named font is not yet loaded, return nil. */)
1105 Lisp_Object name
, frame
;
1108 struct font_info
*fontp
;
1111 (*check_window_system_func
) ();
1113 CHECK_STRING (name
);
1114 name
= Fdowncase (name
);
1116 frame
= selected_frame
;
1117 CHECK_LIVE_FRAME (frame
);
1120 if (!query_font_func
)
1121 error ("Font query function is not supported");
1123 fontp
= (*query_font_func
) (f
, XSTRING (name
)->data
);
1127 info
= Fmake_vector (make_number (7), Qnil
);
1129 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1130 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1131 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1132 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1133 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1134 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1135 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1141 /* Return the font name for the character at POSITION in the current
1142 buffer. This is computed from all the text properties and overlays
1143 that apply to POSITION. It returns nil in the following cases:
1145 (1) The window system doesn't have a font for the character (thus
1146 it is displayed by an empty box).
1148 (2) The character code is invalid.
1150 (3) The current buffer is not displayed in any window.
1152 In addition, the returned font name may not take into account of
1153 such redisplay engine hooks as what used in jit-lock-mode if
1154 POSITION is currently not visible. */
1157 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1158 doc
: /* For internal use only. */)
1160 Lisp_Object position
;
1162 int pos
, pos_byte
, dummy
;
1170 CHECK_NUMBER_COERCE_MARKER (position
);
1171 pos
= XINT (position
);
1172 if (pos
< BEGV
|| pos
>= ZV
)
1173 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1174 pos_byte
= CHAR_TO_BYTE (pos
);
1175 c
= FETCH_CHAR (pos_byte
);
1176 if (! CHAR_VALID_P (c
, 0))
1178 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1181 w
= XWINDOW (window
);
1182 f
= XFRAME (w
->frame
);
1183 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1184 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
);
1185 face
= FACE_FROM_ID (f
, face_id
);
1186 return (face
->font
&& face
->font_name
1187 ? build_string (face
->font_name
)
1192 /* Called from Ffontset_info via map_char_table on each leaf of
1193 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1194 ARG)' and FONT-INFOs have this form:
1195 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1196 The current leaf is indexed by CHARACTER and has value ELT. This
1197 function add the information of the current leaf to ARG by
1198 appending a new element or modifying the last element.. */
1201 accumulate_font_info (arg
, character
, elt
)
1202 Lisp_Object arg
, character
, elt
;
1204 Lisp_Object last
, last_char
, last_elt
;
1206 if (!CONSP (elt
) && !SINGLE_BYTE_CHAR_P (XINT (character
)))
1207 elt
= FONTSET_REF (Vdefault_fontset
, XINT (character
));
1211 last_char
= XCAR (XCAR (last
));
1212 last_elt
= XCAR (XCDR (XCAR (last
)));
1214 if (!NILP (Fequal (elt
, last_elt
)))
1216 int this_charset
= CHAR_CHARSET (XINT (character
));
1218 if (CONSP (last_char
)) /* LAST_CHAR == (FROM . TO) */
1220 if (this_charset
== CHAR_CHARSET (XINT (XCAR (last_char
))))
1222 XSETCDR (last_char
, character
);
1226 else if (XINT (last_char
) == XINT (character
))
1228 else if (this_charset
== CHAR_CHARSET (XINT (last_char
)))
1230 XSETCAR (XCAR (last
), Fcons (last_char
, character
));
1234 XSETCDR (last
, Fcons (Fcons (character
, Fcons (elt
, Qnil
)), Qnil
));
1235 XSETCAR (arg
, XCDR (last
));
1239 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1240 doc
: /* Return information about a fontset named NAME on frame FRAME.
1241 The value is a vector:
1242 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],
1244 SIZE is the maximum bound width of ASCII font in the fontset,
1245 HEIGHT is the maximum bound height of ASCII font in the fontset,
1246 CHARSET-OR-RANGE is a charset, a character (may be a generic character)
1247 or a cons of two characters specifying the range of characters.
1248 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),
1249 where FAMILY is a `FAMILY' field of a XLFD font name,
1250 REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name.
1251 FAMILY may contain a `FOUNDRY' field at the head.
1252 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.
1253 OPENEDs are names of fonts actually opened.
1254 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.
1255 If FRAME is omitted, it defaults to the currently selected frame. */)
1257 Lisp_Object name
, frame
;
1259 Lisp_Object fontset
;
1261 Lisp_Object indices
[3];
1262 Lisp_Object val
, tail
, elt
;
1263 Lisp_Object
*realized
;
1264 struct font_info
*fontp
= NULL
;
1268 (*check_window_system_func
) ();
1270 fontset
= check_fontset_name (name
);
1273 frame
= selected_frame
;
1274 CHECK_LIVE_FRAME (frame
);
1277 /* Recode realized fontsets whose base is FONTSET in the table
1279 realized
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1280 * ASIZE (Vfontset_table
));
1281 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1283 elt
= FONTSET_FROM_ID (i
);
1285 && EQ (FONTSET_BASE (elt
), fontset
))
1286 realized
[n_realized
++] = elt
;
1289 /* Accumulate information of the fontset in VAL. The format is
1290 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1291 FONT-SPEC). See the comment for accumulate_font_info for the
1293 val
= Fcons (Fcons (make_number (0),
1294 Fcons (XCDR (FONTSET_ASCII (fontset
)), Qnil
)),
1296 val
= Fcons (val
, val
);
1297 map_char_table (accumulate_font_info
, Qnil
, fontset
, val
, 0, indices
);
1300 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1301 character for a charset, replace it with the charset symbol. If
1302 fonts are opened for FONT-SPEC, append the names of the fonts to
1304 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
1308 if (INTEGERP (XCAR (elt
)))
1310 int charset
, c1
, c2
;
1311 c
= XINT (XCAR (elt
));
1312 SPLIT_CHAR (c
, charset
, c1
, c2
);
1314 XSETCAR (elt
, CHARSET_SYMBOL (charset
));
1317 c
= XINT (XCAR (XCAR (elt
)));
1318 for (i
= 0; i
< n_realized
; i
++)
1320 Lisp_Object face_id
, font
;
1323 face_id
= FONTSET_REF_VIA_BASE (realized
[i
], c
);
1324 if (INTEGERP (face_id
))
1326 face
= FACE_FROM_ID (f
, XINT (face_id
));
1327 if (face
&& face
->font
&& face
->font_name
)
1329 font
= build_string (face
->font_name
);
1330 if (NILP (Fmember (font
, XCDR (XCDR (elt
)))))
1331 XSETCDR (XCDR (elt
), Fcons (font
, XCDR (XCDR (elt
))));
1337 elt
= Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII
), val
)));
1341 fontp
= (*query_font_func
) (f
, XSTRING (elt
)->data
);
1343 val
= Fmake_vector (make_number (3), val
);
1344 AREF (val
, 0) = fontp
? make_number (fontp
->size
) : make_number (0);
1345 AREF (val
, 1) = fontp
? make_number (fontp
->height
) : make_number (0);
1349 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1350 doc
: /* Return a font name pattern for character CH in fontset NAME.
1351 If NAME is t, find a font name pattern in the default fontset. */)
1353 Lisp_Object name
, ch
;
1356 Lisp_Object fontset
, elt
;
1358 fontset
= check_fontset_name (name
);
1362 if (!char_valid_p (c
, 1))
1363 invalid_character (c
);
1365 elt
= FONTSET_REF (fontset
, c
);
1372 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1373 doc
: /* Return a list of all defined fontset names. */)
1376 Lisp_Object fontset
, list
;
1380 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1382 fontset
= FONTSET_FROM_ID (i
);
1384 && BASE_FONTSET_P (fontset
))
1385 list
= Fcons (FONTSET_NAME (fontset
), list
);
1394 if (!load_font_func
)
1395 /* Window system initializer should have set proper functions. */
1398 Qfontset
= intern ("fontset");
1399 staticpro (&Qfontset
);
1400 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (3));
1402 Vcached_fontset_data
= Qnil
;
1403 staticpro (&Vcached_fontset_data
);
1405 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1406 staticpro (&Vfontset_table
);
1408 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1409 staticpro (&Vdefault_fontset
);
1410 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1411 FONTSET_NAME (Vdefault_fontset
)
1412 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1413 #if defined (MAC_OS)
1414 FONTSET_ASCII (Vdefault_fontset
)
1415 = Fcons (make_number (0),
1416 build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));
1417 #elif defined (WINDOWSNT)
1418 FONTSET_ASCII (Vdefault_fontset
)
1419 = Fcons (make_number (0),
1420 build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
1422 FONTSET_ASCII (Vdefault_fontset
)
1423 = Fcons (make_number (0),
1424 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1426 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1427 next_fontset_id
= 1;
1429 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1430 doc
: /* Alist of fontname patterns vs corresponding encoding info.
1431 Each element looks like (REGEXP . ENCODING-INFO),
1432 where ENCODING-INFO is an alist of CHARSET vs ENCODING.
1433 ENCODING is one of the following integer values:
1434 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,
1435 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,
1436 2: code points 0x20A0..0x7FFF are used,
1437 3: code points 0xA020..0xFF7F are used. */);
1438 Vfont_encoding_alist
= Qnil
;
1440 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1441 doc
: /* Char table of characters whose ascent values should be ignored.
1442 If an entry for a character is non-nil, the ascent value of the glyph
1443 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
1445 This affects how a composite character which contains
1446 such a character is displayed on screen. */);
1447 Vuse_default_ascent
= Qnil
;
1449 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1450 doc
: /* Char table of characters which is not composed relatively.
1451 If an entry for a character is non-nil, a composition sequence
1452 which contains that character is displayed so that
1453 the glyph of that character is put without considering
1454 an ascent and descent value of a previous character. */);
1455 Vignore_relative_composition
= Qnil
;
1457 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1458 doc
: /* Alist of fontname vs list of the alternate fontnames.
1459 When a specified font name is not found, the corresponding
1460 alternate fontnames (if any) are tried instead. */);
1461 Valternate_fontname_alist
= Qnil
;
1463 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1464 doc
: /* Alist of fontset names vs the aliases. */);
1465 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1466 build_string ("fontset-default")),
1469 DEFVAR_LISP ("vertical-centering-font-regexp",
1470 &Vvertical_centering_font_regexp
,
1471 doc
: /* *Regexp matching font names that require vertical centering on display.
1472 When a character is displayed with such fonts, the character is displayed
1473 at the vertical center of lines. */);
1474 Vvertical_centering_font_regexp
= Qnil
;
1476 defsubr (&Squery_fontset
);
1477 defsubr (&Snew_fontset
);
1478 defsubr (&Sset_fontset_font
);
1479 defsubr (&Sfont_info
);
1480 defsubr (&Sinternal_char_font
);
1481 defsubr (&Sfontset_info
);
1482 defsubr (&Sfontset_font
);
1483 defsubr (&Sfontset_list
);