2 Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* #define FONTSET_DEBUG */
36 #include "dispextern.h"
42 #define xassert(X) do {if (!(X)) abort ();} while (0)
50 A fontset is a collection of font related information to give
51 similar appearance (style, size, etc) of characters. There are two
52 kinds of fontsets; base and realized. A base fontset is created by
53 new-fontset from Emacs Lisp explicitly. A realized fontset is
54 created implicitly when a face is realized for ASCII characters. A
55 face is also realized for multibyte characters based on an ASCII
56 face. All of the multibyte faces based on the same ASCII face
57 share the same realized fontset.
59 A fontset object is implemented by a char-table.
61 An element of a base fontset is:
63 (INDEX . (FOUNDRY . REGISTRY ))
64 FONTNAME is a font name pattern for the corresponding character.
65 FOUNDRY and REGISTRY are respectively foundy and regisry fields of
66 a font name for the corresponding character. INDEX specifies for
67 which character (or generic character) the element is defined. It
68 may be different from an index to access this element. For
69 instance, if a fontset defines some font for all characters of
70 charset `japanese-jisx0208', INDEX is the generic character of this
71 charset. REGISTRY is the
73 An element of a realized fontset is FACE-ID which is a face to use
74 for displaying the correspnding character.
76 All single byte charaters (ASCII and 8bit-unibyte) share the same
77 element in a fontset. The element is stored in the first element
80 To access or set each element, use macros FONTSET_REF and
81 FONTSET_SET respectively for efficiency.
83 A fontset has 3 extra slots.
85 The 1st slot is an ID number of the fontset.
87 The 2nd slot is a name of the fontset. This is nil for a realized
90 The 3rd slot is a frame that the fontset belongs to. This is nil
93 A parent of a base fontset is nil. A parent of a realized fontset
96 All fontsets are recorded in Vfontset_table.
101 There's a special fontset named `default fontset' which defines a
102 default fontname pattern. When a base fontset doesn't specify a
103 font for a specific character, the corresponding value in the
104 default fontset is used. The format is the same as a base fontset.
106 The parent of a realized fontset created for such a face that has
107 no fontset is the default fontset.
110 These structures are hidden from the other codes than this file.
111 The other codes handle fontsets only by their ID numbers. They
112 usually use variable name `fontset' for IDs. But, in this file, we
113 always use varialbe name `id' for IDs, and name `fontset' for the
114 actual fontset objects.
118 /********** VARIABLES and FUNCTION PROTOTYPES **********/
120 extern Lisp_Object Qfont
;
121 Lisp_Object Qfontset
;
123 /* Vector containing all fontsets. */
124 static Lisp_Object Vfontset_table
;
126 /* Next possibly free fontset ID. Usually this keeps the mininum
127 fontset ID not yet used. */
128 static int next_fontset_id
;
130 /* The default fontset. This gives default FAMILY and REGISTRY of
131 font for each characters. */
132 static Lisp_Object Vdefault_fontset
;
134 Lisp_Object Vfont_encoding_alist
;
135 Lisp_Object Vuse_default_ascent
;
136 Lisp_Object Vignore_relative_composition
;
137 Lisp_Object Valternate_fontname_alist
;
138 Lisp_Object Vfontset_alias_alist
;
139 Lisp_Object Vhighlight_wrong_size_font
;
140 Lisp_Object Vclip_large_size_font
;
141 Lisp_Object Vvertical_centering_font_regexp
;
143 /* The following six are declarations of callback functions depending
144 on window system. See the comments in src/fontset.h for more
147 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
148 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
150 /* Return a list of font names which matches PATTERN. See the document of
151 `x-list-fonts' for more detail. */
152 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
157 /* Load a font named NAME for frame F and return a pointer to the
158 information of the loaded font. If loading is failed, return 0. */
159 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
161 /* Return a pointer to struct font_info of a font named NAME for frame F. */
162 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
164 /* Additional function for setting fontset or changing fontset
165 contents of frame F. */
166 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
167 Lisp_Object oldval
));
169 /* To find a CCL program, fs_load_font calls this function.
170 The argument is a pointer to the struct font_info.
171 This function set the memer `encoder' of the structure. */
172 void (*find_ccl_program_func
) P_ ((struct font_info
*));
174 /* Check if any window system is used now. */
175 void (*check_window_system_func
) P_ ((void));
178 /* Prototype declarations for static functions. */
179 static Lisp_Object fontset_ref
P_ ((Lisp_Object
, int));
180 static void fontset_set
P_ ((Lisp_Object
, int, Lisp_Object
));
181 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
182 static int fontset_id_valid_p
P_ ((int));
183 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
184 static Lisp_Object font_family_registry
P_ ((Lisp_Object
, int));
187 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
189 /* Return the fontset with ID. No check of ID's validness. */
190 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
192 /* Macros to access special values of FONTSET. */
193 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
194 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
195 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
196 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0]
197 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
199 #define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
202 /* Return the element of FONTSET (char-table) at index C (character). */
204 #define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
207 fontset_ref (fontset
, c
)
212 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];
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
;
317 int size
= ASIZE (Vfontset_table
);
318 int id
= next_fontset_id
;
320 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
321 the next available fontset ID. So it is expected that this loop
322 terminates quickly. In addition, as the last element of
323 Vfotnset_table is always nil, we don't have to check the range of
325 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
332 tem
= Fmake_vector (make_number (size
+ 8), Qnil
);
333 for (i
= 0; i
< size
; i
++)
334 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
335 Vfontset_table
= tem
;
338 fontset
= Fmake_char_table (Qfontset
, Qnil
);
340 FONTSET_ID (fontset
) = make_number (id
);
341 FONTSET_NAME (fontset
) = name
;
342 FONTSET_FRAME (fontset
) = frame
;
343 FONTSET_BASE (fontset
) = base
;
345 AREF (Vfontset_table
, id
) = fontset
;
346 next_fontset_id
= id
+ 1;
351 /* Return 1 if ID is a valid fontset id, else return 0. */
354 fontset_id_valid_p (id
)
357 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
361 /* Extract `family' and `registry' string from FONTNAME and a cons of
362 them. Actually, `family' may also contain `foundry', `registry'
363 may also contain `encoding' of FONTNAME. But, if FONTNAME doesn't
364 conform to XLFD nor explicitely specifies the other fields
365 (i.e. not using wildcard `*'), return FONTNAME. If FORCE is
366 nonzero, specifications of the other fields are ignored, and return
367 a cons as far as FONTNAME conform to XLFD. */
370 font_family_registry (fontname
, force
)
371 Lisp_Object fontname
;
374 Lisp_Object family
, registry
;
375 char *p
= XSTRING (fontname
)->data
;
382 if (!force
&& i
>= 2 && i
<= 11 && *p
!= '*' && p
[1] != '-')
389 family
= make_unibyte_string (sep
[0], sep
[2] - 1 - sep
[0]);
390 registry
= make_unibyte_string (sep
[12], p
- sep
[12]);
391 return Fcons (family
, registry
);
395 /********** INTERFACES TO xfaces.c and dispextern.h **********/
397 /* Return name of the fontset with ID. */
404 fontset
= FONTSET_FROM_ID (id
);
405 return FONTSET_NAME (fontset
);
409 /* Return ASCII font name of the fontset with ID. */
415 Lisp_Object fontset
, elt
;
416 fontset
= FONTSET_FROM_ID (id
);
417 elt
= FONTSET_ASCII (fontset
);
422 /* Free fontset of FACE. Called from free_realized_face. */
425 free_face_fontset (f
, face
)
429 if (fontset_id_valid_p (face
->fontset
))
431 AREF (Vfontset_table
, face
->fontset
) = Qnil
;
432 if (face
->fontset
< next_fontset_id
)
433 next_fontset_id
= face
->fontset
;
438 /* Return 1 iff FACE is suitable for displaying character C.
439 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
440 when C is not a single byte character.. */
443 face_suitable_for_char_p (face
, c
)
447 Lisp_Object fontset
, elt
;
449 if (SINGLE_BYTE_CHAR_P (c
))
450 return (face
== face
->ascii_face
);
452 xassert (fontset_id_valid_p (face
->fontset
));
453 fontset
= FONTSET_FROM_ID (face
->fontset
);
454 xassert (!BASE_FONTSET_P (fontset
));
456 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
457 return (!NILP (elt
) && face
->id
== XFASTINT (elt
));
461 /* Return ID of face suitable for displaying character C on frame F.
462 The selection of face is done based on the fontset of FACE. FACE
463 should already have been realized for ASCII characters. Called
464 from the macro FACE_FOR_CHAR when C is not a single byte character. */
467 face_for_char (f
, face
, c
)
472 Lisp_Object fontset
, elt
;
475 xassert (fontset_id_valid_p (face
->fontset
));
476 fontset
= FONTSET_FROM_ID (face
->fontset
);
477 xassert (!BASE_FONTSET_P (fontset
));
479 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
483 /* No face is recorded for C in the fontset of FACE. Make a new
484 realized face for C that has the same fontset. */
485 face_id
= lookup_face (f
, face
->lface
, c
, face
);
487 /* Record the face ID in FONTSET at the same index as the
488 information in the base fontset. */
489 FONTSET_SET (fontset
, c
, make_number (face_id
));
494 /* Make a realized fontset for ASCII face FACE on frame F from the
495 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
496 default fontset as the base. Value is the id of the new fontset.
497 Called from realize_x_face. */
500 make_fontset_for_ascii_face (f
, base_fontset_id
)
504 Lisp_Object base_fontset
, fontset
, frame
;
506 XSETFRAME (frame
, f
);
507 if (base_fontset_id
>= 0)
509 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
510 if (!BASE_FONTSET_P (base_fontset
))
511 base_fontset
= FONTSET_BASE (base_fontset
);
512 xassert (BASE_FONTSET_P (base_fontset
));
515 base_fontset
= Vdefault_fontset
;
517 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
518 return XINT (FONTSET_ID (fontset
));
522 /* Return the font name pattern for C that is recorded in the fontset
523 with ID. If a font name pattern is specified (instead of a cons of
524 family and registry), check if a font can be opened by that pattern
525 to get the fullname. If a font is opened, return that name.
526 Otherwise, return nil. If ID is -1, or the fontset doesn't contain
527 information about C, get the registry and encoding of C from the
528 default fontset. Called from choose_face_font. */
531 fontset_font_pattern (f
, id
, c
)
535 Lisp_Object fontset
, elt
;
536 struct font_info
*fontp
;
537 Lisp_Object family_registry
;
540 if (fontset_id_valid_p (id
))
542 fontset
= FONTSET_FROM_ID (id
);
543 xassert (!BASE_FONTSET_P (fontset
));
544 fontset
= FONTSET_BASE (fontset
);
545 elt
= FONTSET_REF (fontset
, c
);
548 elt
= FONTSET_REF (Vdefault_fontset
, c
);
552 if (CONSP (XCDR (elt
)))
555 /* The fontset specifies only a font name pattern (not cons of
556 family and registry). If a font can be opened by that pattern,
557 return the name of opened font. Otherwise return nil. The
558 exception is a font for single byte characters. In that case, we
559 return a cons of FAMILY and REGISTRY extracted from the opened
562 xassert (STRINGP (elt
));
563 fontp
= FS_LOAD_FONT (f
, c
, XSTRING (elt
)->data
, -1);
567 return font_family_registry (build_string (fontp
->full_name
),
568 SINGLE_BYTE_CHAR_P (c
));
572 /* Load a font named FONTNAME to display character C on frame F.
573 Return a pointer to the struct font_info of the loaded font. If
574 loading fails, return NULL. If FACE is non-zero and a fontset is
575 assigned to it, record FACE->id in the fontset for C. If FONTNAME
576 is NULL, the name is taken from the fontset of FACE or what
580 fs_load_font (f
, c
, fontname
, id
, face
)
588 Lisp_Object list
, elt
;
590 struct font_info
*fontp
;
591 int charset
= CHAR_CHARSET (c
);
598 fontset
= FONTSET_FROM_ID (id
);
601 && !BASE_FONTSET_P (fontset
))
603 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
606 /* A suitable face for C is already recorded, which means
607 that a proper font is already loaded. */
608 int face_id
= XINT (elt
);
610 xassert (face_id
== face
->id
);
611 face
= FACE_FROM_ID (f
, face_id
);
612 return (*get_font_info_func
) (f
, face
->font_info_id
);
615 if (!fontname
&& charset
== CHARSET_ASCII
)
617 elt
= FONTSET_ASCII (fontset
);
618 fontname
= XSTRING (XCDR (elt
))->data
;
623 /* No way to get fontname. */
626 fontp
= (*load_font_func
) (f
, fontname
, size
);
630 /* Fill in members (charset, vertical_centering, encoding, etc) of
631 font_info structure that are not set by (*load_font_func). */
632 fontp
->charset
= charset
;
634 fontp
->vertical_centering
635 = (STRINGP (Vvertical_centering_font_regexp
)
636 && (fast_c_string_match_ignore_case
637 (Vvertical_centering_font_regexp
, fontp
->full_name
) >= 0));
639 if (fontp
->encoding
[1] != FONT_ENCODING_NOT_DECIDED
)
641 /* The font itself tells which code points to be used. Use this
642 encoding for all other charsets. */
645 fontp
->encoding
[0] = fontp
->encoding
[1];
646 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
647 fontp
->encoding
[i
] = fontp
->encoding
[1];
651 /* The font itself doesn't have information about encoding. */
654 fontname
= fontp
->full_name
;
655 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
656 others is 1 (i.e. 0x80..0xFF). */
657 fontp
->encoding
[0] = 0;
658 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
659 fontp
->encoding
[i
] = 1;
660 /* Then override them by a specification in Vfont_encoding_alist. */
661 for (list
= Vfont_encoding_alist
; CONSP (list
); list
= XCDR (list
))
665 && STRINGP (XCAR (elt
)) && CONSP (XCDR (elt
))
666 && (fast_c_string_match_ignore_case (XCAR (elt
), fontname
)
671 for (tmp
= XCDR (elt
); CONSP (tmp
); tmp
= XCDR (tmp
))
672 if (CONSP (XCAR (tmp
))
673 && ((i
= get_charset_id (XCAR (XCAR (tmp
))))
675 && INTEGERP (XCDR (XCAR (tmp
)))
676 && XFASTINT (XCDR (XCAR (tmp
))) < 4)
678 = XFASTINT (XCDR (XCAR (tmp
)));
683 fontp
->font_encoder
= (struct ccl_program
*) 0;
685 if (find_ccl_program_func
)
686 (*find_ccl_program_func
) (fontp
);
688 /* If we loaded a font for a face that has fontset, record the face
689 ID in the fontset for C. */
692 && !BASE_FONTSET_P (fontset
))
693 FONTSET_SET (fontset
, c
, make_number (face
->id
));
698 /* Cache data used by fontset_pattern_regexp. The car part is a
699 pattern string containing at least one wild card, the cdr part is
700 the corresponding regular expression. */
701 static Lisp_Object Vcached_fontset_data
;
703 #define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
704 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
706 /* If fontset name PATTERN contains any wild card, return regular
707 expression corresponding to PATTERN. */
710 fontset_pattern_regexp (pattern
)
713 if (!index (XSTRING (pattern
)->data
, '*')
714 && !index (XSTRING (pattern
)->data
, '?'))
715 /* PATTERN does not contain any wild cards. */
718 if (!CONSP (Vcached_fontset_data
)
719 || strcmp (XSTRING (pattern
)->data
, CACHED_FONTSET_NAME
))
721 /* We must at first update the cached data. */
722 char *regex
= (char *) alloca (XSTRING (pattern
)->size
* 2 + 3);
723 char *p0
, *p1
= regex
;
725 /* Convert "*" to ".*", "?" to ".". */
727 for (p0
= (char *) XSTRING (pattern
)->data
; *p0
; p0
++)
742 Vcached_fontset_data
= Fcons (build_string (XSTRING (pattern
)->data
),
743 build_string (regex
));
746 return CACHED_FONTSET_REGEX
;
749 /* Return ID of the base fontset named NAME. If there's no such
750 fontset, return -1. */
753 fs_query_fontset (name
, regexpp
)
760 name
= Fdowncase (name
);
763 tem
= Frassoc (name
, Vfontset_alias_alist
);
764 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
768 tem
= fontset_pattern_regexp (name
);
777 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
780 unsigned char *this_name
;
782 fontset
= FONTSET_FROM_ID (i
);
784 || !BASE_FONTSET_P (fontset
))
787 this_name
= XSTRING (FONTSET_NAME (fontset
))->data
;
789 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
790 : !strcmp (XSTRING (name
)->data
, this_name
))
797 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
798 "Return the name of a fontset that matches PATTERN.\n\
799 The value is nil if there is no matching fontset.\n\
800 PATTERN can contain `*' or `?' as a wildcard\n\
801 just as X font name matching algorithm allows.\n\
802 If REGEXPP is non-nil, PATTERN is a regular expression.")
804 Lisp_Object pattern
, regexpp
;
809 (*check_window_system_func
) ();
811 CHECK_STRING (pattern
, 0);
813 if (XSTRING (pattern
)->size
== 0)
816 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
820 fontset
= FONTSET_FROM_ID (id
);
821 return FONTSET_NAME (fontset
);
824 /* Return a list of base fontset names matching PATTERN on frame F.
825 If SIZE is not 0, it is the size (maximum bound width) of fontsets
829 list_fontsets (f
, pattern
, size
)
834 Lisp_Object frame
, regexp
, val
;
837 XSETFRAME (frame
, f
);
839 regexp
= fontset_pattern_regexp (pattern
);
842 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
847 fontset
= FONTSET_FROM_ID (id
);
849 || !BASE_FONTSET_P (fontset
)
850 || !EQ (frame
, FONTSET_FRAME (fontset
)))
852 name
= XSTRING (FONTSET_NAME (fontset
))->data
;
855 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
856 : strcmp (XSTRING (pattern
)->data
, name
))
861 struct font_info
*fontp
;
862 fontp
= FS_LOAD_FONT (f
, 0, NULL
, id
);
863 if (!fontp
|| size
!= fontp
->size
)
866 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
872 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
873 "Create a new fontset NAME that contains font information in FONTLIST.\n\
874 FONTLIST is an alist of charsets vs corresponding font name patterns.")
876 Lisp_Object name
, fontlist
;
878 Lisp_Object fontset
, elements
, ascii_font
;
879 Lisp_Object tem
, tail
, elt
;
881 (*check_window_system_func
) ();
883 CHECK_STRING (name
, 0);
884 CHECK_LIST (fontlist
, 1);
886 name
= Fdowncase (name
);
887 tem
= Fquery_fontset (name
, Qnil
);
889 error ("Fontset `%s' matches the existing fontset `%s'",
890 XSTRING (name
)->data
, XSTRING (tem
)->data
);
892 /* Check the validity of FONTLIST while creating a template for
894 elements
= ascii_font
= Qnil
;
895 for (tail
= fontlist
; CONSP (tail
); tail
= XCDR (tail
))
901 || (charset
= get_charset_id (XCAR (tem
))) < 0
902 || !STRINGP (XCDR (tem
)))
903 error ("Elements of fontlist must be a cons of charset and font name");
905 tem
= Fdowncase (XCDR (tem
));
906 if (charset
== CHARSET_ASCII
)
910 c
= MAKE_CHAR (charset
, 0, 0);
911 elements
= Fcons (Fcons (make_number (c
), tem
), elements
);
915 if (NILP (ascii_font
))
916 error ("No ASCII font in the fontlist");
918 fontset
= make_fontset (Qnil
, name
, Qnil
);
919 FONTSET_ASCII (fontset
) = Fcons (make_number (0), ascii_font
);
920 for (; CONSP (elements
); elements
= XCDR (elements
))
922 elt
= XCAR (elements
);
923 tem
= Fcons (XCAR (elt
), font_family_registry (XCDR (elt
), 0));
924 FONTSET_SET (fontset
, XINT (XCAR (elt
)), tem
);
931 /* Clear all elements of FONTSET for multibyte characters. */
934 clear_fontset_elements (fontset
)
939 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
940 XCHAR_TABLE (fontset
)->contents
[i
] = Qnil
;
944 /* Check validity of NAME as a fontset name and return the
945 corresponding fontset. If not valid, signal an error.
946 If NAME is t, return Vdefault_fontset. */
949 check_fontset_name (name
)
955 return Vdefault_fontset
;
957 CHECK_STRING (name
, 0);
958 id
= fs_query_fontset (name
, 0);
960 error ("Fontset `%s' does not exist", XSTRING (name
)->data
);
961 return FONTSET_FROM_ID (id
);
964 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 4, 0,
965 "Modify fontset NAME to use FONTNAME for CHARACTER.\n\
967 CHARACTER may be a cons; (FROM . TO), where FROM and TO are\n\
968 non-generic characters. In that case, use FONTNAME\n\
969 for all characters in the range FROM and TO (inclusive).\n\
970 CHARACTER may be a charset. In that case, use FONTNAME\n\
971 for all character in the charsets.\n\
973 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family\n\
974 name of a font, REGSITRY is a registry name of a font.")
975 (name
, character
, fontname
, frame
)
976 Lisp_Object name
, character
, fontname
, frame
;
978 Lisp_Object fontset
, elt
;
979 Lisp_Object realized
;
982 Lisp_Object family
, registry
;
984 fontset
= check_fontset_name (name
);
986 if (CONSP (character
))
988 /* CH should be (FROM . TO) where FROM and TO are non-generic
990 CHECK_NUMBER (XCAR (character
), 1);
991 CHECK_NUMBER (XCDR (character
), 1);
992 from
= XINT (XCAR (character
));
993 to
= XINT (XCDR (character
));
994 if (!char_valid_p (from
, 0) || !char_valid_p (to
, 0))
995 error ("Character range should be by non-generic characters.");
997 && (SINGLE_BYTE_CHAR_P (from
) || SINGLE_BYTE_CHAR_P (to
)))
998 error ("Can't change font for a single byte character");
1000 else if (SYMBOLP (character
))
1002 elt
= Fget (character
, Qcharset
);
1003 if (!VECTORP (elt
) || ASIZE (elt
) < 1 || !NATNUMP (AREF (elt
, 0)))
1004 error ("Invalid charset: %s", (XSYMBOL (character
)->name
)->data
);
1005 from
= MAKE_CHAR (XINT (AREF (elt
, 0)), 0, 0);
1010 CHECK_NUMBER (character
, 1);
1011 from
= XINT (character
);
1014 if (!char_valid_p (from
, 1))
1015 invalid_character (from
);
1016 if (SINGLE_BYTE_CHAR_P (from
))
1017 error ("Can't change font for a single byte character");
1020 if (!char_valid_p (to
, 1))
1021 invalid_character (to
);
1022 if (SINGLE_BYTE_CHAR_P (to
))
1023 error ("Can't change font for a single byte character");
1026 if (STRINGP (fontname
))
1028 fontname
= Fdowncase (fontname
);
1029 elt
= Fcons (make_number (from
), font_family_registry (fontname
, 0));
1033 CHECK_CONS (fontname
, 2);
1034 family
= XCAR (fontname
);
1035 registry
= XCDR (fontname
);
1038 CHECK_STRING (family
, 2);
1039 family
= Fdowncase (family
);
1041 if (!NILP (registry
))
1043 CHECK_STRING (registry
, 2);
1044 registry
= Fdowncase (registry
);
1046 elt
= Fcons (make_number (from
), Fcons (family
, registry
));
1049 /* The arg FRAME is kept for backward compatibility. We only check
1052 CHECK_LIVE_FRAME (frame
, 3);
1054 for (; from
<= to
; from
++)
1055 FONTSET_SET (fontset
, from
, elt
);
1056 Foptimize_char_table (fontset
);
1058 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1059 clear all the elements of REALIZED and free all multibyte faces
1060 whose fontset is REALIZED. This way, the specified character(s)
1061 are surely redisplayed by a correct font. */
1062 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1064 realized
= AREF (Vfontset_table
, id
);
1065 if (!NILP (realized
)
1066 && !BASE_FONTSET_P (realized
)
1067 && EQ (FONTSET_BASE (realized
), fontset
))
1069 FRAME_PTR f
= XFRAME (FONTSET_FRAME (realized
));
1070 clear_fontset_elements (realized
);
1071 free_realized_multibyte_face (f
, id
);
1078 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1079 "Return information about a font named NAME on frame FRAME.\n\
1080 If FRAME is omitted or nil, use the selected frame.\n\
1081 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
1082 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
1084 OPENED-NAME is the name used for opening the font,\n\
1085 FULL-NAME is the full name of the font,\n\
1086 SIZE is the maximum bound width of the font,\n\
1087 HEIGHT is the height of the font,\n\
1088 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
1089 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
1090 how to compose characters.\n\
1091 If the named font is not yet loaded, return nil.")
1093 Lisp_Object name
, frame
;
1096 struct font_info
*fontp
;
1099 (*check_window_system_func
) ();
1101 CHECK_STRING (name
, 0);
1102 name
= Fdowncase (name
);
1104 frame
= selected_frame
;
1105 CHECK_LIVE_FRAME (frame
, 1);
1108 if (!query_font_func
)
1109 error ("Font query function is not supported");
1111 fontp
= (*query_font_func
) (f
, XSTRING (name
)->data
);
1115 info
= Fmake_vector (make_number (7), Qnil
);
1117 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1118 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1119 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1120 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1121 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1122 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1123 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1129 /* Return the font name for the character at POSITION in the current
1130 buffer. This is computed from all the text properties and overlays
1131 that apply to POSITION. It returns nil in the following cases:
1133 (1) The window system doesn't have a font for the character (thus
1134 it is displayed by an empty box).
1136 (2) The character code is invalid.
1138 (3) The current buffer is not displayed in any window.
1140 In addition, the returned font name may not take into account of
1141 such redisplay engine hooks as what used in jit-lock-mode if
1142 POSITION is currently not visible. */
1145 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1146 "For internal use only.")
1148 Lisp_Object position
;
1150 int pos
, pos_byte
, dummy
;
1158 CHECK_NUMBER_COERCE_MARKER (position
, 0);
1159 pos
= XINT (position
);
1160 if (pos
< BEGV
|| pos
>= ZV
)
1161 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1162 pos_byte
= CHAR_TO_BYTE (pos
);
1163 c
= FETCH_CHAR (pos_byte
);
1164 if (! CHAR_VALID_P (c
, 0))
1166 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1169 w
= XWINDOW (window
);
1170 f
= XFRAME (w
->frame
);
1171 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1172 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
);
1173 face
= FACE_FROM_ID (f
, face_id
);
1174 return (face
->font
&& face
->font_name
1175 ? build_string (face
->font_name
)
1180 /* Called from Ffontset_info via map_char_table on each leaf of
1181 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1182 ARG)' and FONT-INFOs have this form:
1183 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1184 The current leaf is indexed by CHARACTER and has value ELT. This
1185 function add the information of the current leaf to ARG by
1186 appending a new element or modifying the last element.. */
1189 accumulate_font_info (arg
, character
, elt
)
1190 Lisp_Object arg
, character
, elt
;
1192 Lisp_Object last
, last_char
, last_elt
;
1194 if (!CONSP (elt
) && !SINGLE_BYTE_CHAR_P (XINT (character
)))
1195 elt
= FONTSET_REF (Vdefault_fontset
, XINT (character
));
1199 last_char
= XCAR (XCAR (last
));
1200 last_elt
= XCAR (XCDR (XCAR (last
)));
1202 if (!NILP (Fequal (elt
, last_elt
)))
1204 int this_charset
= CHAR_CHARSET (XINT (character
));
1206 if (CONSP (last_char
)) /* LAST_CHAR == (FROM . TO) */
1208 if (this_charset
== CHAR_CHARSET (XINT (XCAR (last_char
))))
1210 XCDR (last_char
) = character
;
1214 else if (XINT (last_char
) == XINT (character
))
1216 else if (this_charset
== CHAR_CHARSET (XINT (last_char
)))
1218 XCAR (XCAR (last
)) = Fcons (last_char
, character
);
1222 XCDR (last
) = Fcons (Fcons (character
, Fcons (elt
, Qnil
)), Qnil
);
1223 XCAR (arg
) = XCDR (last
);
1227 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1228 "Return information about a fontset named NAME on frame FRAME.\n\
1229 The value is a vector:\n\
1230 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],\n\
1232 SIZE is the maximum bound width of ASCII font in the fontset,\n\
1233 HEIGHT is the maximum bound height of ASCII font in the fontset,\n\
1234 CHARSET-OR-RANGE is a charset, a character (may be a generic character)\n\
1235 or a cons of two characters specifying the range of characters.\n\
1236 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),\n\
1237 where FAMILY is a `FAMILY' field of a XLFD font name,\n\
1238 REGISTRY is a `CHARSET_REGISTRY' field of a XLDF font name.\n\
1239 FAMILY may contain a `FOUNDARY' field at the head.\n\
1240 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.\n\
1241 OPENEDs are names of fonts actually opened.\n\
1242 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.\n\
1243 If FRAME is omitted, it defaults to the currently selected frame.")
1245 Lisp_Object name
, frame
;
1247 Lisp_Object fontset
;
1249 Lisp_Object indices
[3];
1250 Lisp_Object val
, tail
, elt
;
1251 Lisp_Object
*realized
;
1252 struct font_info
*fontp
= NULL
;
1256 (*check_window_system_func
) ();
1258 fontset
= check_fontset_name (name
);
1261 frame
= selected_frame
;
1262 CHECK_LIVE_FRAME (frame
, 1);
1265 /* Recode 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 with 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
)));
1325 elt
= Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII
), val
)));
1329 fontp
= (*query_font_func
) (f
, XSTRING (elt
)->data
);
1331 val
= Fmake_vector (make_number (3), val
);
1332 AREF (val
, 0) = fontp
? make_number (fontp
->size
) : make_number (0);
1333 AREF (val
, 1) = fontp
? make_number (fontp
->height
) : make_number (0);
1337 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1338 "Return a font name pattern for character CH in fontset NAME.\n\
1339 If NAME is t, find a font name pattern in the default fontset.")
1341 Lisp_Object name
, ch
;
1344 Lisp_Object fontset
, elt
;
1346 fontset
= check_fontset_name (name
);
1348 CHECK_NUMBER (ch
, 1);
1350 if (!char_valid_p (c
, 1))
1351 invalid_character (c
);
1353 elt
= FONTSET_REF (fontset
, c
);
1361 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1362 "Return a list of all defined fontset names.")
1365 Lisp_Object fontset
, list
;
1369 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1371 fontset
= FONTSET_FROM_ID (i
);
1373 && BASE_FONTSET_P (fontset
))
1374 list
= Fcons (FONTSET_NAME (fontset
), list
);
1383 if (!load_font_func
)
1384 /* Window system initializer should have set proper functions. */
1387 Qfontset
= intern ("fontset");
1388 staticpro (&Qfontset
);
1389 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (3));
1391 Vcached_fontset_data
= Qnil
;
1392 staticpro (&Vcached_fontset_data
);
1394 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1395 staticpro (&Vfontset_table
);
1397 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1398 staticpro (&Vdefault_fontset
);
1399 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1400 FONTSET_NAME (Vdefault_fontset
)
1401 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1402 #if defined (macintosh)
1403 FONTSET_ASCII (Vdefault_fontset
)
1404 = Fcons (make_number (0),
1405 build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));
1406 #elif defined (WINDOWSNT)
1407 FONTSET_ASCII (Vdefault_fontset
)
1408 = Fcons (make_number (0),
1409 build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
1411 FONTSET_ASCII (Vdefault_fontset
)
1412 = Fcons (make_number (0),
1413 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1415 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1416 next_fontset_id
= 1;
1418 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1419 "Alist of fontname patterns vs corresponding encoding info.\n\
1420 Each element looks like (REGEXP . ENCODING-INFO),\n\
1421 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
1422 ENCODING is one of the following integer values:\n\
1423 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
1424 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
1425 2: code points 0x20A0..0x7FFF are used,\n\
1426 3: code points 0xA020..0xFF7F are used.");
1427 Vfont_encoding_alist
= Qnil
;
1429 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1430 "Char table of characters whose ascent values should be ignored.\n\
1431 If an entry for a character is non-nil, the ascent value of the glyph\n\
1432 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
1434 This affects how a composite character which contains\n\
1435 such a character is displayed on screen.");
1436 Vuse_default_ascent
= Qnil
;
1438 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1439 "Char table of characters which is not composed relatively.\n\
1440 If an entry for a character is non-nil, a composition sequence\n\
1441 which contains that character is displayed so that\n\
1442 the glyph of that character is put without considering\n\
1443 an ascent and descent value of a previous character.");
1444 Vignore_relative_composition
= Qnil
;
1446 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1447 "Alist of fontname vs list of the alternate fontnames.\n\
1448 When a specified font name is not found, the corresponding\n\
1449 alternate fontnames (if any) are tried instead.");
1450 Valternate_fontname_alist
= Qnil
;
1452 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1453 "Alist of fontset names vs the aliases.");
1454 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1455 build_string ("fontset-default")),
1458 DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font
,
1459 "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
1460 The way to highlight them depends on window system on which Emacs runs.\n\
1461 On X11, a rectangle is shown around each such character.");
1462 Vhighlight_wrong_size_font
= Qnil
;
1464 DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font
,
1465 "*Non-nil means characters shown in overlarge fonts are clipped.\n\
1466 The height of clipping area is the same as that of an ASCII character.\n\
1467 The width of the area is the same as that of an ASCII character,\n\
1468 or twice as wide, depending on the character set's column-width.\n\
1470 If the only font you have for a specific character set is too large,\n\
1471 and clipping these characters makes them hard to read,\n\
1472 you can set this variable to nil to display the characters without clipping.\n\
1473 The drawback is that you will get some garbage left on your screen.");
1474 Vclip_large_size_font
= Qt
;
1476 DEFVAR_LISP ("vertical-centering-font-regexp",
1477 &Vvertical_centering_font_regexp
,
1478 "*Regexp matching font names that require vertical centering on display.\n\
1479 When a character is displayed with such fonts, the character is displayed\n\
1480 at the vertival center of lines.");
1481 Vvertical_centering_font_regexp
= Qnil
;
1483 defsubr (&Squery_fontset
);
1484 defsubr (&Snew_fontset
);
1485 defsubr (&Sset_fontset_font
);
1486 defsubr (&Sfont_info
);
1487 defsubr (&Sinternal_char_font
);
1488 defsubr (&Sfontset_info
);
1489 defsubr (&Sfontset_font
);
1490 defsubr (&Sfontset_list
);