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
;
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 set in
362 *FAMILY and *REGISTRY respectively. Actually, `family' may also
363 contain `foundry', `registry' may also contain `encoding' of
367 font_family_registry (fontname
)
368 Lisp_Object fontname
;
370 Lisp_Object family
, registry
;
371 char *p
= XSTRING (fontname
)->data
;
375 while (*p
&& i
< 15) if (*p
++ == '-') sep
[i
++] = p
;
379 family
= make_unibyte_string (sep
[0], sep
[2] - 1 - sep
[0]);
380 registry
= make_unibyte_string (sep
[12], p
- sep
[12]);
381 return Fcons (family
, registry
);
385 /********** INTERFACES TO xfaces.c and dispextern.h **********/
387 /* Return name of the fontset with ID. */
394 fontset
= FONTSET_FROM_ID (id
);
395 return FONTSET_NAME (fontset
);
399 /* Return ASCII font name of the fontset with ID. */
405 Lisp_Object fontset
, elt
;
406 fontset
= FONTSET_FROM_ID (id
);
407 elt
= FONTSET_ASCII (fontset
);
412 /* Free fontset of FACE. Called from free_realized_face. */
415 free_face_fontset (f
, face
)
419 if (fontset_id_valid_p (face
->fontset
))
421 AREF (Vfontset_table
, face
->fontset
) = Qnil
;
422 if (face
->fontset
< next_fontset_id
)
423 next_fontset_id
= face
->fontset
;
428 /* Return 1 iff FACE is suitable for displaying character C.
429 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
430 when C is not a single byte character.. */
433 face_suitable_for_char_p (face
, c
)
437 Lisp_Object fontset
, elt
;
439 if (SINGLE_BYTE_CHAR_P (c
))
440 return (face
== face
->ascii_face
);
442 xassert (fontset_id_valid_p (face
->fontset
));
443 fontset
= FONTSET_FROM_ID (face
->fontset
);
444 xassert (!BASE_FONTSET_P (fontset
));
446 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
447 return (!NILP (elt
) && face
->id
== XFASTINT (elt
));
451 /* Return ID of face suitable for displaying character C on frame F.
452 The selection of face is done based on the fontset of FACE. FACE
453 should already have been realized for ASCII characters. Called
454 from the macro FACE_FOR_CHAR when C is not a single byte character. */
457 face_for_char (f
, face
, c
)
462 Lisp_Object fontset
, elt
;
465 xassert (fontset_id_valid_p (face
->fontset
));
466 fontset
= FONTSET_FROM_ID (face
->fontset
);
467 xassert (!BASE_FONTSET_P (fontset
));
469 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
473 /* No face is recorded for C in the fontset of FACE. Make a new
474 realized face for C that has the same fontset. */
475 face_id
= lookup_face (f
, face
->lface
, c
, face
);
477 /* Record the face ID in FONTSET at the same index as the
478 information in the base fontset. */
479 FONTSET_SET (fontset
, c
, make_number (face_id
));
484 /* Make a realized fontset for ASCII face FACE on frame F from the
485 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
486 default fontset as the base. Value is the id of the new fontset.
487 Called from realize_x_face. */
490 make_fontset_for_ascii_face (f
, base_fontset_id
)
494 Lisp_Object base_fontset
, fontset
, frame
;
496 XSETFRAME (frame
, f
);
497 if (base_fontset_id
>= 0)
499 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
500 if (!BASE_FONTSET_P (base_fontset
))
501 base_fontset
= FONTSET_BASE (base_fontset
);
502 xassert (BASE_FONTSET_P (base_fontset
));
505 base_fontset
= Vdefault_fontset
;
507 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
508 return XINT (FONTSET_ID (fontset
));
512 /* Return the font name pattern for C that is recorded in the fontset
513 with ID. A font is opened by that pattern to get the fullname. If
514 the fullname conform to XLFD, extract foundry-family field and
515 registry-encoding field, and return the cons of them. Otherwise
516 return the fullname. If ID is -1, or the fontset doesn't contain
517 information about C, get the registry and encoding of C from the
518 default fontset. Called from choose_face_font. */
521 fontset_font_pattern (f
, id
, c
)
525 Lisp_Object fontset
, elt
;
526 struct font_info
*fontp
;
527 Lisp_Object family_registry
;
530 if (fontset_id_valid_p (id
))
532 fontset
= FONTSET_FROM_ID (id
);
533 xassert (!BASE_FONTSET_P (fontset
));
534 fontset
= FONTSET_BASE (fontset
);
535 elt
= FONTSET_REF (fontset
, c
);
538 elt
= FONTSET_REF (Vdefault_fontset
, c
);
542 if (CONSP (XCDR (elt
)))
545 /* The fontset specifies only a font name pattern (not cons of
546 family and registry). Try to open a font by that pattern and get
547 a registry from the full name of the opened font. We ignore
548 family name here because it should be wild card in the fontset
551 xassert (STRINGP (elt
));
552 fontp
= FS_LOAD_FONT (f
, c
, XSTRING (elt
)->data
, -1);
556 family_registry
= font_family_registry (build_string (fontp
->full_name
));
557 if (!CONSP (family_registry
))
558 return family_registry
;
559 XCAR (family_registry
) = Qnil
;
560 return family_registry
;
564 /* Load a font named FONTNAME to display character C on frame F.
565 Return a pointer to the struct font_info of the loaded font. If
566 loading fails, return NULL. If FACE is non-zero and a fontset is
567 assigned to it, record FACE->id in the fontset for C. If FONTNAME
568 is NULL, the name is taken from the fontset of FACE or what
572 fs_load_font (f
, c
, fontname
, id
, face
)
580 Lisp_Object list
, elt
;
582 struct font_info
*fontp
;
583 int charset
= CHAR_CHARSET (c
);
590 fontset
= FONTSET_FROM_ID (id
);
593 && !BASE_FONTSET_P (fontset
))
595 elt
= FONTSET_REF_VIA_BASE (fontset
, c
);
598 /* A suitable face for C is already recorded, which means
599 that a proper font is already loaded. */
600 int face_id
= XINT (elt
);
602 xassert (face_id
== face
->id
);
603 face
= FACE_FROM_ID (f
, face_id
);
604 return (*get_font_info_func
) (f
, face
->font_info_id
);
607 if (!fontname
&& charset
== CHARSET_ASCII
)
609 elt
= FONTSET_ASCII (fontset
);
610 fontname
= XSTRING (XCDR (elt
))->data
;
615 /* No way to get fontname. */
618 fontp
= (*load_font_func
) (f
, fontname
, size
);
622 /* Fill in members (charset, vertical_centering, encoding, etc) of
623 font_info structure that are not set by (*load_font_func). */
624 fontp
->charset
= charset
;
626 fontp
->vertical_centering
627 = (STRINGP (Vvertical_centering_font_regexp
)
628 && (fast_c_string_match_ignore_case
629 (Vvertical_centering_font_regexp
, fontp
->full_name
) >= 0));
631 if (fontp
->encoding
[1] != FONT_ENCODING_NOT_DECIDED
)
633 /* The font itself tells which code points to be used. Use this
634 encoding for all other charsets. */
637 fontp
->encoding
[0] = fontp
->encoding
[1];
638 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
639 fontp
->encoding
[i
] = fontp
->encoding
[1];
643 /* The font itself doesn't have information about encoding. */
646 fontname
= fontp
->full_name
;
647 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
648 others is 1 (i.e. 0x80..0xFF). */
649 fontp
->encoding
[0] = 0;
650 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
651 fontp
->encoding
[i
] = 1;
652 /* Then override them by a specification in Vfont_encoding_alist. */
653 for (list
= Vfont_encoding_alist
; CONSP (list
); list
= XCDR (list
))
657 && STRINGP (XCAR (elt
)) && CONSP (XCDR (elt
))
658 && (fast_c_string_match_ignore_case (XCAR (elt
), fontname
)
663 for (tmp
= XCDR (elt
); CONSP (tmp
); tmp
= XCDR (tmp
))
664 if (CONSP (XCAR (tmp
))
665 && ((i
= get_charset_id (XCAR (XCAR (tmp
))))
667 && INTEGERP (XCDR (XCAR (tmp
)))
668 && XFASTINT (XCDR (XCAR (tmp
))) < 4)
670 = XFASTINT (XCDR (XCAR (tmp
)));
675 fontp
->font_encoder
= (struct ccl_program
*) 0;
677 if (find_ccl_program_func
)
678 (*find_ccl_program_func
) (fontp
);
680 /* If we loaded a font for a face that has fontset, record the face
681 ID in the fontset for C. */
684 && !BASE_FONTSET_P (fontset
))
685 FONTSET_SET (fontset
, c
, make_number (face
->id
));
690 /* Cache data used by fontset_pattern_regexp. The car part is a
691 pattern string containing at least one wild card, the cdr part is
692 the corresponding regular expression. */
693 static Lisp_Object Vcached_fontset_data
;
695 #define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
696 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
698 /* If fontset name PATTERN contains any wild card, return regular
699 expression corresponding to PATTERN. */
702 fontset_pattern_regexp (pattern
)
705 if (!index (XSTRING (pattern
)->data
, '*')
706 && !index (XSTRING (pattern
)->data
, '?'))
707 /* PATTERN does not contain any wild cards. */
710 if (!CONSP (Vcached_fontset_data
)
711 || strcmp (XSTRING (pattern
)->data
, CACHED_FONTSET_NAME
))
713 /* We must at first update the cached data. */
714 char *regex
= (char *) alloca (XSTRING (pattern
)->size
* 2);
715 char *p0
, *p1
= regex
;
717 /* Convert "*" to ".*", "?" to ".". */
719 for (p0
= (char *) XSTRING (pattern
)->data
; *p0
; p0
++)
734 Vcached_fontset_data
= Fcons (build_string (XSTRING (pattern
)->data
),
735 build_string (regex
));
738 return CACHED_FONTSET_REGEX
;
741 /* Return ID of the base fontset named NAME. If there's no such
742 fontset, return -1. */
745 fs_query_fontset (name
, regexpp
)
752 name
= Fdowncase (name
);
755 tem
= Frassoc (name
, Vfontset_alias_alist
);
756 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
760 tem
= fontset_pattern_regexp (name
);
769 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
772 unsigned char *this_name
;
774 fontset
= FONTSET_FROM_ID (i
);
776 || !BASE_FONTSET_P (fontset
))
779 this_name
= XSTRING (FONTSET_NAME (fontset
))->data
;
781 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
782 : !strcmp (XSTRING (name
)->data
, this_name
))
789 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
790 "Return the name of a fontset that matches PATTERN.\n\
791 The value is nil if there is no matching fontset.\n\
792 PATTERN can contain `*' or `?' as a wildcard\n\
793 just as X font name matching algorithm allows.\n\
794 If REGEXPP is non-nil, PATTERN is a regular expression.")
796 Lisp_Object pattern
, regexpp
;
801 (*check_window_system_func
) ();
803 CHECK_STRING (pattern
, 0);
805 if (XSTRING (pattern
)->size
== 0)
808 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
812 fontset
= FONTSET_FROM_ID (id
);
813 return FONTSET_NAME (fontset
);
816 /* Return a list of base fontset names matching PATTERN on frame F.
817 If SIZE is not 0, it is the size (maximum bound width) of fontsets
821 list_fontsets (f
, pattern
, size
)
826 Lisp_Object frame
, regexp
, val
;
829 XSETFRAME (frame
, f
);
831 regexp
= fontset_pattern_regexp (pattern
);
834 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
839 fontset
= FONTSET_FROM_ID (id
);
841 || !BASE_FONTSET_P (fontset
)
842 || !EQ (frame
, FONTSET_FRAME (fontset
)))
844 name
= XSTRING (FONTSET_NAME (fontset
))->data
;
847 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
848 : strcmp (XSTRING (pattern
)->data
, name
))
853 struct font_info
*fontp
;
854 fontp
= FS_LOAD_FONT (f
, 0, NULL
, id
);
855 if (!fontp
|| size
!= fontp
->size
)
858 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
864 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
865 "Create a new fontset NAME that contains font information in FONTLIST.\n\
866 FONTLIST is an alist of charsets vs corresponding font name patterns.")
868 Lisp_Object name
, fontlist
;
870 Lisp_Object fontset
, elements
, ascii_font
;
871 Lisp_Object tem
, tail
, elt
;
873 (*check_window_system_func
) ();
875 CHECK_STRING (name
, 0);
876 CHECK_LIST (fontlist
, 1);
878 name
= Fdowncase (name
);
879 tem
= Fquery_fontset (name
, Qnil
);
881 error ("Fontset `%s' matches the existing fontset `%s'",
882 XSTRING (name
)->data
, XSTRING (tem
)->data
);
884 /* Check the validity of FONTLIST while creating a template for
886 elements
= ascii_font
= Qnil
;
887 for (tail
= fontlist
; CONSP (tail
); tail
= XCDR (tail
))
893 || (charset
= get_charset_id (XCAR (tem
))) < 0
894 || !STRINGP (XCDR (tem
)))
895 error ("Elements of fontlist must be a cons of charset and font name");
897 tem
= Fdowncase (XCDR (tem
));
898 if (charset
== CHARSET_ASCII
)
902 c
= MAKE_CHAR (charset
, 0, 0);
903 elements
= Fcons (Fcons (make_number (c
), tem
), elements
);
907 if (NILP (ascii_font
))
908 error ("No ASCII font in the fontlist");
910 fontset
= make_fontset (Qnil
, name
, Qnil
);
911 FONTSET_ASCII (fontset
) = Fcons (make_number (0), ascii_font
);
912 for (; CONSP (elements
); elements
= XCDR (elements
))
914 elt
= XCAR (elements
);
915 tem
= Fcons (XCAR (elt
), font_family_registry (XCDR (elt
)));
916 FONTSET_SET (fontset
, XINT (XCAR (elt
)), tem
);
923 /* Clear all elements of FONTSET for multibyte characters. */
926 clear_fontset_elements (fontset
)
931 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
932 XCHAR_TABLE (fontset
)->contents
[i
] = Qnil
;
936 /* Check validity of NAME as a fontset name and return the
937 corresponding fontset. If not valid, signal an error.
938 If NAME is t, return Vdefault_fontset. */
941 check_fontset_name (name
)
947 return Vdefault_fontset
;
949 CHECK_STRING (name
, 0);
950 id
= fs_query_fontset (name
, 0);
952 error ("Fontset `%s' does not exist", XSTRING (name
)->data
);
953 return FONTSET_FROM_ID (id
);
956 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 4, 0,
957 "Modify fontset NAME to use FONTNAME for CHARACTER.\n\
959 CHARACTER may be a cons; (FROM . TO), where FROM and TO are\n\
960 non-generic characters. In that case, use FONTNAME\n\
961 for all characters in the range FROM and TO (inclusive).\n\
962 CHARACTER may be a charset. In that case, use FONTNAME\n\
963 for all character in the charsets.\n\
965 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family\n\
966 name of a font, REGSITRY is a registry name of a font.")
967 (name
, character
, fontname
, frame
)
968 Lisp_Object name
, character
, fontname
, frame
;
970 Lisp_Object fontset
, elt
;
971 Lisp_Object realized
;
974 Lisp_Object family
, registry
;
976 fontset
= check_fontset_name (name
);
978 if (CONSP (character
))
980 /* CH should be (FROM . TO) where FROM and TO are non-generic
982 CHECK_NUMBER (XCAR (character
), 1);
983 CHECK_NUMBER (XCDR (character
), 1);
984 from
= XINT (XCAR (character
));
985 to
= XINT (XCDR (character
));
986 if (!char_valid_p (from
, 0) || !char_valid_p (to
, 0))
987 error ("Character range should be by non-generic characters.");
989 && (SINGLE_BYTE_CHAR_P (from
) || SINGLE_BYTE_CHAR_P (to
)))
990 error ("Can't change font for a single byte character");
992 else if (SYMBOLP (character
))
994 elt
= Fget (character
, Qcharset
);
995 if (!VECTORP (elt
) || ASIZE (elt
) < 1 || !NATNUMP (AREF (elt
, 0)))
996 error ("Invalid charset: %s", (XSYMBOL (character
)->name
)->data
);
997 from
= MAKE_CHAR (XINT (AREF (elt
, 0)), 0, 0);
1002 CHECK_NUMBER (character
, 1);
1003 from
= XINT (character
);
1006 if (!char_valid_p (from
, 1))
1007 invalid_character (from
);
1008 if (SINGLE_BYTE_CHAR_P (from
))
1009 error ("Can't change font for a single byte character");
1012 if (!char_valid_p (to
, 1))
1013 invalid_character (to
);
1014 if (SINGLE_BYTE_CHAR_P (to
))
1015 error ("Can't change font for a single byte character");
1018 if (STRINGP (fontname
))
1020 fontname
= Fdowncase (fontname
);
1021 elt
= Fcons (make_number (from
), font_family_registry (fontname
));
1025 CHECK_CONS (fontname
, 2);
1026 family
= XCAR (fontname
);
1027 registry
= XCDR (fontname
);
1030 CHECK_STRING (family
, 2);
1031 family
= Fdowncase (family
);
1033 if (!NILP (registry
))
1035 CHECK_STRING (registry
, 2);
1036 registry
= Fdowncase (registry
);
1038 elt
= Fcons (make_number (from
), Fcons (family
, registry
));
1041 /* The arg FRAME is kept for backward compatibility. We only check
1044 CHECK_LIVE_FRAME (frame
, 3);
1046 for (; from
<= to
; from
++)
1047 FONTSET_SET (fontset
, from
, elt
);
1048 Foptimize_char_table (fontset
);
1050 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1051 clear all the elements of REALIZED and free all multibyte faces
1052 whose fontset is REALIZED. This way, the specified character(s)
1053 are surely redisplayed by a correct font. */
1054 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1056 realized
= AREF (Vfontset_table
, id
);
1057 if (!NILP (realized
)
1058 && !BASE_FONTSET_P (realized
)
1059 && EQ (FONTSET_BASE (realized
), fontset
))
1061 FRAME_PTR f
= XFRAME (FONTSET_FRAME (realized
));
1062 clear_fontset_elements (realized
);
1063 free_realized_multibyte_face (f
, id
);
1070 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1071 "Return information about a font named NAME on frame FRAME.\n\
1072 If FRAME is omitted or nil, use the selected frame.\n\
1073 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
1074 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
1076 OPENED-NAME is the name used for opening the font,\n\
1077 FULL-NAME is the full name of the font,\n\
1078 SIZE is the maximum bound width of the font,\n\
1079 HEIGHT is the height of the font,\n\
1080 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
1081 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
1082 how to compose characters.\n\
1083 If the named font is not yet loaded, return nil.")
1085 Lisp_Object name
, frame
;
1088 struct font_info
*fontp
;
1091 (*check_window_system_func
) ();
1093 CHECK_STRING (name
, 0);
1094 name
= Fdowncase (name
);
1096 frame
= selected_frame
;
1097 CHECK_LIVE_FRAME (frame
, 1);
1100 if (!query_font_func
)
1101 error ("Font query function is not supported");
1103 fontp
= (*query_font_func
) (f
, XSTRING (name
)->data
);
1107 info
= Fmake_vector (make_number (7), Qnil
);
1109 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1110 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1111 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1112 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1113 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1114 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1115 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1121 /* Return the font name for the character at POSITION in the current
1122 buffer. This is computed from all the text properties and overlays
1123 that apply to POSITION. It returns nil in the following cases:
1125 (1) The window system doesn't have a font for the character (thus
1126 it is displayed by an empty box).
1128 (2) The character code is invalid.
1130 (3) The current buffer is not displayed in any window.
1132 In addition, the returned font name may not take into account of
1133 such redisplay engine hooks as what used in jit-lock-mode if
1134 POSITION is currently not visible. */
1137 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1138 "For internal use only.")
1140 Lisp_Object position
;
1142 int pos
, pos_byte
, dummy
;
1150 CHECK_NUMBER_COERCE_MARKER (position
, 0);
1151 pos
= XINT (position
);
1152 if (pos
< BEGV
|| pos
>= ZV
)
1153 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1154 pos_byte
= CHAR_TO_BYTE (pos
);
1155 c
= FETCH_CHAR (pos_byte
);
1156 if (! CHAR_VALID_P (c
, 0))
1158 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1161 w
= XWINDOW (window
);
1162 f
= XFRAME (w
->frame
);
1163 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1164 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
);
1165 face
= FACE_FROM_ID (f
, face_id
);
1166 return (face
->font
&& face
->font_name
1167 ? build_string (face
->font_name
)
1172 /* Called from Ffontset_info via map_char_table on each leaf of
1173 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1174 ARG)' and FONT-INFOs have this form:
1175 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1176 The current leaf is indexed by CHARACTER and has value ELT. This
1177 function add the information of the current leaf to ARG by
1178 appending a new element or modifying the last element.. */
1181 accumulate_font_info (arg
, character
, elt
)
1182 Lisp_Object arg
, character
, elt
;
1184 Lisp_Object last
, last_char
, last_elt
;
1186 if (!CONSP (elt
) && !SINGLE_BYTE_CHAR_P (XINT (character
)))
1187 elt
= FONTSET_REF (Vdefault_fontset
, XINT (character
));
1191 last_char
= XCAR (XCAR (last
));
1192 last_elt
= XCAR (XCDR (XCAR (last
)));
1194 if (!NILP (Fequal (elt
, last_elt
)))
1196 int this_charset
= CHAR_CHARSET (XINT (character
));
1198 if (CONSP (last_char
)) /* LAST_CHAR == (FROM . TO) */
1200 if (this_charset
== CHAR_CHARSET (XINT (XCAR (last_char
))))
1202 XCDR (last_char
) = character
;
1206 else if (XINT (last_char
) == XINT (character
))
1208 else if (this_charset
== CHAR_CHARSET (XINT (last_char
)))
1210 XCAR (XCAR (last
)) = Fcons (last_char
, character
);
1214 XCDR (last
) = Fcons (Fcons (character
, Fcons (elt
, Qnil
)), Qnil
);
1215 XCAR (arg
) = XCDR (last
);
1219 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1220 "Return information about a fontset named NAME on frame FRAME.\n\
1221 The value is a vector:\n\
1222 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],\n\
1224 SIZE is the maximum bound width of ASCII font in the fontset,\n\
1225 HEIGHT is the maximum bound height of ASCII font in the fontset,\n\
1226 CHARSET-OR-RANGE is a charset, a character (may be a generic character)\n\
1227 or a cons of two characters specifying the range of characters.\n\
1228 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),\n\
1229 where FAMILY is a `FAMILY' field of a XLFD font name,\n\
1230 REGISTRY is a `CHARSET_REGISTRY' field of a XLDF font name.\n\
1231 FAMILY may contain a `FOUNDARY' field at the head.\n\
1232 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.\n\
1233 OPENEDs are names of fonts actually opened.\n\
1234 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.\n\
1235 If FRAME is omitted, it defaults to the currently selected frame.")
1237 Lisp_Object name
, frame
;
1239 Lisp_Object fontset
;
1241 Lisp_Object indices
[3];
1242 Lisp_Object val
, tail
, elt
;
1243 Lisp_Object
*realized
;
1244 struct font_info
*fontp
= NULL
;
1248 (*check_window_system_func
) ();
1250 fontset
= check_fontset_name (name
);
1253 frame
= selected_frame
;
1254 CHECK_LIVE_FRAME (frame
, 1);
1257 /* Recode realized fontsets whose base is FONTSET in the table
1259 realized
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1260 * ASIZE (Vfontset_table
));
1261 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1263 elt
= FONTSET_FROM_ID (i
);
1265 && EQ (FONTSET_BASE (elt
), fontset
))
1266 realized
[n_realized
++] = elt
;
1269 /* Accumulate information of the fontset in VAL. The format is
1270 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1271 FONT-SPEC). See the comment for accumulate_font_info for the
1273 val
= Fcons (Fcons (make_number (0),
1274 Fcons (XCDR (FONTSET_ASCII (fontset
)), Qnil
)),
1276 val
= Fcons (val
, val
);
1277 map_char_table (accumulate_font_info
, Qnil
, fontset
, val
, 0, indices
);
1280 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1281 character for a charset, replace it with the charset symbol. If
1282 fonts are opened for FONT-SPEC, append the names of the fonts to
1284 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
1288 if (INTEGERP (XCAR (elt
)))
1290 int charset
, c1
, c2
;
1291 c
= XINT (XCAR (elt
));
1292 SPLIT_CHAR (c
, charset
, c1
, c2
);
1294 XCAR (elt
) = CHARSET_SYMBOL (charset
);
1297 c
= XINT (XCAR (XCAR (elt
)));
1298 for (i
= 0; i
< n_realized
; i
++)
1300 Lisp_Object face_id
, font
;
1303 face_id
= FONTSET_REF_VIA_BASE (realized
[i
], c
);
1304 if (INTEGERP (face_id
))
1306 face
= FACE_FROM_ID (f
, XINT (face_id
));
1307 if (face
->font
&& face
->font_name
)
1309 font
= build_string (face
->font_name
);
1310 if (NILP (Fmember (font
, XCDR (XCDR (elt
)))))
1311 XCDR (XCDR (elt
)) = Fcons (font
, XCDR (XCDR (elt
)));
1317 elt
= Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII
), val
)));
1321 fontp
= (*query_font_func
) (f
, XSTRING (elt
)->data
);
1323 val
= Fmake_vector (make_number (3), val
);
1324 AREF (val
, 0) = fontp
? make_number (fontp
->size
) : make_number (0);
1325 AREF (val
, 1) = fontp
? make_number (fontp
->height
) : make_number (0);
1329 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1330 "Return a font name pattern for character CH in fontset NAME.\n\
1331 If NAME is t, find a font name pattern in the default fontset.")
1333 Lisp_Object name
, ch
;
1336 Lisp_Object fontset
, elt
;
1338 fontset
= check_fontset_name (name
);
1340 CHECK_NUMBER (ch
, 1);
1342 if (!char_valid_p (c
, 1))
1343 invalid_character (c
);
1345 elt
= FONTSET_REF (fontset
, c
);
1353 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1354 "Return a list of all defined fontset names.")
1357 Lisp_Object fontset
, list
;
1361 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1363 fontset
= FONTSET_FROM_ID (i
);
1365 && BASE_FONTSET_P (fontset
))
1366 list
= Fcons (FONTSET_NAME (fontset
), list
);
1375 if (!load_font_func
)
1376 /* Window system initializer should have set proper functions. */
1379 Qfontset
= intern ("fontset");
1380 staticpro (&Qfontset
);
1381 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (3));
1383 Vcached_fontset_data
= Qnil
;
1384 staticpro (&Vcached_fontset_data
);
1386 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1387 staticpro (&Vfontset_table
);
1389 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1390 staticpro (&Vdefault_fontset
);
1391 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1392 FONTSET_NAME (Vdefault_fontset
)
1393 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1394 #if defined (macintosh)
1395 FONTSET_ASCII (Vdefault_fontset
)
1396 = Fcons (make_number (0),
1397 build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));
1398 #elif defined (WINDOWSNT)
1399 FONTSET_ASCII (Vdefault_fontset
)
1400 = Fcons (make_number (0),
1401 build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
1403 FONTSET_ASCII (Vdefault_fontset
)
1404 = Fcons (make_number (0),
1405 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1407 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1408 next_fontset_id
= 1;
1410 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1411 "Alist of fontname patterns vs corresponding encoding info.\n\
1412 Each element looks like (REGEXP . ENCODING-INFO),\n\
1413 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
1414 ENCODING is one of the following integer values:\n\
1415 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
1416 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
1417 2: code points 0x20A0..0x7FFF are used,\n\
1418 3: code points 0xA020..0xFF7F are used.");
1419 Vfont_encoding_alist
= Qnil
;
1421 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1422 "Char table of characters whose ascent values should be ignored.\n\
1423 If an entry for a character is non-nil, the ascent value of the glyph\n\
1424 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
1426 This affects how a composite character which contains\n\
1427 such a character is displayed on screen.");
1428 Vuse_default_ascent
= Qnil
;
1430 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1431 "Char table of characters which is not composed relatively.\n\
1432 If an entry for a character is non-nil, a composition sequence\n\
1433 which contains that character is displayed so that\n\
1434 the glyph of that character is put without considering\n\
1435 an ascent and descent value of a previous character.");
1436 Vignore_relative_composition
= Qnil
;
1438 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1439 "Alist of fontname vs list of the alternate fontnames.\n\
1440 When a specified font name is not found, the corresponding\n\
1441 alternate fontnames (if any) are tried instead.");
1442 Valternate_fontname_alist
= Qnil
;
1444 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1445 "Alist of fontset names vs the aliases.");
1446 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1447 build_string ("fontset-default")),
1450 DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font
,
1451 "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
1452 The way to highlight them depends on window system on which Emacs runs.\n\
1453 On X11, a rectangle is shown around each such character.");
1454 Vhighlight_wrong_size_font
= Qnil
;
1456 DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font
,
1457 "*Non-nil means characters shown in overlarge fonts are clipped.\n\
1458 The height of clipping area is the same as that of an ASCII character.\n\
1459 The width of the area is the same as that of an ASCII character,\n\
1460 or twice as wide, depending on the character set's column-width.\n\
1462 If the only font you have for a specific character set is too large,\n\
1463 and clipping these characters makes them hard to read,\n\
1464 you can set this variable to nil to display the characters without clipping.\n\
1465 The drawback is that you will get some garbage left on your screen.");
1466 Vclip_large_size_font
= Qt
;
1468 DEFVAR_LISP ("vertical-centering-font-regexp",
1469 &Vvertical_centering_font_regexp
,
1470 "*Regexp matching font names that require vertical centering on display.\n\
1471 When a character is displayed with such fonts, the character is displayed\n\
1472 at the vertival center of lines.");
1473 Vvertical_centering_font_regexp
= Qnil
;
1475 defsubr (&Squery_fontset
);
1476 defsubr (&Snew_fontset
);
1477 defsubr (&Sset_fontset_font
);
1478 defsubr (&Sfont_info
);
1479 defsubr (&Sinternal_char_font
);
1480 defsubr (&Sfontset_info
);
1481 defsubr (&Sfontset_font
);
1482 defsubr (&Sfontset_list
);