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 the first element
79 To access or set each element, use macros FONTSET_REF and
80 FONTSET_SET respectively for efficiency.
82 A fontset has 3 extra slots.
84 The 1st slot is an ID number of the fontset.
86 The 2nd slot is a name of the fontset. This is nil for a realized
89 The 3rd slot is a frame that the fontset belongs to. This is nil
92 A parent of a base fontset is nil. A parent of a realized fontset
95 All fontsets are recorded in Vfontset_table.
100 There's a special fontset named `default fontset' which defines a
101 default fontname pattern. When a base fontset doesn't specify a
102 font for a specific character, the corresponding value in the
103 default fontset is used. The format is the same as a base fontset.
105 The parent of a realized fontset created for such a face that has
106 no fontset is the default fontset.
109 These structures are hidden from the other codes than this file.
110 The other codes handle fontsets only by their ID numbers. They
111 usually use variable name `fontset' for IDs. But, in this file, we
112 always use varialbe name `id' for IDs, and name `fontset' for the
113 actual fontset objects.
117 /********** VARIABLES and FUNCTION PROTOTYPES **********/
119 extern Lisp_Object Qfont
;
120 Lisp_Object Qfontset
;
122 /* Vector containing all fontsets. */
123 static Lisp_Object Vfontset_table
;
125 /* Next possibly free fontset ID. Usually this keeps the mininum
126 fontset ID not yet used. */
127 static int next_fontset_id
;
129 /* The default fontset. This gives default FAMILY and REGISTRY of
130 font for each characters. */
131 static Lisp_Object Vdefault_fontset
;
133 Lisp_Object Vfont_encoding_alist
;
134 Lisp_Object Vuse_default_ascent
;
135 Lisp_Object Vignore_relative_composition
;
136 Lisp_Object Valternate_fontname_alist
;
137 Lisp_Object Vfontset_alias_alist
;
138 Lisp_Object Vhighlight_wrong_size_font
;
139 Lisp_Object Vclip_large_size_font
;
140 Lisp_Object Vvertical_centering_font_regexp
;
142 /* The following six are declarations of callback functions depending
143 on window system. See the comments in src/fontset.h for more
146 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
147 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
149 /* Return a list of font names which matches PATTERN. See the document of
150 `x-list-fonts' for more detail. */
151 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
156 /* Load a font named NAME for frame F and return a pointer to the
157 information of the loaded font. If loading is failed, return 0. */
158 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
160 /* Return a pointer to struct font_info of a font named NAME for frame F. */
161 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
163 /* Additional function for setting fontset or changing fontset
164 contents of frame F. */
165 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
166 Lisp_Object oldval
));
168 /* To find a CCL program, fs_load_font calls this function.
169 The argument is a pointer to the struct font_info.
170 This function set the memer `encoder' of the structure. */
171 void (*find_ccl_program_func
) P_ ((struct font_info
*));
173 /* Check if any window system is used now. */
174 void (*check_window_system_func
) P_ ((void));
177 /* Prototype declarations for static functions. */
178 static Lisp_Object fontset_ref
P_ ((Lisp_Object
, int));
179 static void fontset_set
P_ ((Lisp_Object
, int, Lisp_Object
));
180 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
181 static int fontset_id_valid_p
P_ ((int));
182 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
183 static Lisp_Object font_family_registry
P_ ((Lisp_Object
));
186 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
188 /* Return the fontset with ID. No check of ID's validness. */
189 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
191 /* Macros to access special values of FONTSET. */
192 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
193 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
194 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
195 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0]
196 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
198 #define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
201 /* Return the element of FONTSET (char-table) at index C (character). */
203 #define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
206 fontset_ref (fontset
, c
)
211 Lisp_Object elt
, defalt
;
214 if (SINGLE_BYTE_CHAR_P (c
))
215 return FONTSET_ASCII (fontset
);
217 SPLIT_CHAR (c
, charset
, c1
, c2
);
218 elt
= XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
219 if (!SUB_CHAR_TABLE_P (elt
))
221 defalt
= XCHAR_TABLE (elt
)->defalt
;
223 || (elt
= XCHAR_TABLE (elt
)->contents
[c1
],
226 if (!SUB_CHAR_TABLE_P (elt
))
228 defalt
= XCHAR_TABLE (elt
)->defalt
;
230 || (elt
= XCHAR_TABLE (elt
)->contents
[c2
],
237 #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
240 fontset_ref_via_base (fontset
, c
)
247 if (SINGLE_BYTE_CHAR_P (*c
))
248 return FONTSET_ASCII (fontset
);
250 elt
= FONTSET_REF (FONTSET_BASE (fontset
), *c
);
251 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
))
252 elt
= FONTSET_REF (Vdefault_fontset
, *c
);
256 *c
= XINT (XCAR (elt
));
257 SPLIT_CHAR (*c
, charset
, c1
, c2
);
258 elt
= XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
260 return (SUB_CHAR_TABLE_P (elt
) ? XCHAR_TABLE (elt
)->defalt
: elt
);
261 if (!SUB_CHAR_TABLE_P (elt
))
263 elt
= XCHAR_TABLE (elt
)->contents
[c1
];
265 return (SUB_CHAR_TABLE_P (elt
) ? XCHAR_TABLE (elt
)->defalt
: elt
);
266 if (!SUB_CHAR_TABLE_P (elt
))
268 elt
= XCHAR_TABLE (elt
)->contents
[c2
];
273 /* Store into the element of FONTSET at index C the value NEWELT. */
274 #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
277 fontset_set (fontset
, c
, newelt
)
282 int charset
, code
[3];
283 Lisp_Object
*elt
, tmp
;
286 if (SINGLE_BYTE_CHAR_P (c
))
288 FONTSET_ASCII (fontset
) = newelt
;
292 SPLIT_CHAR (c
, charset
, code
[0], code
[1]);
293 code
[2] = 0; /* anchor */
294 elt
= &XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
295 for (i
= 0; code
[i
] > 0; i
++)
297 if (!SUB_CHAR_TABLE_P (*elt
))
298 *elt
= make_sub_char_table (*elt
);
299 elt
= &XCHAR_TABLE (*elt
)->contents
[code
[i
]];
301 if (SUB_CHAR_TABLE_P (*elt
))
302 XCHAR_TABLE (*elt
)->defalt
= newelt
;
308 /* Return a newly created fontset with NAME. If BASE is nil, make a
309 base fontset. Otherwise make a realized fontset whose parent is
313 make_fontset (frame
, name
, base
)
314 Lisp_Object frame
, name
, base
;
316 Lisp_Object fontset
, elt
, base_elt
;
317 int size
= ASIZE (Vfontset_table
);
318 int id
= next_fontset_id
;
321 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
322 the next available fontset ID. So it is expected that this loop
323 terminates quickly. In addition, as the last element of
324 Vfotnset_table is always nil, we don't have to check the range of
326 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
333 tem
= Fmake_vector (make_number (size
+ 8), Qnil
);
334 for (i
= 0; i
< size
; i
++)
335 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
336 Vfontset_table
= tem
;
339 fontset
= Fmake_char_table (Qfontset
, Qnil
);
341 FONTSET_ID (fontset
) = make_number (id
);
342 FONTSET_NAME (fontset
) = name
;
343 FONTSET_FRAME (fontset
) = frame
;
344 FONTSET_BASE (fontset
) = base
;
346 AREF (Vfontset_table
, id
) = fontset
;
347 next_fontset_id
= id
+ 1;
352 /* Return 1 if ID is a valid fontset id, else return 0. */
355 fontset_id_valid_p (id
)
358 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
362 /* Extract `family' and `registry' string from FONTNAME and set in
363 *FAMILY and *REGISTRY respectively. Actually, `family' may also
364 contain `foundry', `registry' may also contain `encoding' of
368 font_family_registry (fontname
)
369 Lisp_Object fontname
;
371 Lisp_Object family
, registry
;
372 char *p
= XSTRING (fontname
)->data
;
376 while (*p
&& i
< 15) if (*p
++ == '-') sep
[i
++] = p
;
380 family
= make_unibyte_string (sep
[0], sep
[2] - 1 - sep
[0]);
381 registry
= make_unibyte_string (sep
[12], p
- sep
[12]);
382 return Fcons (family
, registry
);
386 /********** INTERFACES TO xfaces.c and dispextern.h **********/
388 /* Return name of the fontset with ID. */
395 fontset
= FONTSET_FROM_ID (id
);
396 return FONTSET_NAME (fontset
);
400 /* Return ASCII font name of the fontset with ID. */
406 Lisp_Object fontset
, elt
;
407 fontset
= FONTSET_FROM_ID (id
);
408 elt
= FONTSET_ASCII (fontset
);
413 /* Free fontset of FACE. Called from free_realized_face. */
416 free_face_fontset (f
, face
)
420 if (fontset_id_valid_p (face
->fontset
))
422 AREF (Vfontset_table
, face
->fontset
) = Qnil
;
423 if (face
->fontset
< next_fontset_id
)
424 next_fontset_id
= face
->fontset
;
429 /* Return 1 iff FACE is suitable for displaying character C.
430 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
431 when C is not a single byte character.. */
434 face_suitable_for_char_p (face
, c
)
438 Lisp_Object fontset
, elt
;
440 if (SINGLE_BYTE_CHAR_P (c
))
441 return (face
== face
->ascii_face
);
443 xassert (fontset_id_valid_p (face
->fontset
));
444 fontset
= FONTSET_FROM_ID (face
->fontset
);
445 xassert (!BASE_FONTSET_P (fontset
));
447 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
448 return (!NILP (elt
) && face
->id
== XFASTINT (elt
));
452 /* Return ID of face suitable for displaying character C on frame F.
453 The selection of face is done based on the fontset of FACE. FACE
454 should already have been realized for ASCII characters. Called
455 from the macro FACE_FOR_CHAR when C is not a single byte character. */
458 face_for_char (f
, face
, c
)
463 Lisp_Object fontset
, elt
;
466 xassert (fontset_id_valid_p (face
->fontset
));
467 fontset
= FONTSET_FROM_ID (face
->fontset
);
468 xassert (!BASE_FONTSET_P (fontset
));
470 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
474 /* No face is recorded for C in the fontset of FACE. Make a new
475 realized face for C that has the same fontset. */
476 face_id
= lookup_face (f
, face
->lface
, c
, face
);
478 /* Record the face ID in FONTSET at the same index as the
479 information in the base fontset. */
480 FONTSET_SET (fontset
, c
, make_number (face_id
));
485 /* Make a realized fontset for ASCII face FACE on frame F from the
486 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
487 default fontset as the base. Value is the id of the new fontset.
488 Called from realize_x_face. */
491 make_fontset_for_ascii_face (f
, base_fontset_id
)
495 Lisp_Object base_fontset
, fontset
, name
, frame
;
497 XSETFRAME (frame
, f
);
498 if (base_fontset_id
>= 0)
500 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
501 if (!BASE_FONTSET_P (base_fontset
))
502 base_fontset
= FONTSET_BASE (base_fontset
);
503 xassert (BASE_FONTSET_P (base_fontset
));
506 base_fontset
= Vdefault_fontset
;
508 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
509 return XINT (FONTSET_ID (fontset
));
513 /* Return the font name pattern for C that is recorded in the fontset
514 with ID. A font is opened by that pattern to get the fullname. If
515 the fullname conform to XLFD, extract foundry-family field and
516 registry-encoding field, and return the cons of them. Otherwise
517 return the fullname. If ID is -1, or the fontset doesn't contain
518 information about C, get the registry and encoding of C from the
519 default fontset. Called from choose_face_font. */
522 fontset_font_pattern (f
, id
, c
)
526 Lisp_Object fontset
, elt
;
527 struct font_info
*fontp
;
528 Lisp_Object family_registry
;
531 if (fontset_id_valid_p (id
))
533 fontset
= FONTSET_FROM_ID (id
);
534 xassert (!BASE_FONTSET_P (fontset
));
535 fontset
= FONTSET_BASE (fontset
);
536 elt
= FONTSET_REF (fontset
, c
);
539 elt
= FONTSET_REF (Vdefault_fontset
, c
);
543 if (CONSP (XCDR (elt
)))
546 /* The fontset specifies only a font name pattern (not cons of
547 family and registry). Try to open a font by that pattern and get
548 a registry from the full name of the opened font. We ignore
549 family name here because it should be wild card in the fontset
552 xassert (STRINGP (elt
));
553 fontp
= FS_LOAD_FONT (f
, c
, XSTRING (elt
)->data
, -1);
557 family_registry
= font_family_registry (build_string (fontp
->full_name
));
558 if (!CONSP (family_registry
))
559 return family_registry
;
560 XCAR (family_registry
) = Qnil
;
561 return family_registry
;
565 /* Load a font named FONTNAME to display character C on frame F.
566 Return a pointer to the struct font_info of the loaded font. If
567 loading fails, return NULL. If FACE is non-zero and a fontset is
568 assigned to it, record FACE->id in the fontset for C. If FONTNAME
569 is NULL, the name is taken from the fontset of FACE or what
573 fs_load_font (f
, c
, fontname
, id
, face
)
581 Lisp_Object list
, elt
;
584 struct font_info
*fontp
;
585 int charset
= CHAR_CHARSET (c
);
592 fontset
= FONTSET_FROM_ID (id
);
595 && !BASE_FONTSET_P (fontset
))
597 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
600 /* A suitable face for C is already recorded, which means
601 that a proper font is already loaded. */
602 int face_id
= XINT (elt
);
604 xassert (face_id
== face
->id
);
605 face
= FACE_FROM_ID (f
, face_id
);
606 return (*get_font_info_func
) (f
, face
->font_info_id
);
609 if (!fontname
&& charset
== CHARSET_ASCII
)
611 elt
= FONTSET_ASCII (fontset
);
612 fontname
= XSTRING (XCDR (elt
))->data
;
617 /* No way to get fontname. */
620 fontp
= (*load_font_func
) (f
, fontname
, size
);
624 /* Fill in members (charset, vertical_centering, encoding, etc) of
625 font_info structure that are not set by (*load_font_func). */
626 fontp
->charset
= charset
;
628 fontp
->vertical_centering
629 = (STRINGP (Vvertical_centering_font_regexp
)
630 && (fast_c_string_match_ignore_case
631 (Vvertical_centering_font_regexp
, fontp
->full_name
) >= 0));
633 if (fontp
->encoding
[1] != FONT_ENCODING_NOT_DECIDED
)
635 /* The font itself tells which code points to be used. Use this
636 encoding for all other charsets. */
639 fontp
->encoding
[0] = fontp
->encoding
[1];
640 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
641 fontp
->encoding
[i
] = fontp
->encoding
[1];
645 /* The font itself doesn't have information about encoding. */
648 fontname
= fontp
->full_name
;
649 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
650 others is 1 (i.e. 0x80..0xFF). */
651 fontp
->encoding
[0] = 0;
652 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
653 fontp
->encoding
[i
] = 1;
654 /* Then override them by a specification in Vfont_encoding_alist. */
655 for (list
= Vfont_encoding_alist
; CONSP (list
); list
= XCDR (list
))
659 && STRINGP (XCAR (elt
)) && CONSP (XCDR (elt
))
660 && (fast_c_string_match_ignore_case (XCAR (elt
), fontname
)
665 for (tmp
= XCDR (elt
); CONSP (tmp
); tmp
= XCDR (tmp
))
666 if (CONSP (XCAR (tmp
))
667 && ((i
= get_charset_id (XCAR (XCAR (tmp
))))
669 && INTEGERP (XCDR (XCAR (tmp
)))
670 && XFASTINT (XCDR (XCAR (tmp
))) < 4)
672 = XFASTINT (XCDR (XCAR (tmp
)));
677 fontp
->font_encoder
= (struct ccl_program
*) 0;
679 if (find_ccl_program_func
)
680 (*find_ccl_program_func
) (fontp
);
682 /* If we loaded a font for a face that has fontset, record the face
683 ID in the fontset for C. */
686 && !BASE_FONTSET_P (fontset
))
687 FONTSET_SET (fontset
, c
, make_number (face
->id
));
692 /* Cache data used by fontset_pattern_regexp. The car part is a
693 pattern string containing at least one wild card, the cdr part is
694 the corresponding regular expression. */
695 static Lisp_Object Vcached_fontset_data
;
697 #define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
698 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
700 /* If fontset name PATTERN contains any wild card, return regular
701 expression corresponding to PATTERN. */
704 fontset_pattern_regexp (pattern
)
707 if (!index (XSTRING (pattern
)->data
, '*')
708 && !index (XSTRING (pattern
)->data
, '?'))
709 /* PATTERN does not contain any wild cards. */
712 if (!CONSP (Vcached_fontset_data
)
713 || strcmp (XSTRING (pattern
)->data
, CACHED_FONTSET_NAME
))
715 /* We must at first update the cached data. */
716 char *regex
= (char *) alloca (XSTRING (pattern
)->size
* 2);
717 char *p0
, *p1
= regex
;
719 /* Convert "*" to ".*", "?" to ".". */
721 for (p0
= (char *) XSTRING (pattern
)->data
; *p0
; p0
++)
736 Vcached_fontset_data
= Fcons (build_string (XSTRING (pattern
)->data
),
737 build_string (regex
));
740 return CACHED_FONTSET_REGEX
;
743 /* Return ID of the base fontset named NAME. If there's no such
744 fontset, return -1. */
747 fs_query_fontset (name
, regexpp
)
751 Lisp_Object fontset
, tem
;
754 name
= Fdowncase (name
);
757 tem
= Frassoc (name
, Vfontset_alias_alist
);
758 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
762 tem
= fontset_pattern_regexp (name
);
771 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
774 unsigned char *this_name
;
776 fontset
= FONTSET_FROM_ID (i
);
778 || !BASE_FONTSET_P (fontset
))
781 this_name
= XSTRING (FONTSET_NAME (fontset
))->data
;
783 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
784 : !strcmp (XSTRING (name
)->data
, this_name
))
791 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
792 "Return the name of a fontset that matches PATTERN.\n\
793 The value is nil if there is no matching fontset.\n\
794 PATTERN can contain `*' or `?' as a wildcard\n\
795 just as X font name matching algorithm allows.\n\
796 If REGEXPP is non-nil, PATTERN is a regular expression.")
798 Lisp_Object pattern
, regexpp
;
803 (*check_window_system_func
) ();
805 CHECK_STRING (pattern
, 0);
807 if (XSTRING (pattern
)->size
== 0)
810 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
814 fontset
= FONTSET_FROM_ID (id
);
815 return FONTSET_NAME (fontset
);
818 /* Return a list of base fontset names matching PATTERN on frame F.
819 If SIZE is not 0, it is the size (maximum bound width) of fontsets
823 list_fontsets (f
, pattern
, size
)
828 Lisp_Object frame
, regexp
, val
, tail
;
831 XSETFRAME (frame
, f
);
833 regexp
= fontset_pattern_regexp (pattern
);
836 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
841 fontset
= FONTSET_FROM_ID (id
);
843 || !BASE_FONTSET_P (fontset
)
844 || !EQ (frame
, FONTSET_FRAME (fontset
)))
846 name
= XSTRING (FONTSET_NAME (fontset
))->data
;
849 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
850 : strcmp (XSTRING (pattern
)->data
, name
))
855 struct font_info
*fontp
;
856 fontp
= FS_LOAD_FONT (f
, 0, NULL
, id
);
857 if (!fontp
|| size
!= fontp
->size
)
860 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
866 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
867 "Create a new fontset NAME that contains font information in FONTLIST.\n\
868 FONTLIST is an alist of charsets vs corresponding font name patterns.")
870 Lisp_Object name
, fontlist
;
872 Lisp_Object fontset
, elements
, ascii_font
;
873 Lisp_Object tem
, tail
, elt
;
875 (*check_window_system_func
) ();
877 CHECK_STRING (name
, 0);
878 CHECK_LIST (fontlist
, 1);
880 name
= Fdowncase (name
);
881 tem
= Fquery_fontset (name
, Qnil
);
883 error ("Fontset `%s' matches the existing fontset `%s'",
884 XSTRING (name
)->data
, XSTRING (tem
)->data
);
886 /* Check the validity of FONTLIST while creating a template for
888 elements
= ascii_font
= Qnil
;
889 for (tail
= fontlist
; CONSP (tail
); tail
= XCDR (tail
))
891 Lisp_Object family
, registry
;
896 || (charset
= get_charset_id (XCAR (tem
))) < 0
897 || !STRINGP (XCDR (tem
)))
898 error ("Elements of fontlist must be a cons of charset and font name");
900 tem
= Fdowncase (XCDR (tem
));
901 if (charset
== CHARSET_ASCII
)
905 c
= MAKE_CHAR (charset
, 0, 0);
906 elements
= Fcons (Fcons (make_number (c
), tem
), elements
);
910 if (NILP (ascii_font
))
911 error ("No ASCII font in the fontlist");
913 fontset
= make_fontset (Qnil
, name
, Qnil
);
914 FONTSET_ASCII (fontset
) = Fcons (make_number (0), ascii_font
);
915 for (; CONSP (elements
); elements
= XCDR (elements
))
917 elt
= XCAR (elements
);
918 tem
= Fcons (XCAR (elt
), font_family_registry (XCDR (elt
)));
919 FONTSET_SET (fontset
, XINT (XCAR (elt
)), tem
);
926 /* Clear all elements of FONTSET for multibyte characters. */
929 clear_fontset_elements (fontset
)
934 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
935 XCHAR_TABLE (fontset
)->contents
[i
] = Qnil
;
939 /* Check validity of NAME as a fontset name and return the
940 corresponding fontset. If not valid, signal an error.
941 If NAME is t, return Vdefault_fontset. */
944 check_fontset_name (name
)
950 return Vdefault_fontset
;
952 CHECK_STRING (name
, 0);
953 id
= fs_query_fontset (name
, 0);
955 error ("Fontset `%s' does not exist", XSTRING (name
)->data
);
956 return FONTSET_FROM_ID (id
);
959 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 4, 0,
960 "Modify fontset NAME to use FONTNAME for CHARACTER.\n\
962 CHARACTER may be a cons; (FROM . TO), where FROM and TO are\n\
963 non-generic characters. In that case, use FONTNAME\n\
964 for all characters in the range FROM and TO (inclusive).\n\
965 CHARACTER may be a charset. In that case, use FONTNAME\n\
966 for all character in the charsets.\n\
968 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family\n\
969 name of a font, REGSITRY is a registry name of a font.")
970 (name
, character
, fontname
, frame
)
971 Lisp_Object name
, character
, fontname
, frame
;
973 Lisp_Object fontset
, elt
;
974 Lisp_Object realized
;
977 Lisp_Object family
, registry
;
979 fontset
= check_fontset_name (name
);
981 if (CONSP (character
))
983 /* CH should be (FROM . TO) where FROM and TO are non-generic
985 CHECK_NUMBER (XCAR (character
), 1);
986 CHECK_NUMBER (XCDR (character
), 1);
987 from
= XINT (XCAR (character
));
988 to
= XINT (XCDR (character
));
989 if (!char_valid_p (from
, 0) || !char_valid_p (to
, 0))
990 error ("Character range should be by non-generic characters.");
992 && (SINGLE_BYTE_CHAR_P (from
) || SINGLE_BYTE_CHAR_P (to
)))
993 error ("Can't change font for a single byte character");
995 else if (SYMBOLP (character
))
997 elt
= Fget (character
, Qcharset
);
998 if (!VECTORP (elt
) || ASIZE (elt
) < 1 || !NATNUMP (AREF (elt
, 0)))
999 error ("Invalid charset: %s", (XSYMBOL (character
)->name
)->data
);
1000 from
= MAKE_CHAR (XINT (AREF (elt
, 0)), 0, 0);
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
);
1033 CHECK_STRING (family
, 2);
1034 family
= Fdowncase (family
);
1036 if (!NILP (registry
))
1038 CHECK_STRING (registry
, 2);
1039 registry
= Fdowncase (registry
);
1041 elt
= Fcons (make_number (from
), Fcons (family
, registry
));
1044 /* The arg FRAME is kept for backward compatibility. We only check
1047 CHECK_LIVE_FRAME (frame
, 3);
1049 for (; from
<= to
; from
++)
1050 FONTSET_SET (fontset
, from
, elt
);
1051 Foptimize_char_table (fontset
);
1053 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1054 clear all the elements of REALIZED and free all multibyte faces
1055 whose fontset is REALIZED. This way, the specified character(s)
1056 are surely redisplayed by a correct font. */
1057 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1059 realized
= AREF (Vfontset_table
, id
);
1060 if (!NILP (realized
)
1061 && !BASE_FONTSET_P (realized
)
1062 && EQ (FONTSET_BASE (realized
), fontset
))
1064 FRAME_PTR f
= XFRAME (FONTSET_FRAME (realized
));
1065 clear_fontset_elements (realized
);
1066 free_realized_multibyte_face (f
, id
);
1073 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1074 "Return information about a font named NAME on frame FRAME.\n\
1075 If FRAME is omitted or nil, use the selected frame.\n\
1076 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
1077 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
1079 OPENED-NAME is the name used for opening the font,\n\
1080 FULL-NAME is the full name of the font,\n\
1081 SIZE is the maximum bound width of the font,\n\
1082 HEIGHT is the height of the font,\n\
1083 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
1084 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
1085 how to compose characters.\n\
1086 If the named font is not yet loaded, return nil.")
1088 Lisp_Object name
, frame
;
1091 struct font_info
*fontp
;
1094 (*check_window_system_func
) ();
1096 CHECK_STRING (name
, 0);
1097 name
= Fdowncase (name
);
1099 frame
= selected_frame
;
1100 CHECK_LIVE_FRAME (frame
, 1);
1103 if (!query_font_func
)
1104 error ("Font query function is not supported");
1106 fontp
= (*query_font_func
) (f
, XSTRING (name
)->data
);
1110 info
= Fmake_vector (make_number (7), Qnil
);
1112 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1113 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1114 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1115 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1116 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1117 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1118 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1124 /* Return the font name for the character at POSITION in the current
1125 buffer. This is computed from all the text properties and overlays
1126 that apply to POSITION. It returns nil in the following cases:
1128 (1) The window system doesn't have a font for the character (thus
1129 it is displayed by an empty box).
1131 (2) The character code is invalid.
1133 (3) The current buffer is not displayed in any window.
1135 In addition, the returned font name may not take into account of
1136 such redisplay engine hooks as what used in jit-lock-mode if
1137 POSITION is currently not visible. */
1140 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1141 "For internal use only.")
1143 Lisp_Object position
;
1145 int pos
, pos_byte
, dummy
;
1153 CHECK_NUMBER_COERCE_MARKER (position
, 0);
1154 pos
= XINT (position
);
1155 if (pos
< BEGV
|| pos
>= ZV
)
1156 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1157 pos_byte
= CHAR_TO_BYTE (pos
);
1158 c
= FETCH_CHAR (pos_byte
);
1159 if (! CHAR_VALID_P (c
, 0))
1161 window
= Fget_buffer_window (Fcurrent_buffer (), Qt
);
1164 w
= XWINDOW (window
);
1165 f
= XFRAME (w
->frame
);
1166 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1167 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
);
1168 face
= FACE_FROM_ID (f
, face_id
);
1169 return (face
->font
&& face
->font_name
1170 ? build_string (face
->font_name
)
1175 /* Called from Ffontset_info via map_char_table on each leaf of
1176 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1177 ARG)' and FONT-INFOs have this form:
1178 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1179 The current leaf is indexed by CHARACTER and has value ELT. This
1180 function add the information of the current leaf to ARG by
1181 appending a new element or modifying the last element.. */
1184 accumulate_font_info (arg
, character
, elt
)
1185 Lisp_Object arg
, character
, elt
;
1187 Lisp_Object last
, last_char
, last_elt
, tmp
;
1189 if (!CONSP (elt
) && !SINGLE_BYTE_CHAR_P (XINT (character
)))
1190 elt
= FONTSET_REF (Vdefault_fontset
, XINT (character
));
1194 last_char
= XCAR (XCAR (last
));
1195 last_elt
= XCAR (XCDR (XCAR (last
)));
1197 if (!NILP (Fequal (elt
, last_elt
)))
1199 int this_charset
= CHAR_CHARSET (XINT (character
));
1201 if (CONSP (last_char
)) /* LAST_CHAR == (FROM . TO) */
1203 if (this_charset
== CHAR_CHARSET (XINT (XCAR (last_char
))))
1205 XCDR (last_char
) = character
;
1209 else if (XINT (last_char
) == XINT (character
))
1211 else if (this_charset
== CHAR_CHARSET (XINT (last_char
)))
1213 XCAR (XCAR (last
)) = Fcons (last_char
, character
);
1217 XCDR (last
) = Fcons (Fcons (character
, Fcons (elt
, Qnil
)), Qnil
);
1218 XCAR (arg
) = XCDR (last
);
1222 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1223 "Return information about a fontset named NAME on frame FRAME.\n\
1224 The value is a vector:\n\
1225 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],\n\
1227 SIZE is the maximum bound width of ASCII font in the fontset,\n\
1228 HEIGHT is the maximum bound height of ASCII font in the fontset,\n\
1229 CHARSET-OR-RANGE is a charset, a character (may be a generic character)\n\
1230 or a cons of two characters specifying the range of characters.\n\
1231 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),\n\
1232 where FAMILY is a `FAMILY' field of a XLFD font name,\n\
1233 REGISTRY is a `CHARSET_REGISTRY' field of a XLDF font name.\n\
1234 FAMILY may contain a `FOUNDARY' field at the head.\n\
1235 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.\n\
1236 OPENEDs are names of fonts actually opened.\n\
1237 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.\n\
1238 If FRAME is omitted, it defaults to the currently selected frame.")
1240 Lisp_Object name
, frame
;
1242 Lisp_Object fontset
;
1244 Lisp_Object indices
[3];
1245 Lisp_Object val
, tail
, elt
;
1246 Lisp_Object
*realized
;
1247 struct font_info
*fontp
= NULL
;
1251 (*check_window_system_func
) ();
1253 fontset
= check_fontset_name (name
);
1256 frame
= selected_frame
;
1257 CHECK_LIVE_FRAME (frame
, 1);
1260 /* Recode realized fontsets whose base is FONTSET in the table
1262 realized
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1263 * ASIZE (Vfontset_table
));
1264 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1266 elt
= FONTSET_FROM_ID (i
);
1268 && EQ (FONTSET_BASE (elt
), fontset
))
1269 realized
[n_realized
++] = elt
;
1272 /* Accumulate information of the fontset in VAL. The format is
1273 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1274 FONT-SPEC). See the comment for accumulate_font_info for the
1276 val
= Fcons (Fcons (make_number (0),
1277 Fcons (XCDR (FONTSET_ASCII (fontset
)), Qnil
)),
1279 val
= Fcons (val
, val
);
1280 map_char_table (accumulate_font_info
, Qnil
, fontset
, val
, 0, indices
);
1283 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1284 character for a charset, replace it with the charset symbol. If
1285 fonts are opened for FONT-SPEC, append the names of the fonts to
1287 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
1291 if (INTEGERP (XCAR (elt
)))
1293 int charset
, c1
, c2
;
1294 c
= XINT (XCAR (elt
));
1295 SPLIT_CHAR (c
, charset
, c1
, c2
);
1297 XCAR (elt
) = CHARSET_SYMBOL (charset
);
1300 c
= XINT (XCAR (XCAR (elt
)));
1301 for (i
= 0; i
< n_realized
; i
++)
1303 Lisp_Object face_id
, font
;
1306 face_id
= FONTSET_REF_VIA_BASE (realized
[i
], c
);
1307 if (INTEGERP (face_id
))
1309 face
= FACE_FROM_ID (f
, XINT (face_id
));
1310 if (face
->font
&& face
->font_name
)
1312 font
= build_string (face
->font_name
);
1313 if (NILP (Fmember (font
, XCDR (XCDR (elt
)))))
1314 XCDR (XCDR (elt
)) = Fcons (font
, XCDR (XCDR (elt
)));
1320 elt
= Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII
), val
)));
1324 fontp
= (*query_font_func
) (f
, XSTRING (elt
)->data
);
1326 val
= Fmake_vector (make_number (3), val
);
1327 AREF (val
, 0) = fontp
? make_number (fontp
->size
) : make_number (0);
1328 AREF (val
, 1) = fontp
? make_number (fontp
->height
) : make_number (0);
1332 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1333 "Return a font name pattern for character CH in fontset NAME.\n\
1334 If NAME is t, find a font name pattern in the default fontset.")
1336 Lisp_Object name
, ch
;
1339 Lisp_Object fontset
, elt
;
1341 fontset
= check_fontset_name (name
);
1343 CHECK_NUMBER (ch
, 1);
1345 if (!char_valid_p (c
, 1))
1346 invalid_character (c
);
1348 elt
= FONTSET_REF (fontset
, c
);
1356 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1357 "Return a list of all defined fontset names.")
1360 Lisp_Object fontset
, list
;
1364 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1366 fontset
= FONTSET_FROM_ID (i
);
1368 && BASE_FONTSET_P (fontset
))
1369 list
= Fcons (FONTSET_NAME (fontset
), list
);
1380 if (!load_font_func
)
1381 /* Window system initializer should have set proper functions. */
1384 Qfontset
= intern ("fontset");
1385 staticpro (&Qfontset
);
1386 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (3));
1388 Vcached_fontset_data
= Qnil
;
1389 staticpro (&Vcached_fontset_data
);
1391 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1392 staticpro (&Vfontset_table
);
1394 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1395 staticpro (&Vdefault_fontset
);
1396 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1397 FONTSET_NAME (Vdefault_fontset
)
1398 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1399 FONTSET_ASCII (Vdefault_fontset
)
1400 = Fcons (make_number (0),
1401 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1402 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1403 next_fontset_id
= 1;
1405 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1406 "Alist of fontname patterns vs corresponding encoding info.\n\
1407 Each element looks like (REGEXP . ENCODING-INFO),\n\
1408 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
1409 ENCODING is one of the following integer values:\n\
1410 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
1411 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
1412 2: code points 0x20A0..0x7FFF are used,\n\
1413 3: code points 0xA020..0xFF7F are used.");
1414 Vfont_encoding_alist
= Qnil
;
1416 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1417 "Char table of characters whose ascent values should be ignored.\n\
1418 If an entry for a character is non-nil, the ascent value of the glyph\n\
1419 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
1421 This affects how a composite character which contains\n\
1422 such a character is displayed on screen.");
1423 Vuse_default_ascent
= Qnil
;
1425 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1426 "Char table of characters which is not composed relatively.\n\
1427 If an entry for a character is non-nil, a composition sequence\n\
1428 which contains that character is displayed so that\n\
1429 the glyph of that character is put without considering\n\
1430 an ascent and descent value of a previous character.");
1431 Vignore_relative_composition
= Qnil
;
1433 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1434 "Alist of fontname vs list of the alternate fontnames.\n\
1435 When a specified font name is not found, the corresponding\n\
1436 alternate fontnames (if any) are tried instead.");
1437 Valternate_fontname_alist
= Qnil
;
1439 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1440 "Alist of fontset names vs the aliases.");
1441 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1442 build_string ("fontset-default")),
1445 DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font
,
1446 "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
1447 The way to highlight them depends on window system on which Emacs runs.\n\
1448 On X11, a rectangle is shown around each such character.");
1449 Vhighlight_wrong_size_font
= Qnil
;
1451 DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font
,
1452 "*Non-nil means characters shown in overlarge fonts are clipped.\n\
1453 The height of clipping area is the same as that of an ASCII character.\n\
1454 The width of the area is the same as that of an ASCII character,\n\
1455 or twice as wide, depending on the character set's column-width.\n\
1457 If the only font you have for a specific character set is too large,\n\
1458 and clipping these characters makes them hard to read,\n\
1459 you can set this variable to nil to display the characters without clipping.\n\
1460 The drawback is that you will get some garbage left on your screen.");
1461 Vclip_large_size_font
= Qt
;
1463 DEFVAR_LISP ("vertical-centering-font-regexp",
1464 &Vvertical_centering_font_regexp
,
1465 "*Regexp matching font names that require vertical centering on display.\n\
1466 When a character is displayed with such fonts, the character is displayed\n\
1467 at the vertival center of lines.");
1468 Vvertical_centering_font_regexp
= Qnil
;
1470 defsubr (&Squery_fontset
);
1471 defsubr (&Snew_fontset
);
1472 defsubr (&Sset_fontset_font
);
1473 defsubr (&Sfont_info
);
1474 defsubr (&Sinternal_char_font
);
1475 defsubr (&Sfontset_info
);
1476 defsubr (&Sfontset_font
);
1477 defsubr (&Sfontset_list
);