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_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_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_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 /* Check validity of NAME as a fontset name and return the
950 corresponding fontset. If not valid, signal an error.
951 If NAME is t, return Vdefault_fontset. */
954 check_fontset_name (name
)
960 return Vdefault_fontset
;
962 CHECK_STRING (name
, 0);
963 id
= fs_query_fontset (name
, 0);
965 error ("Fontset `%s' does not exist", XSTRING (name
)->data
);
966 return FONTSET_FROM_ID (id
);
969 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 4, 0,
970 "Modify fontset NAME to use FONTNAME for CHARACTER.\n\
972 CHARACTER may be a cons; (FROM . TO), where FROM and TO are\n\
973 non-generic characters. In that case, use FONTNAME\n\
974 for all characters in the range FROM and TO (inclusive).\n\
976 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family\n\
977 name of a font, REGSITRY is a registry name of a font.")
978 (name
, character
, fontname
, frame
)
979 Lisp_Object name
, character
, fontname
, frame
;
981 Lisp_Object fontset
, elt
;
982 Lisp_Object realized
;
985 Lisp_Object family
, registry
;
987 fontset
= check_fontset_name (name
);
989 if (CONSP (character
))
991 /* CH should be (FROM . TO) where FROM and TO are non-generic
993 CHECK_NUMBER (XCAR (character
), 1);
994 CHECK_NUMBER (XCDR (character
), 1);
995 from
= XINT (XCAR (character
));
996 to
= XINT (XCDR (character
));
997 if (!char_valid_p (from
, 0) || !char_valid_p (to
, 0))
998 error ("Character range should be by non-generic characters.");
1000 && (SINGLE_BYTE_CHAR_P (from
) || SINGLE_BYTE_CHAR_P (to
)))
1001 error ("Can't change font for a single byte character");
1005 CHECK_NUMBER (character
, 1);
1006 from
= XINT (character
);
1009 if (!char_valid_p (from
, 1))
1010 invalid_character (from
);
1011 if (SINGLE_BYTE_CHAR_P (from
))
1012 error ("Can't change font for a single byte character");
1015 if (!char_valid_p (to
, 1))
1016 invalid_character (to
);
1017 if (SINGLE_BYTE_CHAR_P (to
))
1018 error ("Can't change font for a single byte character");
1021 if (STRINGP (fontname
))
1023 fontname
= Fdowncase (fontname
);
1024 elt
= Fcons (make_number (from
), font_family_registry (fontname
));
1028 CHECK_CONS (fontname
, 2);
1029 family
= XCAR (fontname
);
1030 registry
= XCDR (fontname
);
1032 CHECK_STRING (family
, 2);
1033 if (!NILP (registry
))
1034 CHECK_STRING (registry
, 2);
1035 elt
= Fcons (make_number (from
), Fcons (family
, registry
));
1038 /* The arg FRAME is kept for backward compatibility. We only check
1041 CHECK_LIVE_FRAME (frame
, 3);
1043 for (; from
<= to
; from
++)
1044 FONTSET_SET (fontset
, from
, elt
);
1045 Foptimize_char_table (fontset
);
1047 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1048 clear all the elements of REALIZED and free all multibyte faces
1049 whose fontset is REALIZED. This way, the specified character(s)
1050 are surely redisplayed by a correct font. */
1051 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1053 realized
= AREF (Vfontset_table
, id
);
1054 if (!NILP (realized
)
1055 && !BASE_FONTSET_P (realized
)
1056 && EQ (FONTSET_BASE (realized
), fontset
))
1058 FRAME_PTR f
= XFRAME (FONTSET_FRAME (realized
));
1059 clear_fontset_elements (realized
);
1060 free_realized_multibyte_face (f
, id
);
1067 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1068 "Return information about a font named NAME on frame FRAME.\n\
1069 If FRAME is omitted or nil, use the selected frame.\n\
1070 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
1071 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
1073 OPENED-NAME is the name used for opening the font,\n\
1074 FULL-NAME is the full name of the font,\n\
1075 SIZE is the maximum bound width of the font,\n\
1076 HEIGHT is the height of the font,\n\
1077 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
1078 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
1079 how to compose characters.\n\
1080 If the named font is not yet loaded, return nil.")
1082 Lisp_Object name
, frame
;
1085 struct font_info
*fontp
;
1088 (*check_window_system_func
) ();
1090 CHECK_STRING (name
, 0);
1091 name
= Fdowncase (name
);
1093 frame
= selected_frame
;
1094 CHECK_LIVE_FRAME (frame
, 1);
1097 if (!query_font_func
)
1098 error ("Font query function is not supported");
1100 fontp
= (*query_font_func
) (f
, XSTRING (name
)->data
);
1104 info
= Fmake_vector (make_number (7), Qnil
);
1106 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1107 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1108 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1109 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1110 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1111 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1112 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1118 /* Return the font name for the character at POSITION in the current
1119 buffer. This is computed from all the text properties and overlays
1120 that apply to POSITION. It returns nil in the following cases:
1122 (1) The window system doesn't have a font for the character (thus
1123 it is displayed by an empty box).
1125 (2) The character code is invalid.
1127 (3) The current buffer is not displayed in any window.
1129 In addition, the returned font name may not take into account of
1130 such redisplay engine hooks as what used in jit-lock-mode if
1131 POSITION is currently not visible. */
1134 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1135 "For internal use only.")
1137 Lisp_Object position
;
1139 int pos
, pos_byte
, dummy
;
1147 CHECK_NUMBER_COERCE_MARKER (position
, 0);
1148 pos
= XINT (position
);
1149 if (pos
< BEGV
|| pos
>= ZV
)
1150 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1151 pos_byte
= CHAR_TO_BYTE (pos
);
1152 c
= FETCH_CHAR (pos_byte
);
1153 if (! CHAR_VALID_P (c
, 0))
1155 window
= Fget_buffer_window (Fcurrent_buffer (), Qt
);
1158 w
= XWINDOW (window
);
1159 f
= XFRAME (w
->frame
);
1160 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1161 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
);
1162 face
= FACE_FROM_ID (f
, face_id
);
1163 return (face
->font
&& face
->font_name
1164 ? build_string (face
->font_name
)
1169 /* Called from Ffontset_info via map_char_table on each leaf of
1170 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1171 ARG)' and FONT-INFOs have this form:
1172 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1173 The current leaf is indexed by CHARACTER and has value ELT. This
1174 function add the information of the current leaf to ARG by
1175 appending a new element or modifying the last element.. */
1178 accumulate_font_info (arg
, character
, elt
)
1179 Lisp_Object arg
, character
, elt
;
1181 Lisp_Object last
, last_char
, last_elt
, tmp
;
1186 last_char
= XCAR (XCAR (last
));
1187 last_elt
= XCAR (XCDR (XCAR (last
)));
1189 if (!NILP (Fequal (elt
, last_elt
)))
1191 int this_charset
= CHAR_CHARSET (XINT (character
));
1193 if (CONSP (last_char
)) /* LAST_CHAR == (FROM . TO) */
1195 if (this_charset
== CHAR_CHARSET (XINT (XCAR (last_char
))))
1197 XCDR (last_char
) = character
;
1203 if (this_charset
== CHAR_CHARSET (XINT (last_char
)))
1205 XCAR (XCAR (last
)) = Fcons (last_char
, character
);
1210 XCDR (last
) = Fcons (Fcons (character
, Fcons (elt
, Qnil
)), Qnil
);
1211 XCAR (arg
) = XCDR (last
);
1215 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1216 "Return information about a fontset named NAME on frame FRAME.\n\
1217 The value is a list:\n\
1218 \(FONTSET-NAME (CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...),\n\
1220 FONTSET-NAME is a full name of the fontset.\n\
1221 CHARSET-OR-RANGE is a charset, a character (may be a generic character)\n\
1222 or a cons of two characters specifying the range of characters.\n\
1223 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),\n\
1224 where FAMILY is a `FAMILY' field of a XLFD font name,\n\
1225 REGISTRY is a `CHARSET_REGISTRY' field of a XLDF font name.\n\
1226 FAMILY may contain a `FOUNDARY' field at the head.\n\
1227 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.\n\
1228 OPENEDs are names of fonts actually opened.\n\
1229 If FRAME is omitted, it defaults to the currently selected frame.")
1231 Lisp_Object name
, frame
;
1233 Lisp_Object fontset
;
1235 Lisp_Object indices
[3];
1236 Lisp_Object val
, tail
, elt
;
1237 Lisp_Object
*realized
;
1241 (*check_window_system_func
) ();
1243 fontset
= check_fontset_name (name
);
1246 frame
= selected_frame
;
1247 CHECK_LIVE_FRAME (frame
, 1);
1250 /* Recodeq realized fontsets whose base is FONTSET in the table
1252 realized
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1253 * ASIZE (Vfontset_table
));
1254 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1256 elt
= FONTSET_FROM_ID (i
);
1258 && EQ (FONTSET_BASE (elt
), fontset
))
1259 realized
[n_realized
++] = elt
;
1262 /* Accumulate information of the fontset in VAL. The format is
1263 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1264 FONT-SPEC). See the comment for accumulate_font_info for the
1266 val
= Fcons (Fcons (make_number (0),
1267 Fcons (XCDR (FONTSET_ASCII (fontset
)), Qnil
)),
1269 val
= Fcons (val
, val
);
1270 map_char_table (accumulate_font_info
, Qnil
, fontset
, val
, 0, indices
);
1273 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1274 character for a charset, replace it wiht the charset symbol. If
1275 fonts are opened for FONT-SPEC, append the names of the fonts to
1277 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
1281 if (INTEGERP (XCAR (elt
)))
1283 int charset
, c1
, c2
;
1284 c
= XINT (XCAR (elt
));
1285 SPLIT_CHAR (c
, charset
, c1
, c2
);
1287 XCAR (elt
) = CHARSET_SYMBOL (charset
);
1290 c
= XINT (XCAR (XCAR (elt
)));
1291 for (i
= 0; i
< n_realized
; i
++)
1293 Lisp_Object face_id
, font
;
1296 face_id
= FONTSET_REF_VIA_BASE (realized
[i
], c
);
1297 if (INTEGERP (face_id
))
1299 face
= FACE_FROM_ID (f
, XINT (face_id
));
1300 if (face
->font
&& face
->font_name
)
1302 font
= build_string (face
->font_name
);
1303 if (NILP (Fmember (font
, XCDR (XCDR (elt
)))))
1304 XCDR (XCDR (elt
)) = Fcons (font
, XCDR (XCDR (elt
)));
1309 return Fcons (FONTSET_NAME (fontset
), val
);
1312 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1313 "Return a font name pattern for character CH in fontset NAME.\n\
1314 If NAME is t, find a font name pattern in the default fontset.")
1316 Lisp_Object name
, ch
;
1319 Lisp_Object fontset
, elt
;
1321 fontset
= check_fontset_name (name
);
1323 CHECK_NUMBER (ch
, 1);
1325 if (!char_valid_p (c
, 1))
1326 invalid_character (c
);
1328 elt
= FONTSET_REF (fontset
, c
);
1336 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1337 "Return a list of all defined fontset names.")
1340 Lisp_Object fontset
, list
;
1344 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1346 fontset
= FONTSET_FROM_ID (i
);
1348 && BASE_FONTSET_P (fontset
))
1349 list
= Fcons (FONTSET_NAME (fontset
), list
);
1360 if (!load_font_func
)
1361 /* Window system initializer should have set proper functions. */
1364 Qfontset
= intern ("fontset");
1365 staticpro (&Qfontset
);
1366 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (3));
1368 Vcached_fontset_data
= Qnil
;
1369 staticpro (&Vcached_fontset_data
);
1371 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1372 staticpro (&Vfontset_table
);
1374 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1375 staticpro (&Vdefault_fontset
);
1376 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1377 FONTSET_NAME (Vdefault_fontset
)
1378 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1379 FONTSET_ASCII (Vdefault_fontset
)
1380 = Fcons (make_number (0),
1381 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1382 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1383 next_fontset_id
= 1;
1385 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1386 "Alist of fontname patterns vs corresponding encoding info.\n\
1387 Each element looks like (REGEXP . ENCODING-INFO),\n\
1388 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
1389 ENCODING is one of the following integer values:\n\
1390 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
1391 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
1392 2: code points 0x20A0..0x7FFF are used,\n\
1393 3: code points 0xA020..0xFF7F are used.");
1394 Vfont_encoding_alist
= Qnil
;
1396 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1397 "Char table of characters whose ascent values should be ignored.\n\
1398 If an entry for a character is non-nil, the ascent value of the glyph\n\
1399 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
1401 This affects how a composite character which contains\n\
1402 such a character is displayed on screen.");
1403 Vuse_default_ascent
= Qnil
;
1405 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1406 "Char table of characters which is not composed relatively.\n\
1407 If an entry for a character is non-nil, a composition sequence\n\
1408 which contains that character is displayed so that\n\
1409 the glyph of that character is put without considering\n\
1410 an ascent and descent value of a previous character.");
1411 Vignore_relative_composition
= Qnil
;
1413 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1414 "Alist of fontname vs list of the alternate fontnames.\n\
1415 When a specified font name is not found, the corresponding\n\
1416 alternate fontnames (if any) are tried instead.");
1417 Valternate_fontname_alist
= Qnil
;
1419 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1420 "Alist of fontset names vs the aliases.");
1421 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1422 build_string ("fontset-default")),
1425 DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font
,
1426 "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
1427 The way to highlight them depends on window system on which Emacs runs.\n\
1428 On X11, a rectangle is shown around each such character.");
1429 Vhighlight_wrong_size_font
= Qnil
;
1431 DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font
,
1432 "*Non-nil means characters shown in overlarge fonts are clipped.\n\
1433 The height of clipping area is the same as that of an ASCII character.\n\
1434 The width of the area is the same as that of an ASCII character,\n\
1435 or twice as wide, depending on the character set's column-width.\n\
1437 If the only font you have for a specific character set is too large,\n\
1438 and clipping these characters makes them hard to read,\n\
1439 you can set this variable to nil to display the characters without clipping.\n\
1440 The drawback is that you will get some garbage left on your screen.");
1441 Vclip_large_size_font
= Qt
;
1443 DEFVAR_LISP ("vertical-centering-font-regexp",
1444 &Vvertical_centering_font_regexp
,
1445 "*Regexp matching font names that require vertical centering on display.\n\
1446 When a character is displayed with such fonts, the character is displayed\n\
1447 at the vertival center of lines.");
1448 Vvertical_centering_font_regexp
= Qnil
;
1450 defsubr (&Squery_fontset
);
1451 defsubr (&Snew_fontset
);
1452 defsubr (&Sset_fontset_font
);
1453 defsubr (&Sfont_info
);
1454 defsubr (&Sinternal_char_font
);
1455 defsubr (&Sfontset_info
);
1456 defsubr (&Sfontset_font
);
1457 defsubr (&Sfontset_list
);