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 const char *p
= SDATA (fontname
);
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
, SDATA (elt
), -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
= SDATA (XCDR (elt
));
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 (SDATA (XCAR (Vcached_fontset_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 (SDATA (pattern
), '*')
719 && !index (SDATA (pattern
), '?'))
720 /* PATTERN does not contain any wild cards. */
723 if (!CONSP (Vcached_fontset_data
)
724 || strcmp (SDATA (pattern
), CACHED_FONTSET_NAME
))
726 /* We must at first update the cached data. */
727 char *regex
= (char *) alloca (SCHARS (pattern
) * 2 + 3);
728 char *p0
, *p1
= regex
;
730 /* Convert "*" to ".*", "?" to ".". */
732 for (p0
= (char *) SDATA (pattern
); *p0
; p0
++)
747 Vcached_fontset_data
= Fcons (build_string (SDATA (pattern
)),
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 const unsigned char *this_name
;
787 fontset
= FONTSET_FROM_ID (i
);
789 || !BASE_FONTSET_P (fontset
))
792 this_name
= SDATA (FONTSET_NAME (fontset
));
794 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
795 : !strcmp (SDATA (name
), 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 (SCHARS (pattern
) == 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
++)
850 const unsigned char *name
;
852 fontset
= FONTSET_FROM_ID (id
);
854 || !BASE_FONTSET_P (fontset
)
855 || !EQ (frame
, FONTSET_FRAME (fontset
)))
857 name
= SDATA (FONTSET_NAME (fontset
));
860 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
861 : strcmp (SDATA (pattern
), 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 SDATA (name
), SDATA (tem
));
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 nil, 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", SDATA (name
));
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 If NAME is nil, modify the default fontset.
980 CHARACTER may be a cons; (FROM . TO), where FROM and TO are
981 non-generic characters. In that case, use FONTNAME
982 for all characters in the range FROM and TO (inclusive).
983 CHARACTER may be a charset. In that case, use FONTNAME
984 for all character in the charsets.
986 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family
987 name of a font, REGISTRY is a registry name of a font. */)
988 (name
, character
, fontname
, frame
)
989 Lisp_Object name
, character
, fontname
, frame
;
991 Lisp_Object fontset
, elt
;
992 Lisp_Object realized
;
995 Lisp_Object family
, registry
;
997 fontset
= check_fontset_name (name
);
999 if (CONSP (character
))
1001 /* CH should be (FROM . TO) where FROM and TO are non-generic
1003 CHECK_NUMBER_CAR (character
);
1004 CHECK_NUMBER_CDR (character
);
1005 from
= XINT (XCAR (character
));
1006 to
= XINT (XCDR (character
));
1007 if (!char_valid_p (from
, 0) || !char_valid_p (to
, 0))
1008 error ("Character range should be by non-generic characters.");
1010 && (SINGLE_BYTE_CHAR_P (from
) || SINGLE_BYTE_CHAR_P (to
)))
1011 error ("Can't change font for a single byte character");
1013 else if (SYMBOLP (character
))
1015 elt
= Fget (character
, Qcharset
);
1016 if (!VECTORP (elt
) || ASIZE (elt
) < 1 || !NATNUMP (AREF (elt
, 0)))
1017 error ("Invalid charset: %s", SDATA (SYMBOL_NAME (character
)));
1018 from
= MAKE_CHAR (XINT (AREF (elt
, 0)), 0, 0);
1023 CHECK_NUMBER (character
);
1024 from
= XINT (character
);
1027 if (!char_valid_p (from
, 1))
1028 invalid_character (from
);
1029 if (SINGLE_BYTE_CHAR_P (from
))
1030 error ("Can't change font for a single byte character");
1033 if (!char_valid_p (to
, 1))
1034 invalid_character (to
);
1035 if (SINGLE_BYTE_CHAR_P (to
))
1036 error ("Can't change font for a single byte character");
1039 if (STRINGP (fontname
))
1041 fontname
= Fdowncase (fontname
);
1042 elt
= Fcons (make_number (from
), font_family_registry (fontname
, 0));
1046 CHECK_CONS (fontname
);
1047 family
= XCAR (fontname
);
1048 registry
= XCDR (fontname
);
1051 CHECK_STRING (family
);
1052 family
= Fdowncase (family
);
1054 if (!NILP (registry
))
1056 CHECK_STRING (registry
);
1057 registry
= Fdowncase (registry
);
1059 elt
= Fcons (make_number (from
), Fcons (family
, registry
));
1062 /* The arg FRAME is kept for backward compatibility. We only check
1065 CHECK_LIVE_FRAME (frame
);
1067 for (; from
<= to
; from
++)
1068 FONTSET_SET (fontset
, from
, elt
);
1069 Foptimize_char_table (fontset
);
1071 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1072 clear all the elements of REALIZED and free all multibyte faces
1073 whose fontset is REALIZED. This way, the specified character(s)
1074 are surely redisplayed by a correct font. */
1075 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1077 realized
= AREF (Vfontset_table
, id
);
1078 if (!NILP (realized
)
1079 && !BASE_FONTSET_P (realized
)
1080 && EQ (FONTSET_BASE (realized
), fontset
))
1082 FRAME_PTR f
= XFRAME (FONTSET_FRAME (realized
));
1083 clear_fontset_elements (realized
);
1084 free_realized_multibyte_face (f
, id
);
1091 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1092 doc
: /* Return information about a font named NAME on frame FRAME.
1093 If FRAME is omitted or nil, use the selected frame.
1094 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1095 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1097 OPENED-NAME is the name used for opening the font,
1098 FULL-NAME is the full name of the font,
1099 SIZE is the maximum bound width of the font,
1100 HEIGHT is the height of the font,
1101 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1102 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1103 how to compose characters.
1104 If the named font is not yet loaded, return nil. */)
1106 Lisp_Object name
, frame
;
1109 struct font_info
*fontp
;
1112 (*check_window_system_func
) ();
1114 CHECK_STRING (name
);
1115 name
= Fdowncase (name
);
1117 frame
= selected_frame
;
1118 CHECK_LIVE_FRAME (frame
);
1121 if (!query_font_func
)
1122 error ("Font query function is not supported");
1124 fontp
= (*query_font_func
) (f
, SDATA (name
));
1128 info
= Fmake_vector (make_number (7), Qnil
);
1130 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1131 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1132 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1133 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1134 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1135 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1136 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1142 /* Return the font name for the character at POSITION in the current
1143 buffer. This is computed from all the text properties and overlays
1144 that apply to POSITION. It returns nil in the following cases:
1146 (1) The window system doesn't have a font for the character (thus
1147 it is displayed by an empty box).
1149 (2) The character code is invalid.
1151 (3) The current buffer is not displayed in any window.
1153 In addition, the returned font name may not take into account of
1154 such redisplay engine hooks as what used in jit-lock-mode if
1155 POSITION is currently not visible. */
1158 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1159 doc
: /* For internal use only. */)
1161 Lisp_Object position
;
1163 int pos
, pos_byte
, dummy
;
1171 CHECK_NUMBER_COERCE_MARKER (position
);
1172 pos
= XINT (position
);
1173 if (pos
< BEGV
|| pos
>= ZV
)
1174 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1175 pos_byte
= CHAR_TO_BYTE (pos
);
1176 c
= FETCH_CHAR (pos_byte
);
1177 if (! CHAR_VALID_P (c
, 0))
1179 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1182 w
= XWINDOW (window
);
1183 f
= XFRAME (w
->frame
);
1184 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1185 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
);
1186 face
= FACE_FROM_ID (f
, face_id
);
1187 return (face
->font
&& face
->font_name
1188 ? build_string (face
->font_name
)
1193 /* Called from Ffontset_info via map_char_table on each leaf of
1194 fontset. ARG is a copy of the default fontset. The current leaf
1195 is indexed by CHARACTER and has value ELT. This function override
1196 the copy by ELT if ELT is not nil. */
1199 override_font_info (fontset
, character
, elt
)
1200 Lisp_Object fontset
, character
, elt
;
1203 Faset (fontset
, character
, elt
);
1206 /* Called from Ffontset_info via map_char_table on each leaf of
1207 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1208 ARG)' and FONT-INFOs have this form:
1209 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1210 The current leaf is indexed by CHARACTER and has value ELT. This
1211 function add the information of the current leaf to ARG by
1212 appending a new element or modifying the last element. */
1215 accumulate_font_info (arg
, character
, elt
)
1216 Lisp_Object arg
, character
, elt
;
1218 Lisp_Object last
, last_char
, last_elt
;
1220 if (!CONSP (elt
) && !SINGLE_BYTE_CHAR_P (XINT (character
)))
1221 elt
= FONTSET_REF (Vdefault_fontset
, XINT (character
));
1225 last_char
= XCAR (XCAR (last
));
1226 last_elt
= XCAR (XCDR (XCAR (last
)));
1228 if (!NILP (Fequal (elt
, last_elt
)))
1230 int this_charset
= CHAR_CHARSET (XINT (character
));
1232 if (CONSP (last_char
)) /* LAST_CHAR == (FROM . TO) */
1234 if (this_charset
== CHAR_CHARSET (XINT (XCAR (last_char
))))
1236 XSETCDR (last_char
, character
);
1240 else if (XINT (last_char
) == XINT (character
))
1242 else if (this_charset
== CHAR_CHARSET (XINT (last_char
)))
1244 XSETCAR (XCAR (last
), Fcons (last_char
, character
));
1248 XSETCDR (last
, Fcons (Fcons (character
, Fcons (elt
, Qnil
)), Qnil
));
1249 XSETCAR (arg
, XCDR (last
));
1253 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1254 doc
: /* Return information about a fontset named NAME on frame FRAME.
1255 If NAME is nil, return information about the default fontset.
1256 The value is a vector:
1257 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],
1259 SIZE is the maximum bound width of ASCII font in the fontset,
1260 HEIGHT is the maximum bound height of ASCII font in the fontset,
1261 CHARSET-OR-RANGE is a charset, a character (may be a generic character)
1262 or a cons of two characters specifying the range of characters.
1263 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),
1264 where FAMILY is a `FAMILY' field of a XLFD font name,
1265 REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name.
1266 FAMILY may contain a `FOUNDRY' field at the head.
1267 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.
1268 OPENEDs are names of fonts actually opened.
1269 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.
1270 If FRAME is omitted, it defaults to the currently selected frame. */)
1272 Lisp_Object name
, frame
;
1274 Lisp_Object fontset
;
1276 Lisp_Object indices
[3];
1277 Lisp_Object val
, tail
, elt
;
1278 Lisp_Object
*realized
;
1279 struct font_info
*fontp
= NULL
;
1283 (*check_window_system_func
) ();
1285 fontset
= check_fontset_name (name
);
1288 frame
= selected_frame
;
1289 CHECK_LIVE_FRAME (frame
);
1292 /* Recode realized fontsets whose base is FONTSET in the table
1294 realized
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1295 * ASIZE (Vfontset_table
));
1296 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1298 elt
= FONTSET_FROM_ID (i
);
1300 && EQ (FONTSET_BASE (elt
), fontset
))
1301 realized
[n_realized
++] = elt
;
1304 if (! EQ (fontset
, Vdefault_fontset
))
1306 /* Merge FONTSET onto the default fontset. */
1307 val
= Fcopy_sequence (Vdefault_fontset
);
1308 map_char_table (override_font_info
, Qnil
, fontset
, val
, 0, indices
);
1312 /* Accumulate information of the fontset in VAL. The format is
1313 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1314 FONT-SPEC). See the comment for accumulate_font_info for the
1316 val
= Fcons (Fcons (make_number (0),
1317 Fcons (XCDR (FONTSET_ASCII (fontset
)), Qnil
)),
1319 val
= Fcons (val
, val
);
1320 map_char_table (accumulate_font_info
, Qnil
, fontset
, val
, 0, indices
);
1323 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1324 character for a charset, replace it with the charset symbol. If
1325 fonts are opened for FONT-SPEC, append the names of the fonts to
1327 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
1331 if (INTEGERP (XCAR (elt
)))
1333 int charset
, c1
, c2
;
1334 c
= XINT (XCAR (elt
));
1335 SPLIT_CHAR (c
, charset
, c1
, c2
);
1337 XSETCAR (elt
, CHARSET_SYMBOL (charset
));
1340 c
= XINT (XCAR (XCAR (elt
)));
1341 for (i
= 0; i
< n_realized
; i
++)
1343 Lisp_Object face_id
, font
;
1346 face_id
= FONTSET_REF_VIA_BASE (realized
[i
], c
);
1347 if (INTEGERP (face_id
))
1349 face
= FACE_FROM_ID (f
, XINT (face_id
));
1350 if (face
&& face
->font
&& face
->font_name
)
1352 font
= build_string (face
->font_name
);
1353 if (NILP (Fmember (font
, XCDR (XCDR (elt
)))))
1354 XSETCDR (XCDR (elt
), Fcons (font
, XCDR (XCDR (elt
))));
1360 elt
= Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII
), val
)));
1364 fontp
= (*query_font_func
) (f
, SDATA (elt
));
1366 val
= Fmake_vector (make_number (3), val
);
1367 AREF (val
, 0) = fontp
? make_number (fontp
->size
) : make_number (0);
1368 AREF (val
, 1) = fontp
? make_number (fontp
->height
) : make_number (0);
1372 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1373 doc
: /* Return a font name pattern for character CH in fontset NAME.
1374 If NAME is nil, find a font name pattern in the default fontset. */)
1376 Lisp_Object name
, ch
;
1379 Lisp_Object fontset
, elt
;
1381 fontset
= check_fontset_name (name
);
1385 if (!char_valid_p (c
, 1))
1386 invalid_character (c
);
1388 elt
= FONTSET_REF (fontset
, c
);
1395 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1396 doc
: /* Return a list of all defined fontset names. */)
1399 Lisp_Object fontset
, list
;
1403 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1405 fontset
= FONTSET_FROM_ID (i
);
1407 && BASE_FONTSET_P (fontset
))
1408 list
= Fcons (FONTSET_NAME (fontset
), list
);
1417 if (!load_font_func
)
1418 /* Window system initializer should have set proper functions. */
1421 Qfontset
= intern ("fontset");
1422 staticpro (&Qfontset
);
1423 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (3));
1425 Vcached_fontset_data
= Qnil
;
1426 staticpro (&Vcached_fontset_data
);
1428 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1429 staticpro (&Vfontset_table
);
1431 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1432 staticpro (&Vdefault_fontset
);
1433 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1434 FONTSET_NAME (Vdefault_fontset
)
1435 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1436 #if defined (MAC_OS)
1437 FONTSET_ASCII (Vdefault_fontset
)
1438 = Fcons (make_number (0),
1439 build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));
1440 #elif defined (WINDOWSNT)
1441 FONTSET_ASCII (Vdefault_fontset
)
1442 = Fcons (make_number (0),
1443 build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
1445 FONTSET_ASCII (Vdefault_fontset
)
1446 = Fcons (make_number (0),
1447 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1449 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1450 next_fontset_id
= 1;
1452 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1453 doc
: /* Alist of fontname patterns vs corresponding encoding info.
1454 Each element looks like (REGEXP . ENCODING-INFO),
1455 where ENCODING-INFO is an alist of CHARSET vs ENCODING.
1456 ENCODING is one of the following integer values:
1457 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,
1458 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,
1459 2: code points 0x20A0..0x7FFF are used,
1460 3: code points 0xA020..0xFF7F are used. */);
1461 Vfont_encoding_alist
= Qnil
;
1462 Vfont_encoding_alist
1463 = Fcons (Fcons (build_string ("JISX0201"),
1464 Fcons (Fcons (intern ("latin-jisx0201"), make_number (0)),
1466 Vfont_encoding_alist
);
1467 Vfont_encoding_alist
1468 = Fcons (Fcons (build_string ("ISO8859-1"),
1469 Fcons (Fcons (intern ("ascii"), make_number (0)),
1471 Vfont_encoding_alist
);
1473 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1474 doc
: /* Char table of characters whose ascent values should be ignored.
1475 If an entry for a character is non-nil, the ascent value of the glyph
1476 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
1478 This affects how a composite character which contains
1479 such a character is displayed on screen. */);
1480 Vuse_default_ascent
= Qnil
;
1482 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1483 doc
: /* Char table of characters which is not composed relatively.
1484 If an entry for a character is non-nil, a composition sequence
1485 which contains that character is displayed so that
1486 the glyph of that character is put without considering
1487 an ascent and descent value of a previous character. */);
1488 Vignore_relative_composition
= Qnil
;
1490 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1491 doc
: /* Alist of fontname vs list of the alternate fontnames.
1492 When a specified font name is not found, the corresponding
1493 alternate fontnames (if any) are tried instead. */);
1494 Valternate_fontname_alist
= Qnil
;
1496 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1497 doc
: /* Alist of fontset names vs the aliases. */);
1498 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1499 build_string ("fontset-default")),
1502 DEFVAR_LISP ("vertical-centering-font-regexp",
1503 &Vvertical_centering_font_regexp
,
1504 doc
: /* *Regexp matching font names that require vertical centering on display.
1505 When a character is displayed with such fonts, the character is displayed
1506 at the vertical center of lines. */);
1507 Vvertical_centering_font_regexp
= Qnil
;
1509 defsubr (&Squery_fontset
);
1510 defsubr (&Snew_fontset
);
1511 defsubr (&Sset_fontset_font
);
1512 defsubr (&Sfont_info
);
1513 defsubr (&Sinternal_char_font
);
1514 defsubr (&Sfontset_info
);
1515 defsubr (&Sfontset_font
);
1516 defsubr (&Sfontset_list
);