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 */
35 #include "dispextern.h"
41 #define xassert(X) do {if (!(X)) abort ();} while (0)
49 A fontset is a collection of font related information to give
50 similar appearance (style, size, etc) of characters. There are two
51 kinds of fontsets; base and realized. A base fontset is created by
52 new-fontset from Emacs Lisp explicitly. A realized fontset is
53 created implicitly when a face is realized for ASCII characters. A
54 face is also realized for multibyte characters based on an ASCII
55 face. All of the multibyte faces based on the same ASCII face
56 share the same realized fontset.
58 A fontset object is implemented by a char-table.
60 An element of a base fontset is:
62 (INDEX . (FOUNDRY . REGISTRY ))
63 FONTNAME is a font name pattern for the corresponding character.
64 FOUNDRY and REGISTRY are respectively foundy and regisry fields of
65 a font name for the corresponding character. INDEX specifies for
66 which character (or generic character) the element is defined. It
67 may be different from an index to access this element. For
68 instance, if a fontset defines some font for all characters of
69 charset `japanese-jisx0208', INDEX is the generic character of this
70 charset. REGISTRY is the
72 An element of a realized fontset is FACE-ID which is a face to use
73 for displaying the correspnding character.
75 All single byte charaters (ASCII and 8bit-unibyte) share the same
76 element in a fontset. The element is stored in `defalt' slot of
77 the fontset. And this slot is never used as a default value of
78 multibyte characters. That means that the first 256 elements of a
79 fontset are always nil (as this is not efficient, we may implement
80 a fontset in a different way in the future).
82 To access or set each element, use macros FONTSET_REF and
83 FONTSET_SET respectively for efficiency.
85 A fontset has 3 extra slots.
87 The 1st slot is an ID number of the fontset.
89 The 2nd slot is a name of the fontset. This is nil for a realized
92 The 3rd slot is a frame that the fontset belongs to. This is nil
95 A parent of a base fontset is nil. A parent of a realized fontset
98 All fontsets (except for the default fontset described below) are
99 recorded in Vfontset_table.
104 There's a special fontset named `default fontset' which defines a
105 default fontname that contains only REGISTRY field for each
106 character. When a base fontset doesn't specify a font for a
107 specific character, the corresponding value in the default fontset
108 is used. The format is the same as a base fontset.
110 The parent of realized fontsets created for faces that have no
111 fontset is the default fontset.
114 These structures are hidden from the other codes than this file.
115 The other codes handle fontsets only by their ID numbers. They
116 usually use variable name `fontset' for IDs. But, in this file, we
117 always use varialbe name `id' for IDs, and name `fontset' for the
118 actual fontset objects.
122 /********** VARIABLES and FUNCTION PROTOTYPES **********/
124 extern Lisp_Object Qfont
;
125 Lisp_Object Qfontset
;
127 /* Vector containing all fontsets. */
128 static Lisp_Object Vfontset_table
;
130 /* Next possibly free fontset ID. Usually this keeps the mininum
131 fontset ID not yet used. */
132 static int next_fontset_id
;
134 /* The default fontset. This gives default FAMILY and REGISTRY of
135 font for each characters. */
136 static Lisp_Object Vdefault_fontset
;
138 Lisp_Object Vfont_encoding_alist
;
139 Lisp_Object Vuse_default_ascent
;
140 Lisp_Object Vignore_relative_composition
;
141 Lisp_Object Valternate_fontname_alist
;
142 Lisp_Object Vfontset_alias_alist
;
143 Lisp_Object Vhighlight_wrong_size_font
;
144 Lisp_Object Vclip_large_size_font
;
145 Lisp_Object Vvertical_centering_font_regexp
;
147 /* The following six are declarations of callback functions depending
148 on window system. See the comments in src/fontset.h for more
151 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
152 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
154 /* Return a list of font names which matches PATTERN. See the document of
155 `x-list-fonts' for more detail. */
156 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
161 /* Load a font named NAME for frame F and return a pointer to the
162 information of the loaded font. If loading is failed, return 0. */
163 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
165 /* Return a pointer to struct font_info of a font named NAME for frame F. */
166 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
168 /* Additional function for setting fontset or changing fontset
169 contents of frame F. */
170 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
171 Lisp_Object oldval
));
173 /* To find a CCL program, fs_load_font calls this function.
174 The argument is a pointer to the struct font_info.
175 This function set the memer `encoder' of the structure. */
176 void (*find_ccl_program_func
) P_ ((struct font_info
*));
178 /* Check if any window system is used now. */
179 void (*check_window_system_func
) P_ ((void));
182 /* Prototype declarations for static functions. */
183 static Lisp_Object fontset_ref
P_ ((Lisp_Object
, int));
184 static void fontset_set
P_ ((Lisp_Object
, int, Lisp_Object
));
185 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
186 static int fontset_id_valid_p
P_ ((int));
187 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
188 static Lisp_Object font_family_registry
P_ ((Lisp_Object
));
191 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
193 /* Macros for Lisp vector. */
194 #define AREF(V, IDX) XVECTOR (V)->contents[IDX]
195 #define ASIZE(V) XVECTOR (V)->size
197 /* Return the fontset with ID. No check of ID's validness. */
198 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
200 /* Macros to access extra, default, and parent slots, of fontset. */
201 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
202 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
203 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
204 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->defalt
205 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
207 #define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
210 /* Return the element of FONTSET (char-table) at index C (character). */
212 #define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
214 static INLINE Lisp_Object
215 fontset_ref (fontset
, c
)
220 Lisp_Object elt
, defalt
;
223 if (SINGLE_BYTE_CHAR_P (c
))
224 return FONTSET_ASCII (fontset
);
226 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
227 elt
= XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
228 if (!SUB_CHAR_TABLE_P (elt
))
230 defalt
= XCHAR_TABLE (elt
)->defalt
;
232 || (elt
= XCHAR_TABLE (elt
)->contents
[c1
],
235 if (!SUB_CHAR_TABLE_P (elt
))
237 defalt
= XCHAR_TABLE (elt
)->defalt
;
239 || (elt
= XCHAR_TABLE (elt
)->contents
[c2
],
246 #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
248 static INLINE Lisp_Object
249 fontset_ref_via_base (fontset
, c
)
256 if (SINGLE_BYTE_CHAR_P (*c
))
257 return FONTSET_ASCII (fontset
);
259 elt
= FONTSET_REF (FONTSET_BASE (fontset
), *c
);
263 *c
= XINT (XCAR (elt
));
264 SPLIT_NON_ASCII_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 NEWETL. */
281 #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
284 fontset_set (fontset
, c
, newelt
)
289 int charset
, code
[3];
290 Lisp_Object
*elt
, tmp
;
293 if (SINGLE_BYTE_CHAR_P (c
))
295 FONTSET_ASCII (fontset
) = newelt
;
299 SPLIT_NON_ASCII_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
;
323 Lisp_Object fontset
, elt
, base_elt
;
324 int size
= ASIZE (Vfontset_table
);
325 int id
= next_fontset_id
;
328 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
329 the next available fontset ID. So it is expected that this loop
330 terminates quickly. In addition, as the last element of
331 Vfotnset_table is always nil, we don't have to check the range of
333 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
340 tem
= Fmake_vector (make_number (size
+ 8), Qnil
);
341 for (i
= 0; i
< size
; i
++)
342 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
343 Vfontset_table
= tem
;
347 fontset
= Fcopy_sequence (Vdefault_fontset
);
349 fontset
= Fmake_char_table (Qfontset
, Qnil
);
351 FONTSET_ID (fontset
) = make_number (id
);
352 FONTSET_NAME (fontset
) = name
;
353 FONTSET_FRAME (fontset
) = frame
;
354 FONTSET_BASE (fontset
) = base
;
356 AREF (Vfontset_table
, id
) = fontset
;
357 next_fontset_id
= id
+ 1;
362 /* Return 1 if ID is a valid fontset id, else return 0. */
365 fontset_id_valid_p (id
)
368 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
372 /* Extract `family' and `registry' string from FONTNAME and set in
373 *FAMILY and *REGISTRY respectively. Actually, `family' may also
374 contain `foundry', `registry' may also contain `encoding' of
378 font_family_registry (fontname
)
379 Lisp_Object fontname
;
381 Lisp_Object family
, registry
;
382 char *p
= XSTRING (fontname
)->data
;
386 while (*p
&& i
< 15) if (*p
++ == '-') sep
[i
++] = p
;
390 family
= make_unibyte_string (sep
[0], sep
[2] - 1 - sep
[0]);
391 registry
= make_unibyte_string (sep
[12], p
- sep
[12]);
392 return Fcons (family
, registry
);
396 /********** INTERFACES TO xfaces.c and dispextern.h **********/
398 /* Return name of the fontset with ID. */
405 fontset
= FONTSET_FROM_ID (id
);
406 return FONTSET_NAME (fontset
);
410 /* Return ASCII font name of the fontset with ID. */
416 Lisp_Object fontset
, elt
;
417 fontset
= FONTSET_FROM_ID (id
);
418 elt
= FONTSET_ASCII (fontset
);
423 /* Free fontset of FACE. Called from free_realized_face. */
426 free_face_fontset (f
, face
)
430 if (fontset_id_valid_p (face
->fontset
))
432 AREF (Vfontset_table
, face
->fontset
) = Qnil
;
433 if (face
->fontset
< next_fontset_id
)
434 next_fontset_id
= face
->fontset
;
439 /* Return 1 iff FACE is suitable for displaying character C.
440 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
441 when C is not a single byte character.. */
444 face_suitable_for_char_p (face
, c
)
448 Lisp_Object fontset
, elt
;
450 if (SINGLE_BYTE_CHAR_P (c
))
451 return (face
== face
->ascii_face
);
453 xassert (fontset_id_valid_p (face
->fontset
));
454 fontset
= FONTSET_FROM_ID (face
->fontset
);
455 xassert (!BASE_FONTSET_P (fontset
));
457 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
458 return (!NILP (elt
) && face
->id
== XFASTINT (elt
));
462 /* Return ID of face suitable for displaying character C on frame F.
463 The selection of face is done based on the fontset of FACE. FACE
464 should already have been realized for ASCII characters. Called
465 from the macro FACE_FOR_CHAR when C is not a single byte character. */
468 face_for_char (f
, face
, c
)
473 Lisp_Object fontset
, elt
;
476 xassert (fontset_id_valid_p (face
->fontset
));
477 fontset
= FONTSET_FROM_ID (face
->fontset
);
478 xassert (!BASE_FONTSET_P (fontset
));
480 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
484 /* No face is recorded for C in the fontset of FACE. Make a new
485 realized face for C that has the same fontset. */
486 face_id
= lookup_face (f
, face
->lface
, c
, face
);
488 /* Record the face ID in FONTSET at the same index as the
489 information in the base fontset. */
490 FONTSET_SET (fontset
, c
, make_number (face_id
));
495 /* Make a realized fontset for ASCII face FACE on frame F from the
496 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
497 default fontset as the base. Value is the id of the new fontset.
498 Called from realize_x_face. */
501 make_fontset_for_ascii_face (f
, base_fontset_id
)
505 Lisp_Object base_fontset
, fontset
, name
, frame
;
507 XSETFRAME (frame
, f
);
508 if (base_fontset_id
>= 0)
510 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
511 if (!BASE_FONTSET_P (base_fontset
))
512 base_fontset
= FONTSET_BASE (base_fontset
);
513 xassert (BASE_FONTSET_P (base_fontset
));
516 base_fontset
= Vdefault_fontset
;
518 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
519 return XINT (FONTSET_ID (fontset
));
523 /* Return the font name pattern for C that is recorded in the fontset
524 with ID. A font is opened by that pattern to get the fullname. If
525 the fullname conform to XLFD, extract foundry-family field and
526 registry-encoding field, and return the cons of them. Otherwise
527 return the fullname. If ID is -1, or the fontset doesn't contain
528 information about C, get the registry and encoding of C from the
529 default fontset. Called from choose_face_font. */
532 fontset_font_pattern (f
, id
, c
)
536 Lisp_Object fontset
, elt
;
537 struct font_info
*fontp
;
538 Lisp_Object family_registry
;
541 if (fontset_id_valid_p (id
))
543 fontset
= FONTSET_FROM_ID (id
);
544 xassert (!BASE_FONTSET_P (fontset
));
545 fontset
= FONTSET_BASE (fontset
);
546 elt
= FONTSET_REF (fontset
, c
);
549 elt
= FONTSET_REF (Vdefault_fontset
, c
);
553 if (CONSP (XCDR (elt
)))
556 /* The fontset specifies only a font name pattern (not cons of
557 family and registry). Try to open a font by that pattern and get
558 a registry from the full name of the opened font. We ignore
559 family name here because it should be wild card in the fontset
562 xassert (STRINGP (elt
));
563 fontp
= FS_LOAD_FONT (f
, c
, XSTRING (elt
)->data
, -1);
567 family_registry
= font_family_registry (build_string (fontp
->full_name
));
568 if (!CONSP (family_registry
))
569 return family_registry
;
570 XCAR (family_registry
) = Qnil
;
571 return family_registry
;
575 /* Load a font named FONTNAME to display character C on frame F.
576 Return a pointer to the struct font_info of the loaded font. If
577 loading fails, return NULL. If FACE is non-zero and a fontset is
578 assigned to it, record FACE->id in the fontset for C. If FONTNAME
579 is NULL, the name is taken from the fontset of FACE or what
583 fs_load_font (f
, c
, fontname
, id
, face
)
591 Lisp_Object list
, elt
;
594 struct font_info
*fontp
;
595 int charset
= CHAR_CHARSET (c
);
602 fontset
= FONTSET_FROM_ID (id
);
605 && !BASE_FONTSET_P (fontset
))
607 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
610 /* A suitable face for C is already recorded, which means
611 that a proper font is already loaded. */
612 int face_id
= XINT (elt
);
614 xassert (face_id
== face
->id
);
615 face
= FACE_FROM_ID (f
, face_id
);
616 return (*get_font_info_func
) (f
, face
->font_info_id
);
619 if (!fontname
&& charset
== CHARSET_ASCII
)
621 elt
= FONTSET_ASCII (fontset
);
622 fontname
= XSTRING (XCDR (elt
))->data
;
627 /* No way to get fontname. */
630 fontp
= (*load_font_func
) (f
, fontname
, size
);
634 /* Fill in members (charset, vertical_centering, encoding, etc) of
635 font_info structure that are not set by (*load_font_func). */
636 fontp
->charset
= charset
;
638 fontp
->vertical_centering
639 = (STRINGP (Vvertical_centering_font_regexp
)
640 && (fast_c_string_match_ignore_case
641 (Vvertical_centering_font_regexp
, fontp
->full_name
) >= 0));
643 if (fontp
->encoding
[1] != FONT_ENCODING_NOT_DECIDED
)
645 /* The font itself tells which code points to be used. Use this
646 encoding for all other charsets. */
649 fontp
->encoding
[0] = fontp
->encoding
[1];
650 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
651 fontp
->encoding
[i
] = fontp
->encoding
[1];
655 /* The font itself doesn't have information about encoding. */
658 fontname
= fontp
->full_name
;
659 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
660 others is 1 (i.e. 0x80..0xFF). */
661 fontp
->encoding
[0] = 0;
662 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
663 fontp
->encoding
[i
] = 1;
664 /* Then override them by a specification in Vfont_encoding_alist. */
665 for (list
= Vfont_encoding_alist
; CONSP (list
); list
= XCDR (list
))
669 && STRINGP (XCAR (elt
)) && CONSP (XCDR (elt
))
670 && (fast_c_string_match_ignore_case (XCAR (elt
), fontname
)
675 for (tmp
= XCDR (elt
); CONSP (tmp
); tmp
= XCDR (tmp
))
676 if (CONSP (XCAR (tmp
))
677 && ((i
= get_charset_id (XCAR (XCAR (tmp
))))
679 && INTEGERP (XCDR (XCAR (tmp
)))
680 && XFASTINT (XCDR (XCAR (tmp
))) < 4)
682 = XFASTINT (XCDR (XCAR (tmp
)));
687 fontp
->font_encoder
= (struct ccl_program
*) 0;
689 if (find_ccl_program_func
)
690 (*find_ccl_program_func
) (fontp
);
692 /* If we loaded a font for a face that has fontset, record the face
693 ID in the fontset for C. */
696 && !BASE_FONTSET_P (fontset
))
697 FONTSET_SET (fontset
, c
, make_number (face
->id
));
702 /* Cache data used by fontset_pattern_regexp. The car part is a
703 pattern string containing at least one wild card, the cdr part is
704 the corresponding regular expression. */
705 static Lisp_Object Vcached_fontset_data
;
707 #define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
708 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
710 /* If fontset name PATTERN contains any wild card, return regular
711 expression corresponding to PATTERN. */
714 fontset_pattern_regexp (pattern
)
717 if (!index (XSTRING (pattern
)->data
, '*')
718 && !index (XSTRING (pattern
)->data
, '?'))
719 /* PATTERN does not contain any wild cards. */
722 if (!CONSP (Vcached_fontset_data
)
723 || strcmp (XSTRING (pattern
)->data
, CACHED_FONTSET_NAME
))
725 /* We must at first update the cached data. */
726 char *regex
= (char *) alloca (XSTRING (pattern
)->size
* 2);
727 char *p0
, *p1
= regex
;
729 /* Convert "*" to ".*", "?" to ".". */
731 for (p0
= (char *) XSTRING (pattern
)->data
; *p0
; p0
++)
746 Vcached_fontset_data
= Fcons (build_string (XSTRING (pattern
)->data
),
747 build_string (regex
));
750 return CACHED_FONTSET_REGEX
;
753 /* Return ID of the base fontset named NAME. If there's no such
754 fontset, return -1. */
757 fs_query_fontset (name
, regexpp
)
761 Lisp_Object fontset
, tem
;
764 name
= Fdowncase (name
);
767 tem
= Frassoc (name
, Vfontset_alias_alist
);
768 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
772 tem
= fontset_pattern_regexp (name
);
781 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
784 unsigned char *this_name
;
786 fontset
= FONTSET_FROM_ID (i
);
788 || !BASE_FONTSET_P (fontset
))
791 this_name
= XSTRING (FONTSET_NAME (fontset
))->data
;
793 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
794 : !strcmp (XSTRING (name
)->data
, this_name
))
801 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
802 "Return the name of a fontset that matches PATTERN.\n\
803 The value is nil if there is no matching fontset.\n\
804 PATTERN can contain `*' or `?' as a wildcard\n\
805 just as X font name matching algorithm allows.\n\
806 If REGEXPP is non-nil, PATTERN is a regular expression.")
808 Lisp_Object pattern
, regexpp
;
813 (*check_window_system_func
) ();
815 CHECK_STRING (pattern
, 0);
817 if (XSTRING (pattern
)->size
== 0)
820 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
824 fontset
= FONTSET_FROM_ID (id
);
825 return FONTSET_NAME (fontset
);
828 /* Return a list of base fontset names matching PATTERN on frame F.
829 If SIZE is not 0, it is the size (maximum bound width) of fontsets
833 list_fontsets (f
, pattern
, size
)
838 Lisp_Object frame
, regexp
, val
, tail
;
841 XSETFRAME (frame
, f
);
843 regexp
= fontset_pattern_regexp (pattern
);
846 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
851 fontset
= FONTSET_FROM_ID (id
);
853 || !BASE_FONTSET_P (fontset
)
854 || !EQ (frame
, FONTSET_FRAME (fontset
)))
856 name
= XSTRING (FONTSET_NAME (fontset
))->data
;
859 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
860 : strcmp (XSTRING (pattern
)->data
, name
))
865 struct font_info
*fontp
;
866 fontp
= FS_LOAD_FONT (f
, 0, NULL
, id
);
867 if (!fontp
|| size
!= fontp
->size
)
870 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
876 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
877 "Create a new fontset NAME that contains font information in FONTLIST.\n\
878 FONTLIST is an alist of charsets vs corresponding font name patterns.")
880 Lisp_Object name
, fontlist
;
882 Lisp_Object fontset
, elements
, ascii_font
;
883 Lisp_Object tem
, tail
, elt
;
885 (*check_window_system_func
) ();
887 CHECK_STRING (name
, 0);
888 CHECK_LIST (fontlist
, 1);
890 name
= Fdowncase (name
);
891 tem
= Fquery_fontset (name
, Qnil
);
893 error ("Fontset `%s' matches the existing fontset `%s'",
894 XSTRING (name
)->data
, XSTRING (tem
)->data
);
896 /* Check the validity of FONTLIST while creating a template for
898 elements
= ascii_font
= Qnil
;
899 for (tail
= fontlist
; CONSP (tail
); tail
= XCDR (tail
))
901 Lisp_Object family
, registry
;
906 || (charset
= get_charset_id (XCAR (tem
))) < 0
907 || !STRINGP (XCDR (tem
)))
908 error ("Elements of fontlist must be a cons of charset and font name");
910 tem
= Fdowncase (XCDR (tem
));
911 if (charset
== CHARSET_ASCII
)
915 c
= MAKE_CHAR (charset
, 0, 0);
916 elements
= Fcons (Fcons (make_number (c
), tem
), elements
);
920 if (NILP (ascii_font
))
921 error ("No ASCII font in the fontlist");
923 fontset
= make_fontset (Qnil
, name
, Qnil
);
924 FONTSET_ASCII (fontset
) = Fcons (make_number (0), ascii_font
);
925 for (; CONSP (elements
); elements
= XCDR (elements
))
927 elt
= XCAR (elements
);
928 tem
= Fcons (XCAR (elt
), font_family_registry (XCDR (elt
)));
929 FONTSET_SET (fontset
, XINT (XCAR (elt
)), tem
);
936 /* Clear all elements of FONTSET for multibyte characters. */
939 clear_fontset_elements (fontset
)
944 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
945 XCHAR_TABLE (fontset
)->contents
[i
] = Qnil
;
949 /* Return 1 iff REGISTRY is a valid string as the font registry and
950 encoding. It is valid if it doesn't start with `-' and the number
951 of `-' in the string is at most 1. */
954 check_registry_encoding (registry
)
955 Lisp_Object registry
;
957 unsigned char *str
= XSTRING (registry
)->data
;
958 unsigned char *p
= str
;
961 if (!*p
|| *p
++ == '-')
969 /* Check validity of NAME as a fontset name and return the
970 corresponding fontset. If not valid, signal an error.
971 If NAME is t, return Vdefault_fontset. */
974 check_fontset_name (name
)
980 return Vdefault_fontset
;
982 CHECK_STRING (name
, 0);
983 id
= fs_query_fontset (name
, 0);
985 error ("Fontset `%s' does not exist", XSTRING (name
)->data
);
986 return FONTSET_FROM_ID (id
);
989 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 4, 0,
990 "Modify fontset NAME to use FONTNAME for CHARACTER.\n\
992 CHARACTER may be a cons; (FROM . TO), where FROM and TO are\n\
993 non-generic characters. In that case, use FONTNAME\n\
994 for all characters in the range FROM and TO (inclusive).\n\
996 If NAME is t, an entry in the default fontset is modified.\n\
997 In that case, FONTNAME should be a registry and encoding name\n\
998 of a font for CHARACTER.")
999 (name
, character
, fontname
, frame
)
1000 Lisp_Object name
, character
, fontname
, frame
;
1002 Lisp_Object fontset
, elt
;
1003 Lisp_Object realized
;
1007 fontset
= check_fontset_name (name
);
1009 if (CONSP (character
))
1011 /* CH should be (FROM . TO) where FROM and TO are non-generic
1013 CHECK_NUMBER (XCAR (character
), 1);
1014 CHECK_NUMBER (XCDR (character
), 1);
1015 from
= XINT (XCAR (character
));
1016 to
= XINT (XCDR (character
));
1017 if (!char_valid_p (from
, 0) || !char_valid_p (to
, 0))
1018 error ("Character range should be by non-generic characters.");
1020 && (SINGLE_BYTE_CHAR_P (from
) || SINGLE_BYTE_CHAR_P (to
)))
1021 error ("Can't change font for a single byte character");
1025 CHECK_NUMBER (character
, 1);
1026 from
= XINT (character
);
1029 if (!char_valid_p (from
, 1))
1030 invalid_character (from
);
1031 if (SINGLE_BYTE_CHAR_P (from
))
1032 error ("Can't change font for a single byte character");
1035 if (!char_valid_p (to
, 1))
1036 invalid_character (to
);
1037 if (SINGLE_BYTE_CHAR_P (to
))
1038 error ("Can't change font for a single byte character");
1041 CHECK_STRING (fontname
, 2);
1042 fontname
= Fdowncase (fontname
);
1043 if (EQ (fontset
, Vdefault_fontset
))
1045 if (!check_registry_encoding (fontname
))
1046 error ("Invalid registry and encoding name: %s",
1047 XSTRING (fontname
)->data
);
1048 elt
= Fcons (make_number (from
), Fcons (Qnil
, fontname
));
1051 elt
= Fcons (make_number (from
), font_family_registry (fontname
));
1053 /* The arg FRAME is kept for backward compatibility. We only check
1056 CHECK_LIVE_FRAME (frame
, 3);
1058 for (; from
<= to
; from
++)
1059 FONTSET_SET (fontset
, from
, elt
);
1060 Foptimize_char_table (fontset
);
1062 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1063 clear all the elements of REALIZED and free all multibyte faces
1064 whose fontset is REALIZED. This way, the specified character(s)
1065 are surely redisplayed by a correct font. */
1066 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1068 realized
= AREF (Vfontset_table
, id
);
1069 if (!NILP (realized
)
1070 && !BASE_FONTSET_P (realized
)
1071 && EQ (FONTSET_BASE (realized
), fontset
))
1073 FRAME_PTR f
= XFRAME (FONTSET_FRAME (realized
));
1074 clear_fontset_elements (realized
);
1075 free_realized_multibyte_face (f
, id
);
1082 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1083 "Return information about a font named NAME on frame FRAME.\n\
1084 If FRAME is omitted or nil, use the selected frame.\n\
1085 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
1086 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
1088 OPENED-NAME is the name used for opening the font,\n\
1089 FULL-NAME is the full name of the font,\n\
1090 SIZE is the maximum bound width of the font,\n\
1091 HEIGHT is the height of the font,\n\
1092 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
1093 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
1094 how to compose characters.\n\
1095 If the named font is not yet loaded, return nil.")
1097 Lisp_Object name
, frame
;
1100 struct font_info
*fontp
;
1103 (*check_window_system_func
) ();
1105 CHECK_STRING (name
, 0);
1106 name
= Fdowncase (name
);
1108 frame
= selected_frame
;
1109 CHECK_LIVE_FRAME (frame
, 1);
1112 if (!query_font_func
)
1113 error ("Font query function is not supported");
1115 fontp
= (*query_font_func
) (f
, XSTRING (name
)->data
);
1119 info
= Fmake_vector (make_number (7), Qnil
);
1121 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1122 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1123 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1124 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1125 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1126 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1127 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1133 /* Return the font name for the character at POSITION in the current
1134 buffer. This is computed from all the text properties and overlays
1135 that apply to POSITION. It returns nil in the following cases:
1137 (1) The window system doesn't have a font for the character (thus
1138 it is displayed by an empty box).
1140 (2) The character code is invalid.
1142 (3) The current buffer is not displayed in any window.
1144 In addition, the returned font name may not take into account of
1145 such redisplay engine hooks as what used in jit-lock-mode if
1146 POSITION is currently not visible. */
1149 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1150 "For internal use only.")
1152 Lisp_Object position
;
1154 int pos
, pos_byte
, dummy
;
1162 CHECK_NUMBER_COERCE_MARKER (position
, 0);
1163 pos
= XINT (position
);
1164 if (pos
< BEGV
|| pos
>= ZV
)
1165 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1166 pos_byte
= CHAR_TO_BYTE (pos
);
1167 c
= FETCH_CHAR (pos_byte
);
1168 if (! CHAR_VALID_P (c
, 0))
1170 window
= Fget_buffer_window (Fcurrent_buffer (), Qt
);
1173 w
= XWINDOW (window
);
1174 f
= XFRAME (w
->frame
);
1175 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1176 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
);
1177 face
= FACE_FROM_ID (f
, face_id
);
1178 return (face
->font
&& face
->font_name
1179 ? build_string (face
->font_name
)
1184 /* Called from Ffontset_info via map_char_table on each leaf of
1185 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1186 ARG)' and FONT-INFOs have this form:
1187 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1188 The current leaf is indexed by CHARACTER and has value ELT. This
1189 function add the information of the current leaf to ARG by
1190 appending a new element or modifying the last element.. */
1193 accumulate_font_info (arg
, character
, elt
)
1194 Lisp_Object arg
, character
, elt
;
1196 Lisp_Object last
, last_char
, last_elt
, tmp
;
1201 last_char
= XCAR (XCAR (last
));
1202 last_elt
= XCAR (XCDR (XCAR (last
)));
1204 if (!NILP (Fequal (elt
, last_elt
)))
1206 int this_charset
= CHAR_CHARSET (XINT (character
));
1208 if (CONSP (last_char
)) /* LAST_CHAR == (FROM . TO) */
1210 if (this_charset
== CHAR_CHARSET (XINT (XCAR (last_char
))))
1212 XCDR (last_char
) = character
;
1218 if (this_charset
== CHAR_CHARSET (XINT (last_char
)))
1220 XCAR (XCAR (last
)) = Fcons (last_char
, character
);
1225 XCDR (last
) = Fcons (Fcons (character
, Fcons (elt
, Qnil
)), Qnil
);
1226 XCAR (arg
) = XCDR (last
);
1230 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1231 "Return information about a fontset named NAME on frame FRAME.\n\
1232 The value is a list:\n\
1233 \(FONTSET-NAME (CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...),\n\
1235 FONTSET-NAME is a full name of the fontset.\n\
1236 CHARSET-OR-RANGE is a charset, a character (may be a generic character)\n\
1237 or a cons of two characters specifying the range of characters.\n\
1238 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),\n\
1239 where FAMILY is a `FAMILY' field of a XLFD font name,\n\
1240 REGISTRY is a `CHARSET_REGISTRY' field of a XLDF font name.\n\
1241 FAMILY may contain a `FOUNDARY' field at the head.\n\
1242 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.\n\
1243 OPENEDs are names of fonts actually opened.\n\
1244 If FRAME is omitted, it defaults to the currently selected frame.")
1246 Lisp_Object name
, frame
;
1248 Lisp_Object fontset
;
1250 Lisp_Object indices
[3];
1251 Lisp_Object val
, tail
, elt
;
1252 Lisp_Object
*realized
;
1256 (*check_window_system_func
) ();
1258 fontset
= check_fontset_name (name
);
1261 frame
= selected_frame
;
1262 CHECK_LIVE_FRAME (frame
, 1);
1265 /* Recodeq realized fontsets whose base is FONTSET in the table
1267 realized
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1268 * ASIZE (Vfontset_table
));
1269 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1271 elt
= FONTSET_FROM_ID (i
);
1273 && EQ (FONTSET_BASE (elt
), fontset
))
1274 realized
[n_realized
++] = elt
;
1277 /* Accumulate information of the fontset in VAL. The format is
1278 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1279 FONT-SPEC). See the comment for accumulate_font_info for the
1281 val
= Fcons (Fcons (make_number (0),
1282 Fcons (XCDR (FONTSET_ASCII (fontset
)), Qnil
)),
1284 val
= Fcons (val
, val
);
1285 map_char_table (accumulate_font_info
, Qnil
, fontset
, val
, 0, indices
);
1288 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1289 character for a charset, replace it wiht the charset symbol. If
1290 fonts are opened for FONT-SPEC, append the names of the fonts to
1292 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
1296 if (INTEGERP (XCAR (elt
)))
1298 int charset
, c1
, c2
;
1299 c
= XINT (XCAR (elt
));
1300 SPLIT_CHAR (c
, charset
, c1
, c2
);
1302 XCAR (elt
) = CHARSET_SYMBOL (charset
);
1305 c
= XINT (XCAR (XCAR (elt
)));
1306 for (i
= 0; i
< n_realized
; i
++)
1308 Lisp_Object face_id
, font
;
1311 face_id
= FONTSET_REF_VIA_BASE (realized
[i
], c
);
1312 if (INTEGERP (face_id
))
1314 face
= FACE_FROM_ID (f
, XINT (face_id
));
1315 if (face
->font
&& face
->font_name
)
1317 font
= build_string (face
->font_name
);
1318 if (NILP (Fmember (font
, XCDR (XCDR (elt
)))))
1319 XCDR (XCDR (elt
)) = Fcons (font
, XCDR (XCDR (elt
)));
1324 return Fcons (FONTSET_NAME (fontset
), val
);
1327 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1328 "Return a font name pattern for character CH in fontset NAME.\n\
1329 If NAME is t, find a font name pattern in the default fontset.")
1331 Lisp_Object name
, ch
;
1334 Lisp_Object fontset
, elt
;
1336 fontset
= check_fontset_name (name
);
1338 CHECK_NUMBER (ch
, 1);
1340 if (!char_valid_p (c
, 1))
1341 invalid_character (c
);
1343 elt
= FONTSET_REF (fontset
, c
);
1351 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1352 "Return a list of all defined fontset names.")
1355 Lisp_Object fontset
, list
;
1359 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1361 fontset
= FONTSET_FROM_ID (i
);
1363 && BASE_FONTSET_P (fontset
))
1364 list
= Fcons (FONTSET_NAME (fontset
), list
);
1375 if (!load_font_func
)
1376 /* Window system initializer should have set proper functions. */
1379 Qfontset
= intern ("fontset");
1380 staticpro (&Qfontset
);
1381 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (3));
1383 Vcached_fontset_data
= Qnil
;
1384 staticpro (&Vcached_fontset_data
);
1386 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1387 staticpro (&Vfontset_table
);
1389 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1390 staticpro (&Vdefault_fontset
);
1391 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1392 FONTSET_NAME (Vdefault_fontset
)
1393 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1394 FONTSET_ASCII (Vdefault_fontset
)
1395 = Fcons (make_number (0), Fcons (Qnil
, build_string ("iso8859-1")));
1396 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1397 next_fontset_id
= 1;
1399 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1400 "Alist of fontname patterns vs corresponding encoding info.\n\
1401 Each element looks like (REGEXP . ENCODING-INFO),\n\
1402 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
1403 ENCODING is one of the following integer values:\n\
1404 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
1405 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
1406 2: code points 0x20A0..0x7FFF are used,\n\
1407 3: code points 0xA020..0xFF7F are used.");
1408 Vfont_encoding_alist
= Qnil
;
1410 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1411 "Char table of characters whose ascent values should be ignored.\n\
1412 If an entry for a character is non-nil, the ascent value of the glyph\n\
1413 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
1415 This affects how a composite character which contains\n\
1416 such a character is displayed on screen.");
1417 Vuse_default_ascent
= Qnil
;
1419 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1420 "Char table of characters which is not composed relatively.\n\
1421 If an entry for a character is non-nil, a composition sequence\n\
1422 which contains that character is displayed so that\n\
1423 the glyph of that character is put without considering\n\
1424 an ascent and descent value of a previous character.");
1425 Vignore_relative_composition
= Qnil
;
1427 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1428 "Alist of fontname vs list of the alternate fontnames.\n\
1429 When a specified font name is not found, the corresponding\n\
1430 alternate fontnames (if any) are tried instead.");
1431 Valternate_fontname_alist
= Qnil
;
1433 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1434 "Alist of fontset names vs the aliases.");
1435 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1436 build_string ("fontset-default")),
1439 DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font
,
1440 "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
1441 The way to highlight them depends on window system on which Emacs runs.\n\
1442 On X11, a rectangle is shown around each such character.");
1443 Vhighlight_wrong_size_font
= Qnil
;
1445 DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font
,
1446 "*Non-nil means characters shown in overlarge fonts are clipped.\n\
1447 The height of clipping area is the same as that of an ASCII character.\n\
1448 The width of the area is the same as that of an ASCII character,\n\
1449 or twice as wide, depending on the character set's column-width.\n\
1451 If the only font you have for a specific character set is too large,\n\
1452 and clipping these characters makes them hard to read,\n\
1453 you can set this variable to nil to display the characters without clipping.\n\
1454 The drawback is that you will get some garbage left on your screen.");
1455 Vclip_large_size_font
= Qt
;
1457 DEFVAR_LISP ("vertical-centering-font-regexp",
1458 &Vvertical_centering_font_regexp
,
1459 "*Regexp matching font names that require vertical centering on display.\n\
1460 When a character is displayed with such fonts, the character is displayed\n\
1461 at the vertival center of lines.");
1462 Vvertical_centering_font_regexp
= Qnil
;
1464 defsubr (&Squery_fontset
);
1465 defsubr (&Snew_fontset
);
1466 defsubr (&Sset_fontset_font
);
1467 defsubr (&Sfont_info
);
1468 defsubr (&Sinternal_char_font
);
1469 defsubr (&Sfontset_info
);
1470 defsubr (&Sfontset_font
);
1471 defsubr (&Sfontset_list
);