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"
51 #define xassert(X) do {if (!(X)) abort ();} while (0)
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:
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
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
99 The 3rd slot is a frame that the fontset belongs to. This is nil
102 A parent of a base fontset is nil. A parent of a realized fontset
105 All fontsets are recorded in Vfontset_table.
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 Lisp_Object Vfont_encoding_alist
;
144 Lisp_Object Vuse_default_ascent
;
145 Lisp_Object Vignore_relative_composition
;
146 Lisp_Object Valternate_fontname_alist
;
147 Lisp_Object Vfontset_alias_alist
;
148 Lisp_Object Vvertical_centering_font_regexp
;
150 /* The following six are declarations of callback functions depending
151 on window system. See the comments in src/fontset.h for more
154 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
155 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
157 /* Return a list of font names which matches PATTERN. See the documentation
158 of `x-list-fonts' for more details. */
159 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
164 /* Load a font named NAME for frame F and return a pointer to the
165 information of the loaded font. If loading is failed, return 0. */
166 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
168 /* Return a pointer to struct font_info of a font named NAME for frame F. */
169 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
171 /* Additional function for setting fontset or changing fontset
172 contents of frame F. */
173 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
174 Lisp_Object oldval
));
176 /* To find a CCL program, fs_load_font calls this function.
177 The argument is a pointer to the struct font_info.
178 This function set the member `encoder' of the structure. */
179 void (*find_ccl_program_func
) P_ ((struct font_info
*));
181 /* Check if any window system is used now. */
182 void (*check_window_system_func
) P_ ((void));
185 /* Prototype declarations for static functions. */
186 static Lisp_Object fontset_ref
P_ ((Lisp_Object
, int));
187 static void fontset_set
P_ ((Lisp_Object
, int, Lisp_Object
));
188 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
189 static int fontset_id_valid_p
P_ ((int));
190 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
191 static Lisp_Object font_family_registry
P_ ((Lisp_Object
, int));
194 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
196 /* Return the fontset with ID. No check of ID's validness. */
197 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
199 /* Macros to access special values of FONTSET. */
200 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
201 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
202 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
203 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0]
204 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
206 #define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
209 /* Return the element of FONTSET (char-table) at index C (character). */
211 #define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
214 fontset_ref (fontset
, c
)
219 Lisp_Object elt
, defalt
;
221 if (SINGLE_BYTE_CHAR_P (c
))
222 return FONTSET_ASCII (fontset
);
224 SPLIT_CHAR (c
, charset
, c1
, c2
);
225 elt
= XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
226 if (!SUB_CHAR_TABLE_P (elt
))
228 defalt
= XCHAR_TABLE (elt
)->defalt
;
230 || (elt
= XCHAR_TABLE (elt
)->contents
[c1
],
233 if (!SUB_CHAR_TABLE_P (elt
))
235 defalt
= XCHAR_TABLE (elt
)->defalt
;
237 || (elt
= XCHAR_TABLE (elt
)->contents
[c2
],
244 #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
247 fontset_ref_via_base (fontset
, c
)
254 if (SINGLE_BYTE_CHAR_P (*c
))
255 return FONTSET_ASCII (fontset
);
257 elt
= FONTSET_REF (FONTSET_BASE (fontset
), *c
);
258 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
))
259 elt
= FONTSET_REF (Vdefault_fontset
, *c
);
263 *c
= XINT (XCAR (elt
));
264 SPLIT_CHAR (*c
, charset
, c1
, c2
);
265 elt
= XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
267 return (SUB_CHAR_TABLE_P (elt
) ? XCHAR_TABLE (elt
)->defalt
: elt
);
268 if (!SUB_CHAR_TABLE_P (elt
))
270 elt
= XCHAR_TABLE (elt
)->contents
[c1
];
272 return (SUB_CHAR_TABLE_P (elt
) ? XCHAR_TABLE (elt
)->defalt
: elt
);
273 if (!SUB_CHAR_TABLE_P (elt
))
275 elt
= XCHAR_TABLE (elt
)->contents
[c2
];
280 /* Store into the element of FONTSET at index C the value NEWELT. */
281 #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
284 fontset_set (fontset
, c
, newelt
)
289 int charset
, code
[3];
293 if (SINGLE_BYTE_CHAR_P (c
))
295 FONTSET_ASCII (fontset
) = newelt
;
299 SPLIT_CHAR (c
, charset
, code
[0], code
[1]);
300 code
[2] = 0; /* anchor */
301 elt
= &XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
302 for (i
= 0; code
[i
] > 0; i
++)
304 if (!SUB_CHAR_TABLE_P (*elt
))
305 *elt
= make_sub_char_table (*elt
);
306 elt
= &XCHAR_TABLE (*elt
)->contents
[code
[i
]];
308 if (SUB_CHAR_TABLE_P (*elt
))
309 XCHAR_TABLE (*elt
)->defalt
= newelt
;
315 /* Return a newly created fontset with NAME. If BASE is nil, make a
316 base fontset. Otherwise make a realized fontset whose parent is
320 make_fontset (frame
, name
, base
)
321 Lisp_Object frame
, name
, base
;
324 int size
= ASIZE (Vfontset_table
);
325 int id
= next_fontset_id
;
327 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
328 the next available fontset ID. So it is expected that this loop
329 terminates quickly. In addition, as the last element of
330 Vfontset_table is always nil, we don't have to check the range of
332 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
339 tem
= Fmake_vector (make_number (size
+ 8), Qnil
);
340 for (i
= 0; i
< size
; i
++)
341 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
342 Vfontset_table
= tem
;
345 fontset
= Fmake_char_table (Qfontset
, Qnil
);
347 FONTSET_ID (fontset
) = make_number (id
);
348 FONTSET_NAME (fontset
) = name
;
349 FONTSET_FRAME (fontset
) = frame
;
350 FONTSET_BASE (fontset
) = base
;
352 AREF (Vfontset_table
, id
) = fontset
;
353 next_fontset_id
= id
+ 1;
358 /* Return 1 if ID is a valid fontset id, else return 0. */
361 fontset_id_valid_p (id
)
364 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
368 /* Extract `family' and `registry' string from FONTNAME and a cons of
369 them. Actually, `family' may also contain `foundry', `registry'
370 may also contain `encoding' of FONTNAME. But, if FONTNAME doesn't
371 conform to XLFD nor explicitely specifies the other fields
372 (i.e. not using wildcard `*'), return FONTNAME. If FORCE is
373 nonzero, specifications of the other fields are ignored, and return
374 a cons as far as FONTNAME conform to XLFD. */
377 font_family_registry (fontname
, force
)
378 Lisp_Object fontname
;
381 Lisp_Object family
, registry
;
382 const char *p
= SDATA (fontname
);
389 if (!force
&& i
>= 2 && i
<= 11 && *p
!= '*' && p
[1] != '-')
396 family
= make_unibyte_string (sep
[0], sep
[2] - 1 - sep
[0]);
397 registry
= make_unibyte_string (sep
[12], p
- sep
[12]);
398 return Fcons (family
, registry
);
402 /********** INTERFACES TO xfaces.c and dispextern.h **********/
404 /* Return name of the fontset with ID. */
411 fontset
= FONTSET_FROM_ID (id
);
412 return FONTSET_NAME (fontset
);
416 /* Return ASCII font name of the fontset with ID. */
422 Lisp_Object fontset
, elt
;
423 fontset
= FONTSET_FROM_ID (id
);
424 elt
= FONTSET_ASCII (fontset
);
429 /* Free fontset of FACE. Called from free_realized_face. */
432 free_face_fontset (f
, face
)
436 if (fontset_id_valid_p (face
->fontset
))
438 AREF (Vfontset_table
, face
->fontset
) = Qnil
;
439 if (face
->fontset
< next_fontset_id
)
440 next_fontset_id
= face
->fontset
;
445 /* Return 1 iff FACE is suitable for displaying character C.
446 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
447 when C is not a single byte character.. */
450 face_suitable_for_char_p (face
, c
)
454 Lisp_Object fontset
, elt
;
456 if (SINGLE_BYTE_CHAR_P (c
))
457 return (face
== face
->ascii_face
);
459 xassert (fontset_id_valid_p (face
->fontset
));
460 fontset
= FONTSET_FROM_ID (face
->fontset
);
461 xassert (!BASE_FONTSET_P (fontset
));
463 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
464 return (!NILP (elt
) && face
->id
== XFASTINT (elt
));
468 /* Return ID of face suitable for displaying character C on frame F.
469 The selection of face is done based on the fontset of FACE. FACE
470 should already have been realized for ASCII characters. Called
471 from the macro FACE_FOR_CHAR when C is not a single byte character. */
474 face_for_char (f
, face
, c
)
479 Lisp_Object fontset
, elt
;
482 xassert (fontset_id_valid_p (face
->fontset
));
483 fontset
= FONTSET_FROM_ID (face
->fontset
);
484 xassert (!BASE_FONTSET_P (fontset
));
486 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
490 /* No face is recorded for C in the fontset of FACE. Make a new
491 realized face for C that has the same fontset. */
492 face_id
= lookup_face (f
, face
->lface
, c
, face
);
494 /* Record the face ID in FONTSET at the same index as the
495 information in the base fontset. */
496 FONTSET_SET (fontset
, c
, make_number (face_id
));
501 /* Make a realized fontset for ASCII face FACE on frame F from the
502 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
503 default fontset as the base. Value is the id of the new fontset.
504 Called from realize_x_face. */
507 make_fontset_for_ascii_face (f
, base_fontset_id
)
511 Lisp_Object base_fontset
, fontset
, frame
;
513 XSETFRAME (frame
, f
);
514 if (base_fontset_id
>= 0)
516 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
517 if (!BASE_FONTSET_P (base_fontset
))
518 base_fontset
= FONTSET_BASE (base_fontset
);
519 xassert (BASE_FONTSET_P (base_fontset
));
522 base_fontset
= Vdefault_fontset
;
524 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
525 return XINT (FONTSET_ID (fontset
));
529 /* Return the font name pattern for C that is recorded in the fontset
530 with ID. If a font name pattern is specified (instead of a cons of
531 family and registry), check if a font can be opened by that pattern
532 to get the fullname. If a font is opened, return that name.
533 Otherwise, return nil. If ID is -1, or the fontset doesn't contain
534 information about C, get the registry and encoding of C from the
535 default fontset. Called from choose_face_font. */
538 fontset_font_pattern (f
, id
, c
)
542 Lisp_Object fontset
, elt
;
543 struct font_info
*fontp
;
546 if (fontset_id_valid_p (id
))
548 fontset
= FONTSET_FROM_ID (id
);
549 xassert (!BASE_FONTSET_P (fontset
));
550 fontset
= FONTSET_BASE (fontset
);
551 elt
= FONTSET_REF (fontset
, c
);
554 elt
= FONTSET_REF (Vdefault_fontset
, c
);
558 if (CONSP (XCDR (elt
)))
561 /* The fontset specifies only a font name pattern (not cons of
562 family and registry). If a font can be opened by that pattern,
563 return the name of opened font. Otherwise return nil. The
564 exception is a font for single byte characters. In that case, we
565 return a cons of FAMILY and REGISTRY extracted from the opened
568 xassert (STRINGP (elt
));
569 fontp
= FS_LOAD_FONT (f
, c
, SDATA (elt
), -1);
573 return font_family_registry (build_string (fontp
->full_name
),
574 SINGLE_BYTE_CHAR_P (c
));
578 #if defined(WINDOWSNT) && defined (_MSC_VER)
579 #pragma optimize("", off)
582 /* Load a font named FONTNAME to display character C on frame F.
583 Return a pointer to the struct font_info of the loaded font. If
584 loading fails, return NULL. If FACE is non-zero and a fontset is
585 assigned to it, record FACE->id in the fontset for C. If FONTNAME
586 is NULL, the name is taken from the fontset of FACE or what
590 fs_load_font (f
, c
, fontname
, id
, face
)
598 Lisp_Object list
, elt
;
600 struct font_info
*fontp
;
601 int charset
= CHAR_CHARSET (c
);
608 fontset
= FONTSET_FROM_ID (id
);
611 && !BASE_FONTSET_P (fontset
))
613 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
616 /* A suitable face for C is already recorded, which means
617 that a proper font is already loaded. */
618 int face_id
= XINT (elt
);
620 xassert (face_id
== face
->id
);
621 face
= FACE_FROM_ID (f
, face_id
);
622 return (*get_font_info_func
) (f
, face
->font_info_id
);
625 if (!fontname
&& charset
== CHARSET_ASCII
)
627 elt
= FONTSET_ASCII (fontset
);
628 fontname
= SDATA (XCDR (elt
));
633 /* No way to get fontname. */
636 fontp
= (*load_font_func
) (f
, fontname
, size
);
640 /* Fill in members (charset, vertical_centering, encoding, etc) of
641 font_info structure that are not set by (*load_font_func). */
642 fontp
->charset
= charset
;
644 fontp
->vertical_centering
645 = (STRINGP (Vvertical_centering_font_regexp
)
646 && (fast_c_string_match_ignore_case
647 (Vvertical_centering_font_regexp
, fontp
->full_name
) >= 0));
649 if (fontp
->encoding
[1] != FONT_ENCODING_NOT_DECIDED
)
651 /* The font itself tells which code points to be used. Use this
652 encoding for all other charsets. */
655 fontp
->encoding
[0] = fontp
->encoding
[1];
656 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
657 fontp
->encoding
[i
] = fontp
->encoding
[1];
661 /* The font itself doesn't have information about encoding. */
664 fontname
= fontp
->full_name
;
665 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
666 others is 1 (i.e. 0x80..0xFF). */
667 fontp
->encoding
[0] = 0;
668 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
669 fontp
->encoding
[i
] = 1;
670 /* Then override them by a specification in Vfont_encoding_alist. */
671 for (list
= Vfont_encoding_alist
; CONSP (list
); list
= XCDR (list
))
675 && STRINGP (XCAR (elt
)) && CONSP (XCDR (elt
))
676 && (fast_c_string_match_ignore_case (XCAR (elt
), fontname
)
681 for (tmp
= XCDR (elt
); CONSP (tmp
); tmp
= XCDR (tmp
))
682 if (CONSP (XCAR (tmp
))
683 && ((i
= get_charset_id (XCAR (XCAR (tmp
))))
685 && INTEGERP (XCDR (XCAR (tmp
)))
686 && XFASTINT (XCDR (XCAR (tmp
))) < 4)
688 = XFASTINT (XCDR (XCAR (tmp
)));
693 if (! fontp
->font_encoder
&& find_ccl_program_func
)
694 (*find_ccl_program_func
) (fontp
);
696 /* If we loaded a font for a face that has fontset, record the face
697 ID in the fontset for C. */
700 && !BASE_FONTSET_P (fontset
))
701 FONTSET_SET (fontset
, c
, make_number (face
->id
));
705 #if defined(WINDOWSNT) && defined (_MSC_VER)
706 #pragma optimize("", on)
710 /* Cache data used by fontset_pattern_regexp. The car part is a
711 pattern string containing at least one wild card, the cdr part is
712 the corresponding regular expression. */
713 static Lisp_Object Vcached_fontset_data
;
715 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
716 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
718 /* If fontset name PATTERN contains any wild card, return regular
719 expression corresponding to PATTERN. */
722 fontset_pattern_regexp (pattern
)
725 if (!index (SDATA (pattern
), '*')
726 && !index (SDATA (pattern
), '?'))
727 /* PATTERN does not contain any wild cards. */
730 if (!CONSP (Vcached_fontset_data
)
731 || strcmp (SDATA (pattern
), CACHED_FONTSET_NAME
))
733 /* We must at first update the cached data. */
734 char *regex
= (char *) alloca (SCHARS (pattern
) * 2 + 3);
735 char *p0
, *p1
= regex
;
737 /* Convert "*" to ".*", "?" to ".". */
739 for (p0
= (char *) SDATA (pattern
); *p0
; p0
++)
754 Vcached_fontset_data
= Fcons (build_string (SDATA (pattern
)),
755 build_string (regex
));
758 return CACHED_FONTSET_REGEX
;
761 /* Return ID of the base fontset named NAME. If there's no such
762 fontset, return -1. */
765 fs_query_fontset (name
, regexpp
)
772 name
= Fdowncase (name
);
775 tem
= Frassoc (name
, Vfontset_alias_alist
);
776 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
780 tem
= fontset_pattern_regexp (name
);
789 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
792 const unsigned char *this_name
;
794 fontset
= FONTSET_FROM_ID (i
);
796 || !BASE_FONTSET_P (fontset
))
799 this_name
= SDATA (FONTSET_NAME (fontset
));
801 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
802 : !strcmp (SDATA (name
), this_name
))
809 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
810 doc
: /* Return the name of a fontset that matches PATTERN.
811 The value is nil if there is no matching fontset.
812 PATTERN can contain `*' or `?' as a wildcard
813 just as X font name matching algorithm allows.
814 If REGEXPP is non-nil, PATTERN is a regular expression. */)
816 Lisp_Object pattern
, regexpp
;
821 (*check_window_system_func
) ();
823 CHECK_STRING (pattern
);
825 if (SCHARS (pattern
) == 0)
828 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
832 fontset
= FONTSET_FROM_ID (id
);
833 return FONTSET_NAME (fontset
);
836 /* Return a list of base fontset names matching PATTERN on frame F.
837 If SIZE is not 0, it is the size (maximum bound width) of fontsets
841 list_fontsets (f
, pattern
, size
)
846 Lisp_Object frame
, regexp
, val
;
849 XSETFRAME (frame
, f
);
851 regexp
= fontset_pattern_regexp (pattern
);
854 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
857 const unsigned char *name
;
859 fontset
= FONTSET_FROM_ID (id
);
861 || !BASE_FONTSET_P (fontset
)
862 || !EQ (frame
, FONTSET_FRAME (fontset
)))
864 name
= SDATA (FONTSET_NAME (fontset
));
867 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
868 : strcmp (SDATA (pattern
), name
))
873 struct font_info
*fontp
;
874 fontp
= FS_LOAD_FONT (f
, 0, NULL
, id
);
875 if (!fontp
|| size
!= fontp
->size
)
878 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
884 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
885 doc
: /* Create a new fontset NAME that contains font information in FONTLIST.
886 FONTLIST is an alist of charsets vs corresponding font name patterns. */)
888 Lisp_Object name
, fontlist
;
890 Lisp_Object fontset
, elements
, ascii_font
;
891 Lisp_Object tem
, tail
, elt
;
893 (*check_window_system_func
) ();
896 CHECK_LIST (fontlist
);
898 name
= Fdowncase (name
);
899 tem
= Fquery_fontset (name
, Qnil
);
901 error ("Fontset `%s' matches the existing fontset `%s'",
902 SDATA (name
), SDATA (tem
));
904 /* Check the validity of FONTLIST while creating a template for
906 elements
= ascii_font
= Qnil
;
907 for (tail
= fontlist
; CONSP (tail
); tail
= XCDR (tail
))
913 || (charset
= get_charset_id (XCAR (tem
))) < 0
914 || (!STRINGP (XCDR (tem
)) && !CONSP (XCDR (tem
))))
915 error ("Elements of fontlist must be a cons of charset and font name pattern");
919 tem
= Fdowncase (tem
);
921 tem
= Fcons (Fdowncase (Fcar (tem
)), Fdowncase (Fcdr (tem
)));
922 if (charset
== CHARSET_ASCII
)
926 c
= MAKE_CHAR (charset
, 0, 0);
927 elements
= Fcons (Fcons (make_number (c
), tem
), elements
);
931 if (NILP (ascii_font
))
932 error ("No ASCII font in the fontlist");
934 fontset
= make_fontset (Qnil
, name
, Qnil
);
935 FONTSET_ASCII (fontset
) = Fcons (make_number (0), ascii_font
);
936 for (; CONSP (elements
); elements
= XCDR (elements
))
938 elt
= XCAR (elements
);
941 tem
= font_family_registry (tem
, 0);
942 tem
= Fcons (XCAR (elt
), tem
);
943 FONTSET_SET (fontset
, XINT (XCAR (elt
)), tem
);
950 /* Clear all elements of FONTSET for multibyte characters. */
953 clear_fontset_elements (fontset
)
958 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
959 XCHAR_TABLE (fontset
)->contents
[i
] = Qnil
;
963 /* Check validity of NAME as a fontset name and return the
964 corresponding fontset. If not valid, signal an error.
965 If NAME is nil, return Vdefault_fontset. */
968 check_fontset_name (name
)
974 return Vdefault_fontset
;
977 id
= fs_query_fontset (name
, 0);
979 error ("Fontset `%s' does not exist", SDATA (name
));
980 return FONTSET_FROM_ID (id
);
983 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 4, 0,
984 doc
: /* Modify fontset NAME to use FONTNAME for CHARACTER.
986 If NAME is nil, modify the default fontset.
987 CHARACTER may be a cons; (FROM . TO), where FROM and TO are
988 non-generic characters. In that case, use FONTNAME
989 for all characters in the range FROM and TO (inclusive).
990 CHARACTER may be a charset. In that case, use FONTNAME
991 for all character in the charsets.
993 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family
994 name of a font, REGISTRY is a registry name of a font. */)
995 (name
, character
, fontname
, frame
)
996 Lisp_Object name
, character
, fontname
, frame
;
998 Lisp_Object fontset
, elt
;
999 Lisp_Object realized
;
1002 Lisp_Object family
, registry
;
1004 fontset
= check_fontset_name (name
);
1006 if (CONSP (character
))
1008 /* CH should be (FROM . TO) where FROM and TO are non-generic
1010 CHECK_NUMBER_CAR (character
);
1011 CHECK_NUMBER_CDR (character
);
1012 from
= XINT (XCAR (character
));
1013 to
= XINT (XCDR (character
));
1014 if (!char_valid_p (from
, 0) || !char_valid_p (to
, 0))
1015 error ("Character range should be by non-generic characters.");
1017 && (SINGLE_BYTE_CHAR_P (from
) || SINGLE_BYTE_CHAR_P (to
)))
1018 error ("Can't change font for a single byte character");
1020 else if (SYMBOLP (character
))
1022 elt
= Fget (character
, Qcharset
);
1023 if (!VECTORP (elt
) || ASIZE (elt
) < 1 || !NATNUMP (AREF (elt
, 0)))
1024 error ("Invalid charset: %s", SDATA (SYMBOL_NAME (character
)));
1025 from
= MAKE_CHAR (XINT (AREF (elt
, 0)), 0, 0);
1030 CHECK_NUMBER (character
);
1031 from
= XINT (character
);
1034 if (!char_valid_p (from
, 1))
1035 invalid_character (from
);
1036 if (SINGLE_BYTE_CHAR_P (from
))
1037 error ("Can't change font for a single byte character");
1040 if (!char_valid_p (to
, 1))
1041 invalid_character (to
);
1042 if (SINGLE_BYTE_CHAR_P (to
))
1043 error ("Can't change font for a single byte character");
1046 if (STRINGP (fontname
))
1048 fontname
= Fdowncase (fontname
);
1049 elt
= Fcons (make_number (from
), font_family_registry (fontname
, 0));
1053 CHECK_CONS (fontname
);
1054 family
= XCAR (fontname
);
1055 registry
= XCDR (fontname
);
1058 CHECK_STRING (family
);
1059 family
= Fdowncase (family
);
1061 if (!NILP (registry
))
1063 CHECK_STRING (registry
);
1064 registry
= Fdowncase (registry
);
1066 elt
= Fcons (make_number (from
), Fcons (family
, registry
));
1069 /* The arg FRAME is kept for backward compatibility. We only check
1072 CHECK_LIVE_FRAME (frame
);
1074 for (; from
<= to
; from
++)
1075 FONTSET_SET (fontset
, from
, elt
);
1076 Foptimize_char_table (fontset
);
1078 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1079 clear all the elements of REALIZED and free all multibyte faces
1080 whose fontset is REALIZED. This way, the specified character(s)
1081 are surely redisplayed by a correct font. */
1082 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1084 realized
= AREF (Vfontset_table
, id
);
1085 if (!NILP (realized
)
1086 && !BASE_FONTSET_P (realized
)
1087 && EQ (FONTSET_BASE (realized
), fontset
))
1089 FRAME_PTR f
= XFRAME (FONTSET_FRAME (realized
));
1090 clear_fontset_elements (realized
);
1091 free_realized_multibyte_face (f
, id
);
1098 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1099 doc
: /* Return information about a font named NAME on frame FRAME.
1100 If FRAME is omitted or nil, use the selected frame.
1101 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1102 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1104 OPENED-NAME is the name used for opening the font,
1105 FULL-NAME is the full name of the font,
1106 SIZE is the maximum bound width of the font,
1107 HEIGHT is the height of the font,
1108 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1109 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1110 how to compose characters.
1111 If the named font is not yet loaded, return nil. */)
1113 Lisp_Object name
, frame
;
1116 struct font_info
*fontp
;
1119 (*check_window_system_func
) ();
1121 CHECK_STRING (name
);
1122 name
= Fdowncase (name
);
1124 frame
= selected_frame
;
1125 CHECK_LIVE_FRAME (frame
);
1128 if (!query_font_func
)
1129 error ("Font query function is not supported");
1131 fontp
= (*query_font_func
) (f
, SDATA (name
));
1135 info
= Fmake_vector (make_number (7), Qnil
);
1137 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1138 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1139 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1140 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1141 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1142 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1143 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1149 /* Return a cons (FONT-NAME . GLYPH-CODE).
1150 FONT-NAME is the font name for the character at POSITION in the current
1151 buffer. This is computed from all the text properties and overlays
1152 that apply to POSITION.
1153 GLYPH-CODE is the glyph code in the font to use for the character.
1155 If the 2nd optional arg CH is non-nil, it is a character to check
1156 the font instead of the character at POSITION.
1158 It returns nil in the following cases:
1160 (1) The window system doesn't have a font for the character (thus
1161 it is displayed by an empty box).
1163 (2) The character code is invalid.
1165 (3) The current buffer is not displayed in any window.
1167 In addition, the returned font name may not take into account of
1168 such redisplay engine hooks as what used in jit-lock-mode if
1169 POSITION is currently not visible. */
1172 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 2, 0,
1173 doc
: /* For internal use only. */)
1175 Lisp_Object position
, ch
;
1177 int pos
, pos_byte
, dummy
;
1185 CHECK_NUMBER_COERCE_MARKER (position
);
1186 pos
= XINT (position
);
1187 if (pos
< BEGV
|| pos
>= ZV
)
1188 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1189 pos_byte
= CHAR_TO_BYTE (pos
);
1191 c
= FETCH_CHAR (pos_byte
);
1197 if (! CHAR_VALID_P (c
, 0))
1199 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1202 w
= XWINDOW (window
);
1203 f
= XFRAME (w
->frame
);
1204 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1205 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
);
1206 face
= FACE_FROM_ID (f
, face_id
);
1207 if (! face
->font
|| ! face
->font_name
)
1211 struct font_info
*fontp
= (*get_font_info_func
) (f
, face
->font_info_id
);
1213 int c1
, c2
, charset
;
1215 SPLIT_CHAR (c
, charset
, c1
, c2
);
1217 STORE_XCHAR2B (&char2b
, c1
, c2
);
1219 STORE_XCHAR2B (&char2b
, 0, c1
);
1220 rif
->encode_char (c
, &char2b
, fontp
, NULL
);
1221 code
= (XCHAR2B_BYTE1 (&char2b
) << 8) | XCHAR2B_BYTE2 (&char2b
);
1223 return Fcons (build_string (face
->font_name
), make_number (code
));
1227 /* Called from Ffontset_info via map_char_table on each leaf of
1228 fontset. ARG is a copy of the default fontset. The current leaf
1229 is indexed by CHARACTER and has value ELT. This function override
1230 the copy by ELT if ELT is not nil. */
1233 override_font_info (fontset
, character
, elt
)
1234 Lisp_Object fontset
, character
, elt
;
1237 Faset (fontset
, character
, elt
);
1240 /* Called from Ffontset_info via map_char_table on each leaf of
1241 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1242 ARG)' and FONT-INFOs have this form:
1243 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1244 The current leaf is indexed by CHARACTER and has value ELT. This
1245 function add the information of the current leaf to ARG by
1246 appending a new element or modifying the last element. */
1249 accumulate_font_info (arg
, character
, elt
)
1250 Lisp_Object arg
, character
, elt
;
1252 Lisp_Object last
, last_char
, last_elt
;
1254 if (!CONSP (elt
) && !SINGLE_BYTE_CHAR_P (XINT (character
)))
1255 elt
= FONTSET_REF (Vdefault_fontset
, XINT (character
));
1259 last_char
= XCAR (XCAR (last
));
1260 last_elt
= XCAR (XCDR (XCAR (last
)));
1262 if (!NILP (Fequal (elt
, last_elt
)))
1264 int this_charset
= CHAR_CHARSET (XINT (character
));
1266 if (CONSP (last_char
)) /* LAST_CHAR == (FROM . TO) */
1268 if (this_charset
== CHAR_CHARSET (XINT (XCAR (last_char
))))
1270 XSETCDR (last_char
, character
);
1274 else if (XINT (last_char
) == XINT (character
))
1276 else if (this_charset
== CHAR_CHARSET (XINT (last_char
)))
1278 XSETCAR (XCAR (last
), Fcons (last_char
, character
));
1282 XSETCDR (last
, Fcons (Fcons (character
, Fcons (elt
, Qnil
)), Qnil
));
1283 XSETCAR (arg
, XCDR (last
));
1287 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1288 doc
: /* Return information about a fontset named NAME on frame FRAME.
1289 If NAME is nil, return information about the default fontset.
1290 The value is a vector:
1291 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],
1293 SIZE is the maximum bound width of ASCII font in the fontset,
1294 HEIGHT is the maximum bound height of ASCII font in the fontset,
1295 CHARSET-OR-RANGE is a charset, a character (may be a generic character)
1296 or a cons of two characters specifying the range of characters.
1297 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),
1298 where FAMILY is a `FAMILY' field of a XLFD font name,
1299 REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name.
1300 FAMILY may contain a `FOUNDRY' field at the head.
1301 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.
1302 OPENEDs are names of fonts actually opened.
1303 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.
1304 If FRAME is omitted, it defaults to the currently selected frame. */)
1306 Lisp_Object name
, frame
;
1308 Lisp_Object fontset
;
1310 Lisp_Object indices
[3];
1311 Lisp_Object val
, tail
, elt
;
1312 Lisp_Object
*realized
;
1313 struct font_info
*fontp
= NULL
;
1317 (*check_window_system_func
) ();
1319 fontset
= check_fontset_name (name
);
1322 frame
= selected_frame
;
1323 CHECK_LIVE_FRAME (frame
);
1326 /* Recode realized fontsets whose base is FONTSET in the table
1328 realized
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1329 * ASIZE (Vfontset_table
));
1330 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1332 elt
= FONTSET_FROM_ID (i
);
1334 && EQ (FONTSET_BASE (elt
), fontset
))
1335 realized
[n_realized
++] = elt
;
1338 if (! EQ (fontset
, Vdefault_fontset
))
1340 /* Merge FONTSET onto the default fontset. */
1341 val
= Fcopy_sequence (Vdefault_fontset
);
1342 map_char_table (override_font_info
, Qnil
, fontset
, fontset
, val
, 0, indices
);
1346 /* Accumulate information of the fontset in VAL. The format is
1347 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1348 FONT-SPEC). See the comment for accumulate_font_info for the
1350 val
= Fcons (Fcons (make_number (0),
1351 Fcons (XCDR (FONTSET_ASCII (fontset
)), Qnil
)),
1353 val
= Fcons (val
, val
);
1354 map_char_table (accumulate_font_info
, Qnil
, fontset
, fontset
, val
, 0, indices
);
1357 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1358 character for a charset, replace it with the charset symbol. If
1359 fonts are opened for FONT-SPEC, append the names of the fonts to
1361 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
1365 if (INTEGERP (XCAR (elt
)))
1367 int charset
, c1
, c2
;
1368 c
= XINT (XCAR (elt
));
1369 SPLIT_CHAR (c
, charset
, c1
, c2
);
1371 XSETCAR (elt
, CHARSET_SYMBOL (charset
));
1374 c
= XINT (XCAR (XCAR (elt
)));
1375 for (i
= 0; i
< n_realized
; i
++)
1377 Lisp_Object face_id
, font
;
1380 face_id
= FONTSET_REF_VIA_BASE (realized
[i
], c
);
1381 if (INTEGERP (face_id
))
1383 face
= FACE_FROM_ID (f
, XINT (face_id
));
1384 if (face
&& face
->font
&& face
->font_name
)
1386 font
= build_string (face
->font_name
);
1387 if (NILP (Fmember (font
, XCDR (XCDR (elt
)))))
1388 XSETCDR (XCDR (elt
), Fcons (font
, XCDR (XCDR (elt
))));
1394 elt
= Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII
), val
)));
1398 fontp
= (*query_font_func
) (f
, SDATA (elt
));
1400 val
= Fmake_vector (make_number (3), val
);
1401 AREF (val
, 0) = fontp
? make_number (fontp
->size
) : make_number (0);
1402 AREF (val
, 1) = fontp
? make_number (fontp
->height
) : make_number (0);
1406 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1407 doc
: /* Return a font name pattern for character CH in fontset NAME.
1408 If NAME is nil, find a font name pattern in the default fontset. */)
1410 Lisp_Object name
, ch
;
1413 Lisp_Object fontset
, elt
;
1415 fontset
= check_fontset_name (name
);
1419 if (!char_valid_p (c
, 1))
1420 invalid_character (c
);
1422 elt
= FONTSET_REF (fontset
, c
);
1429 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1430 doc
: /* Return a list of all defined fontset names. */)
1433 Lisp_Object fontset
, list
;
1437 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1439 fontset
= FONTSET_FROM_ID (i
);
1441 && BASE_FONTSET_P (fontset
))
1442 list
= Fcons (FONTSET_NAME (fontset
), list
);
1451 if (!load_font_func
)
1452 /* Window system initializer should have set proper functions. */
1455 Qfontset
= intern ("fontset");
1456 staticpro (&Qfontset
);
1457 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (3));
1459 Vcached_fontset_data
= Qnil
;
1460 staticpro (&Vcached_fontset_data
);
1462 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1463 staticpro (&Vfontset_table
);
1465 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1466 staticpro (&Vdefault_fontset
);
1467 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1468 FONTSET_NAME (Vdefault_fontset
)
1469 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1470 #if defined (MAC_OS)
1471 FONTSET_ASCII (Vdefault_fontset
)
1472 = Fcons (make_number (0),
1473 build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));
1474 #elif defined (WINDOWSNT)
1475 FONTSET_ASCII (Vdefault_fontset
)
1476 = Fcons (make_number (0),
1477 build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
1479 FONTSET_ASCII (Vdefault_fontset
)
1480 = Fcons (make_number (0),
1481 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1483 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1484 next_fontset_id
= 1;
1486 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1487 doc
: /* Alist of fontname patterns vs corresponding encoding info.
1488 Each element looks like (REGEXP . ENCODING-INFO),
1489 where ENCODING-INFO is an alist of CHARSET vs ENCODING.
1490 ENCODING is one of the following integer values:
1491 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,
1492 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,
1493 2: code points 0x20A0..0x7FFF are used,
1494 3: code points 0xA020..0xFF7F are used. */);
1495 Vfont_encoding_alist
= Qnil
;
1496 Vfont_encoding_alist
1497 = Fcons (Fcons (build_string ("JISX0201"),
1498 Fcons (Fcons (intern ("latin-jisx0201"), make_number (0)),
1500 Vfont_encoding_alist
);
1501 Vfont_encoding_alist
1502 = Fcons (Fcons (build_string ("ISO8859-1"),
1503 Fcons (Fcons (intern ("ascii"), make_number (0)),
1505 Vfont_encoding_alist
);
1507 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1508 doc
: /* Char table of characters whose ascent values should be ignored.
1509 If an entry for a character is non-nil, the ascent value of the glyph
1510 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
1512 This affects how a composite character which contains
1513 such a character is displayed on screen. */);
1514 Vuse_default_ascent
= Qnil
;
1516 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1517 doc
: /* Char table of characters which is not composed relatively.
1518 If an entry for a character is non-nil, a composition sequence
1519 which contains that character is displayed so that
1520 the glyph of that character is put without considering
1521 an ascent and descent value of a previous character. */);
1522 Vignore_relative_composition
= Qnil
;
1524 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1525 doc
: /* Alist of fontname vs list of the alternate fontnames.
1526 When a specified font name is not found, the corresponding
1527 alternate fontnames (if any) are tried instead. */);
1528 Valternate_fontname_alist
= Qnil
;
1530 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1531 doc
: /* Alist of fontset names vs the aliases. */);
1532 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1533 build_string ("fontset-default")),
1536 DEFVAR_LISP ("vertical-centering-font-regexp",
1537 &Vvertical_centering_font_regexp
,
1538 doc
: /* *Regexp matching font names that require vertical centering on display.
1539 When a character is displayed with such fonts, the character is displayed
1540 at the vertical center of lines. */);
1541 Vvertical_centering_font_regexp
= Qnil
;
1543 defsubr (&Squery_fontset
);
1544 defsubr (&Snew_fontset
);
1545 defsubr (&Sset_fontset_font
);
1546 defsubr (&Sfont_info
);
1547 defsubr (&Sinternal_char_font
);
1548 defsubr (&Sfontset_info
);
1549 defsubr (&Sfontset_font
);
1550 defsubr (&Sfontset_list
);
1553 /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
1554 (do not change this comment) */