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
));
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
;
215 if (SINGLE_BYTE_CHAR_P (c
))
216 return FONTSET_ASCII (fontset
);
218 SPLIT_CHAR (c
, charset
, c1
, c2
);
219 elt
= XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
220 if (!SUB_CHAR_TABLE_P (elt
))
222 defalt
= XCHAR_TABLE (elt
)->defalt
;
224 || (elt
= XCHAR_TABLE (elt
)->contents
[c1
],
227 if (!SUB_CHAR_TABLE_P (elt
))
229 defalt
= XCHAR_TABLE (elt
)->defalt
;
231 || (elt
= XCHAR_TABLE (elt
)->contents
[c2
],
238 #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
241 fontset_ref_via_base (fontset
, c
)
248 if (SINGLE_BYTE_CHAR_P (*c
))
249 return FONTSET_ASCII (fontset
);
251 elt
= FONTSET_REF (FONTSET_BASE (fontset
), *c
);
252 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
))
253 elt
= FONTSET_REF (Vdefault_fontset
, *c
);
257 *c
= XINT (XCAR (elt
));
258 SPLIT_CHAR (*c
, charset
, c1
, c2
);
259 elt
= XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
261 return (SUB_CHAR_TABLE_P (elt
) ? XCHAR_TABLE (elt
)->defalt
: elt
);
262 if (!SUB_CHAR_TABLE_P (elt
))
264 elt
= XCHAR_TABLE (elt
)->contents
[c1
];
266 return (SUB_CHAR_TABLE_P (elt
) ? XCHAR_TABLE (elt
)->defalt
: elt
);
267 if (!SUB_CHAR_TABLE_P (elt
))
269 elt
= XCHAR_TABLE (elt
)->contents
[c2
];
274 /* Store into the element of FONTSET at index C the value NEWELT. */
275 #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
278 fontset_set (fontset
, c
, newelt
)
283 int charset
, code
[3];
284 Lisp_Object
*elt
, tmp
;
287 if (SINGLE_BYTE_CHAR_P (c
))
289 FONTSET_ASCII (fontset
) = newelt
;
293 SPLIT_CHAR (c
, charset
, code
[0], code
[1]);
294 code
[2] = 0; /* anchor */
295 elt
= &XCHAR_TABLE (fontset
)->contents
[charset
+ 128];
296 for (i
= 0; code
[i
] > 0; i
++)
298 if (!SUB_CHAR_TABLE_P (*elt
))
299 *elt
= make_sub_char_table (*elt
);
300 elt
= &XCHAR_TABLE (*elt
)->contents
[code
[i
]];
302 if (SUB_CHAR_TABLE_P (*elt
))
303 XCHAR_TABLE (*elt
)->defalt
= newelt
;
309 /* Return a newly created fontset with NAME. If BASE is nil, make a
310 base fontset. Otherwise make a realized fontset whose parent is
314 make_fontset (frame
, name
, base
)
315 Lisp_Object frame
, name
, base
;
317 Lisp_Object fontset
, elt
, base_elt
;
318 int size
= ASIZE (Vfontset_table
);
319 int id
= next_fontset_id
;
322 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
323 the next available fontset ID. So it is expected that this loop
324 terminates quickly. In addition, as the last element of
325 Vfotnset_table is always nil, we don't have to check the range of
327 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
334 tem
= Fmake_vector (make_number (size
+ 8), Qnil
);
335 for (i
= 0; i
< size
; i
++)
336 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
337 Vfontset_table
= tem
;
340 fontset
= Fmake_char_table (Qfontset
, Qnil
);
342 FONTSET_ID (fontset
) = make_number (id
);
343 FONTSET_NAME (fontset
) = name
;
344 FONTSET_FRAME (fontset
) = frame
;
345 FONTSET_BASE (fontset
) = base
;
347 AREF (Vfontset_table
, id
) = fontset
;
348 next_fontset_id
= id
+ 1;
353 /* Return 1 if ID is a valid fontset id, else return 0. */
356 fontset_id_valid_p (id
)
359 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
363 /* Extract `family' and `registry' string from FONTNAME and set in
364 *FAMILY and *REGISTRY respectively. Actually, `family' may also
365 contain `foundry', `registry' may also contain `encoding' of
369 font_family_registry (fontname
)
370 Lisp_Object fontname
;
372 Lisp_Object family
, registry
;
373 char *p
= XSTRING (fontname
)->data
;
377 while (*p
&& i
< 15) if (*p
++ == '-') sep
[i
++] = p
;
381 family
= make_unibyte_string (sep
[0], sep
[2] - 1 - sep
[0]);
382 registry
= make_unibyte_string (sep
[12], p
- sep
[12]);
383 return Fcons (family
, registry
);
387 /********** INTERFACES TO xfaces.c and dispextern.h **********/
389 /* Return name of the fontset with ID. */
396 fontset
= FONTSET_FROM_ID (id
);
397 return FONTSET_NAME (fontset
);
401 /* Return ASCII font name of the fontset with ID. */
407 Lisp_Object fontset
, elt
;
408 fontset
= FONTSET_FROM_ID (id
);
409 elt
= FONTSET_ASCII (fontset
);
414 /* Free fontset of FACE. Called from free_realized_face. */
417 free_face_fontset (f
, face
)
421 if (fontset_id_valid_p (face
->fontset
))
423 AREF (Vfontset_table
, face
->fontset
) = Qnil
;
424 if (face
->fontset
< next_fontset_id
)
425 next_fontset_id
= face
->fontset
;
430 /* Return 1 iff FACE is suitable for displaying character C.
431 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
432 when C is not a single byte character.. */
435 face_suitable_for_char_p (face
, c
)
439 Lisp_Object fontset
, elt
;
441 if (SINGLE_BYTE_CHAR_P (c
))
442 return (face
== face
->ascii_face
);
444 xassert (fontset_id_valid_p (face
->fontset
));
445 fontset
= FONTSET_FROM_ID (face
->fontset
);
446 xassert (!BASE_FONTSET_P (fontset
));
448 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
449 return (!NILP (elt
) && face
->id
== XFASTINT (elt
));
453 /* Return ID of face suitable for displaying character C on frame F.
454 The selection of face is done based on the fontset of FACE. FACE
455 should already have been realized for ASCII characters. Called
456 from the macro FACE_FOR_CHAR when C is not a single byte character. */
459 face_for_char (f
, face
, c
)
464 Lisp_Object fontset
, elt
;
467 xassert (fontset_id_valid_p (face
->fontset
));
468 fontset
= FONTSET_FROM_ID (face
->fontset
);
469 xassert (!BASE_FONTSET_P (fontset
));
471 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
475 /* No face is recorded for C in the fontset of FACE. Make a new
476 realized face for C that has the same fontset. */
477 face_id
= lookup_face (f
, face
->lface
, c
, face
);
479 /* Record the face ID in FONTSET at the same index as the
480 information in the base fontset. */
481 FONTSET_SET (fontset
, c
, make_number (face_id
));
486 /* Make a realized fontset for ASCII face FACE on frame F from the
487 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
488 default fontset as the base. Value is the id of the new fontset.
489 Called from realize_x_face. */
492 make_fontset_for_ascii_face (f
, base_fontset_id
)
496 Lisp_Object base_fontset
, fontset
, name
, frame
;
498 XSETFRAME (frame
, f
);
499 if (base_fontset_id
>= 0)
501 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
502 if (!BASE_FONTSET_P (base_fontset
))
503 base_fontset
= FONTSET_BASE (base_fontset
);
504 xassert (BASE_FONTSET_P (base_fontset
));
507 base_fontset
= Vdefault_fontset
;
509 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
510 return XINT (FONTSET_ID (fontset
));
514 /* Return the font name pattern for C that is recorded in the fontset
515 with ID. A font is opened by that pattern to get the fullname. If
516 the fullname conform to XLFD, extract foundry-family field and
517 registry-encoding field, and return the cons of them. Otherwise
518 return the fullname. If ID is -1, or the fontset doesn't contain
519 information about C, get the registry and encoding of C from the
520 default fontset. Called from choose_face_font. */
523 fontset_font_pattern (f
, id
, c
)
527 Lisp_Object fontset
, elt
;
528 struct font_info
*fontp
;
529 Lisp_Object family_registry
;
532 if (fontset_id_valid_p (id
))
534 fontset
= FONTSET_FROM_ID (id
);
535 xassert (!BASE_FONTSET_P (fontset
));
536 fontset
= FONTSET_BASE (fontset
);
537 elt
= FONTSET_REF (fontset
, c
);
540 elt
= FONTSET_REF (Vdefault_fontset
, c
);
544 if (CONSP (XCDR (elt
)))
547 /* The fontset specifies only a font name pattern (not cons of
548 family and registry). Try to open a font by that pattern and get
549 a registry from the full name of the opened font. We ignore
550 family name here because it should be wild card in the fontset
553 xassert (STRINGP (elt
));
554 fontp
= FS_LOAD_FONT (f
, c
, XSTRING (elt
)->data
, -1);
558 family_registry
= font_family_registry (build_string (fontp
->full_name
));
559 if (!CONSP (family_registry
))
560 return family_registry
;
561 XCAR (family_registry
) = Qnil
;
562 return family_registry
;
566 /* Load a font named FONTNAME to display character C on frame F.
567 Return a pointer to the struct font_info of the loaded font. If
568 loading fails, return NULL. If FACE is non-zero and a fontset is
569 assigned to it, record FACE->id in the fontset for C. If FONTNAME
570 is NULL, the name is taken from the fontset of FACE or what
574 fs_load_font (f
, c
, fontname
, id
, face
)
582 Lisp_Object list
, elt
;
585 struct font_info
*fontp
;
586 int charset
= CHAR_CHARSET (c
);
593 fontset
= FONTSET_FROM_ID (id
);
596 && !BASE_FONTSET_P (fontset
))
598 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
601 /* A suitable face for C is already recorded, which means
602 that a proper font is already loaded. */
603 int face_id
= XINT (elt
);
605 xassert (face_id
== face
->id
);
606 face
= FACE_FROM_ID (f
, face_id
);
607 return (*get_font_info_func
) (f
, face
->font_info_id
);
610 if (!fontname
&& charset
== CHARSET_ASCII
)
612 elt
= FONTSET_ASCII (fontset
);
613 fontname
= XSTRING (XCDR (elt
))->data
;
618 /* No way to get fontname. */
621 fontp
= (*load_font_func
) (f
, fontname
, size
);
625 /* Fill in members (charset, vertical_centering, encoding, etc) of
626 font_info structure that are not set by (*load_font_func). */
627 fontp
->charset
= charset
;
629 fontp
->vertical_centering
630 = (STRINGP (Vvertical_centering_font_regexp
)
631 && (fast_c_string_match_ignore_case
632 (Vvertical_centering_font_regexp
, fontp
->full_name
) >= 0));
634 if (fontp
->encoding
[1] != FONT_ENCODING_NOT_DECIDED
)
636 /* The font itself tells which code points to be used. Use this
637 encoding for all other charsets. */
640 fontp
->encoding
[0] = fontp
->encoding
[1];
641 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
642 fontp
->encoding
[i
] = fontp
->encoding
[1];
646 /* The font itself doesn't have information about encoding. */
649 fontname
= fontp
->full_name
;
650 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
651 others is 1 (i.e. 0x80..0xFF). */
652 fontp
->encoding
[0] = 0;
653 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
654 fontp
->encoding
[i
] = 1;
655 /* Then override them by a specification in Vfont_encoding_alist. */
656 for (list
= Vfont_encoding_alist
; CONSP (list
); list
= XCDR (list
))
660 && STRINGP (XCAR (elt
)) && CONSP (XCDR (elt
))
661 && (fast_c_string_match_ignore_case (XCAR (elt
), fontname
)
666 for (tmp
= XCDR (elt
); CONSP (tmp
); tmp
= XCDR (tmp
))
667 if (CONSP (XCAR (tmp
))
668 && ((i
= get_charset_id (XCAR (XCAR (tmp
))))
670 && INTEGERP (XCDR (XCAR (tmp
)))
671 && XFASTINT (XCDR (XCAR (tmp
))) < 4)
673 = XFASTINT (XCDR (XCAR (tmp
)));
678 fontp
->font_encoder
= (struct ccl_program
*) 0;
680 if (find_ccl_program_func
)
681 (*find_ccl_program_func
) (fontp
);
683 /* If we loaded a font for a face that has fontset, record the face
684 ID in the fontset for C. */
687 && !BASE_FONTSET_P (fontset
))
688 FONTSET_SET (fontset
, c
, make_number (face
->id
));
693 /* Cache data used by fontset_pattern_regexp. The car part is a
694 pattern string containing at least one wild card, the cdr part is
695 the corresponding regular expression. */
696 static Lisp_Object Vcached_fontset_data
;
698 #define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
699 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
701 /* If fontset name PATTERN contains any wild card, return regular
702 expression corresponding to PATTERN. */
705 fontset_pattern_regexp (pattern
)
708 if (!index (XSTRING (pattern
)->data
, '*')
709 && !index (XSTRING (pattern
)->data
, '?'))
710 /* PATTERN does not contain any wild cards. */
713 if (!CONSP (Vcached_fontset_data
)
714 || strcmp (XSTRING (pattern
)->data
, CACHED_FONTSET_NAME
))
716 /* We must at first update the cached data. */
717 char *regex
= (char *) alloca (XSTRING (pattern
)->size
* 2);
718 char *p0
, *p1
= regex
;
720 /* Convert "*" to ".*", "?" to ".". */
722 for (p0
= (char *) XSTRING (pattern
)->data
; *p0
; p0
++)
737 Vcached_fontset_data
= Fcons (build_string (XSTRING (pattern
)->data
),
738 build_string (regex
));
741 return CACHED_FONTSET_REGEX
;
744 /* Return ID of the base fontset named NAME. If there's no such
745 fontset, return -1. */
748 fs_query_fontset (name
, regexpp
)
752 Lisp_Object fontset
, tem
;
755 name
= Fdowncase (name
);
758 tem
= Frassoc (name
, Vfontset_alias_alist
);
759 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
763 tem
= fontset_pattern_regexp (name
);
772 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
775 unsigned char *this_name
;
777 fontset
= FONTSET_FROM_ID (i
);
779 || !BASE_FONTSET_P (fontset
))
782 this_name
= XSTRING (FONTSET_NAME (fontset
))->data
;
784 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
785 : !strcmp (XSTRING (name
)->data
, this_name
))
792 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
793 "Return the name of a fontset that matches PATTERN.\n\
794 The value is nil if there is no matching fontset.\n\
795 PATTERN can contain `*' or `?' as a wildcard\n\
796 just as X font name matching algorithm allows.\n\
797 If REGEXPP is non-nil, PATTERN is a regular expression.")
799 Lisp_Object pattern
, regexpp
;
804 (*check_window_system_func
) ();
806 CHECK_STRING (pattern
, 0);
808 if (XSTRING (pattern
)->size
== 0)
811 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
815 fontset
= FONTSET_FROM_ID (id
);
816 return FONTSET_NAME (fontset
);
819 /* Return a list of base fontset names matching PATTERN on frame F.
820 If SIZE is not 0, it is the size (maximum bound width) of fontsets
824 list_fontsets (f
, pattern
, size
)
829 Lisp_Object frame
, regexp
, val
, tail
;
832 XSETFRAME (frame
, f
);
834 regexp
= fontset_pattern_regexp (pattern
);
837 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
842 fontset
= FONTSET_FROM_ID (id
);
844 || !BASE_FONTSET_P (fontset
)
845 || !EQ (frame
, FONTSET_FRAME (fontset
)))
847 name
= XSTRING (FONTSET_NAME (fontset
))->data
;
850 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
851 : strcmp (XSTRING (pattern
)->data
, name
))
856 struct font_info
*fontp
;
857 fontp
= FS_LOAD_FONT (f
, 0, NULL
, id
);
858 if (!fontp
|| size
!= fontp
->size
)
861 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
867 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
868 "Create a new fontset NAME that contains font information in FONTLIST.\n\
869 FONTLIST is an alist of charsets vs corresponding font name patterns.")
871 Lisp_Object name
, fontlist
;
873 Lisp_Object fontset
, elements
, ascii_font
;
874 Lisp_Object tem
, tail
, elt
;
876 (*check_window_system_func
) ();
878 CHECK_STRING (name
, 0);
879 CHECK_LIST (fontlist
, 1);
881 name
= Fdowncase (name
);
882 tem
= Fquery_fontset (name
, Qnil
);
884 error ("Fontset `%s' matches the existing fontset `%s'",
885 XSTRING (name
)->data
, XSTRING (tem
)->data
);
887 /* Check the validity of FONTLIST while creating a template for
889 elements
= ascii_font
= Qnil
;
890 for (tail
= fontlist
; CONSP (tail
); tail
= XCDR (tail
))
892 Lisp_Object family
, registry
;
897 || (charset
= get_charset_id (XCAR (tem
))) < 0
898 || !STRINGP (XCDR (tem
)))
899 error ("Elements of fontlist must be a cons of charset and font name");
901 tem
= Fdowncase (XCDR (tem
));
902 if (charset
== CHARSET_ASCII
)
906 c
= MAKE_CHAR (charset
, 0, 0);
907 elements
= Fcons (Fcons (make_number (c
), tem
), elements
);
911 if (NILP (ascii_font
))
912 error ("No ASCII font in the fontlist");
914 fontset
= make_fontset (Qnil
, name
, Qnil
);
915 FONTSET_ASCII (fontset
) = Fcons (make_number (0), ascii_font
);
916 for (; CONSP (elements
); elements
= XCDR (elements
))
918 elt
= XCAR (elements
);
919 tem
= Fcons (XCAR (elt
), font_family_registry (XCDR (elt
)));
920 FONTSET_SET (fontset
, XINT (XCAR (elt
)), tem
);
927 /* Clear all elements of FONTSET for multibyte characters. */
930 clear_fontset_elements (fontset
)
935 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
936 XCHAR_TABLE (fontset
)->contents
[i
] = Qnil
;
940 /* Check validity of NAME as a fontset name and return the
941 corresponding fontset. If not valid, signal an error.
942 If NAME is t, return Vdefault_fontset. */
945 check_fontset_name (name
)
951 return Vdefault_fontset
;
953 CHECK_STRING (name
, 0);
954 id
= fs_query_fontset (name
, 0);
956 error ("Fontset `%s' does not exist", XSTRING (name
)->data
);
957 return FONTSET_FROM_ID (id
);
960 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 4, 0,
961 "Modify fontset NAME to use FONTNAME for CHARACTER.\n\
963 CHARACTER may be a cons; (FROM . TO), where FROM and TO are\n\
964 non-generic characters. In that case, use FONTNAME\n\
965 for all characters in the range FROM and TO (inclusive).\n\
966 CHARACTER may be a charset. In that case, use FONTNAME\n\
967 for all character in the charsets.\n\
969 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family\n\
970 name of a font, REGSITRY is a registry name of a font.")
971 (name
, character
, fontname
, frame
)
972 Lisp_Object name
, character
, fontname
, frame
;
974 Lisp_Object fontset
, elt
;
975 Lisp_Object realized
;
978 Lisp_Object family
, registry
;
980 fontset
= check_fontset_name (name
);
982 if (CONSP (character
))
984 /* CH should be (FROM . TO) where FROM and TO are non-generic
986 CHECK_NUMBER (XCAR (character
), 1);
987 CHECK_NUMBER (XCDR (character
), 1);
988 from
= XINT (XCAR (character
));
989 to
= XINT (XCDR (character
));
990 if (!char_valid_p (from
, 0) || !char_valid_p (to
, 0))
991 error ("Character range should be by non-generic characters.");
993 && (SINGLE_BYTE_CHAR_P (from
) || SINGLE_BYTE_CHAR_P (to
)))
994 error ("Can't change font for a single byte character");
996 else if (SYMBOLP (character
))
998 elt
= Fget (character
, Qcharset
);
999 if (!VECTORP (elt
) || ASIZE (elt
) < 1 || !NATNUMP (AREF (elt
, 0)))
1000 error ("Invalid charset: %s", (XSYMBOL (character
)->name
)->data
);
1001 from
= MAKE_CHAR (XINT (AREF (elt
, 0)), 0, 0);
1006 CHECK_NUMBER (character
, 1);
1007 from
= XINT (character
);
1010 if (!char_valid_p (from
, 1))
1011 invalid_character (from
);
1012 if (SINGLE_BYTE_CHAR_P (from
))
1013 error ("Can't change font for a single byte character");
1016 if (!char_valid_p (to
, 1))
1017 invalid_character (to
);
1018 if (SINGLE_BYTE_CHAR_P (to
))
1019 error ("Can't change font for a single byte character");
1022 if (STRINGP (fontname
))
1024 fontname
= Fdowncase (fontname
);
1025 elt
= Fcons (make_number (from
), font_family_registry (fontname
));
1029 CHECK_CONS (fontname
, 2);
1030 family
= XCAR (fontname
);
1031 registry
= XCDR (fontname
);
1034 CHECK_STRING (family
, 2);
1035 family
= Fdowncase (family
);
1037 if (!NILP (registry
))
1039 CHECK_STRING (registry
, 2);
1040 registry
= Fdowncase (registry
);
1042 elt
= Fcons (make_number (from
), Fcons (family
, registry
));
1045 /* The arg FRAME is kept for backward compatibility. We only check
1048 CHECK_LIVE_FRAME (frame
, 3);
1050 for (; from
<= to
; from
++)
1051 FONTSET_SET (fontset
, from
, elt
);
1052 Foptimize_char_table (fontset
);
1054 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1055 clear all the elements of REALIZED and free all multibyte faces
1056 whose fontset is REALIZED. This way, the specified character(s)
1057 are surely redisplayed by a correct font. */
1058 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1060 realized
= AREF (Vfontset_table
, id
);
1061 if (!NILP (realized
)
1062 && !BASE_FONTSET_P (realized
)
1063 && EQ (FONTSET_BASE (realized
), fontset
))
1065 FRAME_PTR f
= XFRAME (FONTSET_FRAME (realized
));
1066 clear_fontset_elements (realized
);
1067 free_realized_multibyte_face (f
, id
);
1074 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1075 "Return information about a font named NAME on frame FRAME.\n\
1076 If FRAME is omitted or nil, use the selected frame.\n\
1077 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
1078 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
1080 OPENED-NAME is the name used for opening the font,\n\
1081 FULL-NAME is the full name of the font,\n\
1082 SIZE is the maximum bound width of the font,\n\
1083 HEIGHT is the height of the font,\n\
1084 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
1085 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
1086 how to compose characters.\n\
1087 If the named font is not yet loaded, return nil.")
1089 Lisp_Object name
, frame
;
1092 struct font_info
*fontp
;
1095 (*check_window_system_func
) ();
1097 CHECK_STRING (name
, 0);
1098 name
= Fdowncase (name
);
1100 frame
= selected_frame
;
1101 CHECK_LIVE_FRAME (frame
, 1);
1104 if (!query_font_func
)
1105 error ("Font query function is not supported");
1107 fontp
= (*query_font_func
) (f
, XSTRING (name
)->data
);
1111 info
= Fmake_vector (make_number (7), Qnil
);
1113 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1114 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1115 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1116 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1117 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1118 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1119 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1125 /* Return the font name for the character at POSITION in the current
1126 buffer. This is computed from all the text properties and overlays
1127 that apply to POSITION. It returns nil in the following cases:
1129 (1) The window system doesn't have a font for the character (thus
1130 it is displayed by an empty box).
1132 (2) The character code is invalid.
1134 (3) The current buffer is not displayed in any window.
1136 In addition, the returned font name may not take into account of
1137 such redisplay engine hooks as what used in jit-lock-mode if
1138 POSITION is currently not visible. */
1141 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1142 "For internal use only.")
1144 Lisp_Object position
;
1146 int pos
, pos_byte
, dummy
;
1154 CHECK_NUMBER_COERCE_MARKER (position
, 0);
1155 pos
= XINT (position
);
1156 if (pos
< BEGV
|| pos
>= ZV
)
1157 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1158 pos_byte
= CHAR_TO_BYTE (pos
);
1159 c
= FETCH_CHAR (pos_byte
);
1160 if (! CHAR_VALID_P (c
, 0))
1162 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1165 w
= XWINDOW (window
);
1166 f
= XFRAME (w
->frame
);
1167 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1168 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
);
1169 face
= FACE_FROM_ID (f
, face_id
);
1170 return (face
->font
&& face
->font_name
1171 ? build_string (face
->font_name
)
1176 /* Called from Ffontset_info via map_char_table on each leaf of
1177 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1178 ARG)' and FONT-INFOs have this form:
1179 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1180 The current leaf is indexed by CHARACTER and has value ELT. This
1181 function add the information of the current leaf to ARG by
1182 appending a new element or modifying the last element.. */
1185 accumulate_font_info (arg
, character
, elt
)
1186 Lisp_Object arg
, character
, elt
;
1188 Lisp_Object last
, last_char
, last_elt
, tmp
;
1190 if (!CONSP (elt
) && !SINGLE_BYTE_CHAR_P (XINT (character
)))
1191 elt
= FONTSET_REF (Vdefault_fontset
, XINT (character
));
1195 last_char
= XCAR (XCAR (last
));
1196 last_elt
= XCAR (XCDR (XCAR (last
)));
1198 if (!NILP (Fequal (elt
, last_elt
)))
1200 int this_charset
= CHAR_CHARSET (XINT (character
));
1202 if (CONSP (last_char
)) /* LAST_CHAR == (FROM . TO) */
1204 if (this_charset
== CHAR_CHARSET (XINT (XCAR (last_char
))))
1206 XCDR (last_char
) = character
;
1210 else if (XINT (last_char
) == XINT (character
))
1212 else if (this_charset
== CHAR_CHARSET (XINT (last_char
)))
1214 XCAR (XCAR (last
)) = Fcons (last_char
, character
);
1218 XCDR (last
) = Fcons (Fcons (character
, Fcons (elt
, Qnil
)), Qnil
);
1219 XCAR (arg
) = XCDR (last
);
1223 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1224 "Return information about a fontset named NAME on frame FRAME.\n\
1225 The value is a vector:\n\
1226 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],\n\
1228 SIZE is the maximum bound width of ASCII font in the fontset,\n\
1229 HEIGHT is the maximum bound height of ASCII font in the fontset,\n\
1230 CHARSET-OR-RANGE is a charset, a character (may be a generic character)\n\
1231 or a cons of two characters specifying the range of characters.\n\
1232 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),\n\
1233 where FAMILY is a `FAMILY' field of a XLFD font name,\n\
1234 REGISTRY is a `CHARSET_REGISTRY' field of a XLDF font name.\n\
1235 FAMILY may contain a `FOUNDARY' field at the head.\n\
1236 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.\n\
1237 OPENEDs are names of fonts actually opened.\n\
1238 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.\n\
1239 If FRAME is omitted, it defaults to the currently selected frame.")
1241 Lisp_Object name
, frame
;
1243 Lisp_Object fontset
;
1245 Lisp_Object indices
[3];
1246 Lisp_Object val
, tail
, elt
;
1247 Lisp_Object
*realized
;
1248 struct font_info
*fontp
= NULL
;
1252 (*check_window_system_func
) ();
1254 fontset
= check_fontset_name (name
);
1257 frame
= selected_frame
;
1258 CHECK_LIVE_FRAME (frame
, 1);
1261 /* Recode realized fontsets whose base is FONTSET in the table
1263 realized
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1264 * ASIZE (Vfontset_table
));
1265 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1267 elt
= FONTSET_FROM_ID (i
);
1269 && EQ (FONTSET_BASE (elt
), fontset
))
1270 realized
[n_realized
++] = elt
;
1273 /* Accumulate information of the fontset in VAL. The format is
1274 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1275 FONT-SPEC). See the comment for accumulate_font_info for the
1277 val
= Fcons (Fcons (make_number (0),
1278 Fcons (XCDR (FONTSET_ASCII (fontset
)), Qnil
)),
1280 val
= Fcons (val
, val
);
1281 map_char_table (accumulate_font_info
, Qnil
, fontset
, val
, 0, indices
);
1284 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1285 character for a charset, replace it with the charset symbol. If
1286 fonts are opened for FONT-SPEC, append the names of the fonts to
1288 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
1292 if (INTEGERP (XCAR (elt
)))
1294 int charset
, c1
, c2
;
1295 c
= XINT (XCAR (elt
));
1296 SPLIT_CHAR (c
, charset
, c1
, c2
);
1298 XCAR (elt
) = CHARSET_SYMBOL (charset
);
1301 c
= XINT (XCAR (XCAR (elt
)));
1302 for (i
= 0; i
< n_realized
; i
++)
1304 Lisp_Object face_id
, font
;
1307 face_id
= FONTSET_REF_VIA_BASE (realized
[i
], c
);
1308 if (INTEGERP (face_id
))
1310 face
= FACE_FROM_ID (f
, XINT (face_id
));
1311 if (face
->font
&& face
->font_name
)
1313 font
= build_string (face
->font_name
);
1314 if (NILP (Fmember (font
, XCDR (XCDR (elt
)))))
1315 XCDR (XCDR (elt
)) = Fcons (font
, XCDR (XCDR (elt
)));
1321 elt
= Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII
), val
)));
1325 fontp
= (*query_font_func
) (f
, XSTRING (elt
)->data
);
1327 val
= Fmake_vector (make_number (3), val
);
1328 AREF (val
, 0) = fontp
? make_number (fontp
->size
) : make_number (0);
1329 AREF (val
, 1) = fontp
? make_number (fontp
->height
) : make_number (0);
1333 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1334 "Return a font name pattern for character CH in fontset NAME.\n\
1335 If NAME is t, find a font name pattern in the default fontset.")
1337 Lisp_Object name
, ch
;
1340 Lisp_Object fontset
, elt
;
1342 fontset
= check_fontset_name (name
);
1344 CHECK_NUMBER (ch
, 1);
1346 if (!char_valid_p (c
, 1))
1347 invalid_character (c
);
1349 elt
= FONTSET_REF (fontset
, c
);
1357 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1358 "Return a list of all defined fontset names.")
1361 Lisp_Object fontset
, list
;
1365 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1367 fontset
= FONTSET_FROM_ID (i
);
1369 && BASE_FONTSET_P (fontset
))
1370 list
= Fcons (FONTSET_NAME (fontset
), list
);
1381 if (!load_font_func
)
1382 /* Window system initializer should have set proper functions. */
1385 Qfontset
= intern ("fontset");
1386 staticpro (&Qfontset
);
1387 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (3));
1389 Vcached_fontset_data
= Qnil
;
1390 staticpro (&Vcached_fontset_data
);
1392 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1393 staticpro (&Vfontset_table
);
1395 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1396 staticpro (&Vdefault_fontset
);
1397 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1398 FONTSET_NAME (Vdefault_fontset
)
1399 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1400 FONTSET_ASCII (Vdefault_fontset
)
1401 = Fcons (make_number (0),
1402 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1403 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1404 next_fontset_id
= 1;
1406 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1407 "Alist of fontname patterns vs corresponding encoding info.\n\
1408 Each element looks like (REGEXP . ENCODING-INFO),\n\
1409 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
1410 ENCODING is one of the following integer values:\n\
1411 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
1412 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
1413 2: code points 0x20A0..0x7FFF are used,\n\
1414 3: code points 0xA020..0xFF7F are used.");
1415 Vfont_encoding_alist
= Qnil
;
1417 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1418 "Char table of characters whose ascent values should be ignored.\n\
1419 If an entry for a character is non-nil, the ascent value of the glyph\n\
1420 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
1422 This affects how a composite character which contains\n\
1423 such a character is displayed on screen.");
1424 Vuse_default_ascent
= Qnil
;
1426 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1427 "Char table of characters which is not composed relatively.\n\
1428 If an entry for a character is non-nil, a composition sequence\n\
1429 which contains that character is displayed so that\n\
1430 the glyph of that character is put without considering\n\
1431 an ascent and descent value of a previous character.");
1432 Vignore_relative_composition
= Qnil
;
1434 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1435 "Alist of fontname vs list of the alternate fontnames.\n\
1436 When a specified font name is not found, the corresponding\n\
1437 alternate fontnames (if any) are tried instead.");
1438 Valternate_fontname_alist
= Qnil
;
1440 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1441 "Alist of fontset names vs the aliases.");
1442 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1443 build_string ("fontset-default")),
1446 DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font
,
1447 "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
1448 The way to highlight them depends on window system on which Emacs runs.\n\
1449 On X11, a rectangle is shown around each such character.");
1450 Vhighlight_wrong_size_font
= Qnil
;
1452 DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font
,
1453 "*Non-nil means characters shown in overlarge fonts are clipped.\n\
1454 The height of clipping area is the same as that of an ASCII character.\n\
1455 The width of the area is the same as that of an ASCII character,\n\
1456 or twice as wide, depending on the character set's column-width.\n\
1458 If the only font you have for a specific character set is too large,\n\
1459 and clipping these characters makes them hard to read,\n\
1460 you can set this variable to nil to display the characters without clipping.\n\
1461 The drawback is that you will get some garbage left on your screen.");
1462 Vclip_large_size_font
= Qt
;
1464 DEFVAR_LISP ("vertical-centering-font-regexp",
1465 &Vvertical_centering_font_regexp
,
1466 "*Regexp matching font names that require vertical centering on display.\n\
1467 When a character is displayed with such fonts, the character is displayed\n\
1468 at the vertival center of lines.");
1469 Vvertical_centering_font_regexp
= Qnil
;
1471 defsubr (&Squery_fontset
);
1472 defsubr (&Snew_fontset
);
1473 defsubr (&Sset_fontset_font
);
1474 defsubr (&Sfont_info
);
1475 defsubr (&Sinternal_char_font
);
1476 defsubr (&Sfontset_info
);
1477 defsubr (&Sfontset_font
);
1478 defsubr (&Sfontset_list
);