2 Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2, or (at your option)
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs; see the file COPYING. If not, write to
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 Boston, MA 02111-1307, USA. */
25 /* #define FONTSET_DEBUG */
34 #include "blockinput.h"
36 #include "character.h"
41 #include "dispextern.h"
42 #include "intervals.h"
48 #define xassert(X) do {if (!(X)) abort ();} while (0)
51 #else /* not FONTSET_DEBUG */
52 #define xassert(X) (void) 0
53 #endif /* not FONTSET_DEBUG */
55 EXFUN (Fclear_face_cache
, 1);
59 A fontset is a collection of font related information to give
60 similar appearance (style, etc) of characters. A fontset has two
61 roles. One is to use for the frame parameter `font' as if it is an
62 ASCII font. In that case, Emacs uses the font specified for
63 `ascii' script for the frame's default font.
65 Another role, the more important one, is to provide information
66 about which font to use for each non-ASCII character.
68 There are two kinds of fontsets; base and realized. A base fontset
69 is created by `new-fontset' from Emacs Lisp explicitly. A realized
70 fontset is created implicitly when a face is realized for ASCII
71 characters. A face is also realized for non-ASCII characters based
72 on an ASCII face. All of non-ASCII faces based on the same ASCII
73 face share the same realized fontset.
75 A fontset object is implemented by a char-table whose default value
76 and parent are always nil.
78 An element of a base fontset is a vector of FONT-DEFs which itself
79 is a vector [ FONT-SPEC ENCODING REPERTORY ].
82 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
85 where FAMILY, WEIGHT, SLANT, SWIDTH, ADSTYLE, REGISTRY, and
86 FONT-NAME are strings.
88 ENCODING is a charset ID that can convert characters to glyph codes
89 of the corresponding font.
91 REPERTORY is a charset ID, a char-table, or nil. If REPERTORY is a
92 charset ID, the repertory of the charset exactly matches with that
93 of the font. If REPERTORY is a char-table, all characters who have
94 a non-nil value in the table are supported. If REPERTORY is nil,
95 we consult with the font itself to get the repertory.
97 ENCODING and REPERTORY are extracted from the variable
98 Vfont_encoding_alist by using a font name generated from FONT-SPEC
99 (if it is a vector) or FONT-NAME as a key.
102 An element of a realized fontset is nil or t, or has this form:
104 [CHARSET-PRIORITY-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-FONT-DEF
105 FONT-DEF0 FONT-DEF1 ...].
107 FONT-DEFn has this form:
109 [ FACE-ID FONT-INDEX FONT-DEF ]
111 FONT-DEFn is automatically reordered by the current charset
114 The value nil means that we have not yet generated FONT-VECTOR from
115 the base of the fontset.
117 The value t means that no font is available for the corresponding
121 A fontset has 9 extra slots.
123 The 1st slot: the ID number of the fontset
126 base: the name of the fontset
131 realized: the base fontset
135 realized: the frame that the fontset belongs to
138 base: the font name for ASCII characters
143 realized: the ID number of a face to use for characters that
144 has no font in a realized fontset.
148 realized: Alist of font index vs the corresponding repertory
153 realized: If the base is not the default fontset, a fontset
154 realized from the default fontset, else nil.
157 base: Same as element value (but for fallback fonts).
160 All fontsets are recorded in the vector Vfontset_table.
165 There's a special base fontset named `default fontset' which
166 defines the default font specifications. When a base fontset
167 doesn't specify a font for a specific character, the corresponding
168 value in the default fontset is used.
170 The parent of a realized fontset created for such a face that has
171 no fontset is the default fontset.
174 These structures are hidden from the other codes than this file.
175 The other codes handle fontsets only by their ID numbers. They
176 usually use the variable name `fontset' for IDs. But, in this
177 file, we always use varialbe name `id' for IDs, and name `fontset'
178 for an actual fontset object, i.e., char-table.
182 /********** VARIABLES and FUNCTION PROTOTYPES **********/
184 extern Lisp_Object Qfont
;
185 static Lisp_Object Qfontset
;
186 static Lisp_Object Qfontset_info
;
187 static Lisp_Object Qprepend
, Qappend
;
189 /* Vector containing all fontsets. */
190 static Lisp_Object Vfontset_table
;
192 /* Next possibly free fontset ID. Usually this keeps the minimum
193 fontset ID not yet used. */
194 static int next_fontset_id
;
196 /* The default fontset. This gives default FAMILY and REGISTRY of
197 font for each character. */
198 static Lisp_Object Vdefault_fontset
;
200 Lisp_Object Vfont_encoding_alist
;
201 Lisp_Object Vuse_default_ascent
;
202 Lisp_Object Vignore_relative_composition
;
203 Lisp_Object Valternate_fontname_alist
;
204 Lisp_Object Vfontset_alias_alist
;
205 Lisp_Object Vvertical_centering_font_regexp
;
207 /* The following six are declarations of callback functions depending
208 on window system. See the comments in src/fontset.h for more
211 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
212 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
214 /* Return a list of font names which matches PATTERN. See the documentation
215 of `x-list-fonts' for more details. */
216 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
221 /* Load a font named NAME for frame F and return a pointer to the
222 information of the loaded font. If loading is failed, return 0. */
223 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
225 /* Return a pointer to struct font_info of a font named NAME for frame F. */
226 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
228 /* Additional function for setting fontset or changing fontset
229 contents of frame F. */
230 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
231 Lisp_Object oldval
));
233 /* To find a CCL program, fs_load_font calls this function.
234 The argument is a pointer to the struct font_info.
235 This function set the member `encoder' of the structure. */
236 void (*find_ccl_program_func
) P_ ((struct font_info
*));
238 Lisp_Object (*get_font_repertory_func
) P_ ((struct frame
*,
239 struct font_info
*));
241 /* Check if any window system is used now. */
242 void (*check_window_system_func
) P_ ((void));
245 /* Prototype declarations for static functions. */
246 static Lisp_Object fontset_add
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
248 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
249 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
250 static void accumulate_script_ranges
P_ ((Lisp_Object
, Lisp_Object
,
252 static Lisp_Object find_font_encoding
P_ ((char *));
254 static void set_fontset_font
P_ ((Lisp_Object
, Lisp_Object
));
258 /* Return 1 if ID is a valid fontset id, else return 0. */
261 fontset_id_valid_p (id
)
264 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
271 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
273 /* Return the fontset with ID. No check of ID's validness. */
274 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
276 /* Macros to access special values of FONTSET. */
277 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
279 /* Macros to access special values of (base) FONTSET. */
280 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
281 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
283 /* Macros to access special values of (realized) FONTSET. */
284 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
285 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
286 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
287 #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
288 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
290 /* For both base and realized fontset. */
291 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
293 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
296 /* Return the element of FONTSET for the character C. If FONTSET is a
297 base fontset other then the default fontset and FONTSET doesn't
298 contain information for C, return the information in the default
301 #define FONTSET_REF(fontset, c) \
302 (EQ (fontset, Vdefault_fontset) \
303 ? CHAR_TABLE_REF (fontset, c) \
304 : fontset_ref ((fontset), (c)))
307 fontset_ref (fontset
, c
)
313 elt
= CHAR_TABLE_REF (fontset
, c
);
314 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
315 /* Don't check Vdefault_fontset for a realized fontset. */
316 && NILP (FONTSET_BASE (fontset
)))
317 elt
= CHAR_TABLE_REF (Vdefault_fontset
, c
);
322 /* Return the element of FONTSET for the character C, set FROM and TO
323 to the range of characters around C that have the same value as C.
324 If FONTSET is a base fontset other then the default fontset and
325 FONTSET doesn't contain information for C, return the information
326 in the default fontset. */
328 #define FONTSET_REF_AND_RANGE(fontset, c, form, to) \
329 (EQ (fontset, Vdefault_fontset) \
330 ? char_table_ref_and_range (fontset, c, &from, &to) \
331 : fontset_ref_and_range (fontset, c, &from, &to))
334 fontset_ref_and_range (fontset
, c
, from
, to
)
341 elt
= char_table_ref_and_range (fontset
, c
, from
, to
);
342 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
343 /* Don't check Vdefault_fontset for a realized fontset. */
344 && NILP (FONTSET_BASE (fontset
)))
348 elt
= char_table_ref_and_range (Vdefault_fontset
, c
, &from1
, &to1
);
358 /* Set elements of FONTSET for characters in RANGE to the value ELT.
359 RANGE is a cons (FROM . TO), where FROM and TO are character codes
360 specifying a range. */
362 #define FONTSET_SET(fontset, range, elt) \
363 Fset_char_table_range ((fontset), (range), (elt))
366 /* Modify the elements of FONTSET for characters in RANGE by replacing
367 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
368 and TO are character codes specifying a range. If ADD is nil,
369 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
372 #define FONTSET_ADD(fontset, range, elt, add) \
375 ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
376 : Fset_char_table_range ((fontset), (range), \
377 Fmake_vector (make_number (1), (elt)))) \
378 : fontset_add ((fontset), (range), (elt), (add)))
381 fontset_add (fontset
, range
, elt
, add
)
382 Lisp_Object fontset
, range
, elt
, add
;
385 int idx
= (EQ (add
, Qappend
) ? 0 : 1);
387 args
[1 - idx
] = Fmake_vector (make_number (1), elt
);
391 int from
= XINT (XCAR (range
));
392 int to
= XINT (XCDR (range
));
396 args
[idx
] = char_table_ref_and_range (fontset
, from
, &from1
, &to1
);
399 char_table_set_range (fontset
, from
, to1
,
400 NILP (args
[idx
]) ? args
[1 - idx
]
401 : Fvconcat (2, args
));
407 args
[idx
] = FONTSET_FALLBACK (fontset
);
408 FONTSET_FALLBACK (fontset
)
409 = NILP (args
[idx
]) ? args
[1 - idx
] : Fvconcat (2, args
);
415 /* Update FONTSET_ELEMENT which has this form:
416 [CHARSET-PRIORITY-LIST-TICK PREFERRED-CHARSET-ID INDEX
417 FONT-DEF0 FONT-DEF1 ...].
418 Reorder FONT-DEFs according to the current order of charset
419 (Vcharset_ordered_list), and update CHARSET-PRIORITY-LIST-TICK to
423 reorder_font_vector (fontset_element
)
424 Lisp_Object fontset_element
;
426 Lisp_Object vec
, list
, *new_vec
;
427 Lisp_Object font_def
;
429 int *charset_id_table
;
432 ASET (fontset_element
, 0, make_number (charset_ordered_list_tick
));
433 size
= ASIZE (fontset_element
) - 3;
435 /* No need of reordering VEC. */
437 charset_id_table
= (int *) alloca (sizeof (int) * size
);
438 new_vec
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
) * size
);
440 /* At first, extract ENCODING (a chaset ID) from each FONT-DEF.
441 FONT-DEF has this form:
442 [FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] */
443 for (i
= 0; i
< size
; i
++)
445 font_def
= AREF (fontset_element
, i
+ 3);
446 charset_id_table
[i
] = XINT (AREF (AREF (font_def
, 2), 1));
449 /* Then, store FONT-DEFs in NEW_VEC in the correct order. */
450 for (idx
= 0, list
= Vcharset_ordered_list
;
451 idx
< size
&& CONSP (list
); list
= XCDR (list
))
453 for (i
= 0; i
< size
; i
++)
454 if (charset_id_table
[i
] == XINT (XCAR (list
)))
455 new_vec
[idx
++] = AREF (fontset_element
, i
+ 3);
458 /* At last, update FONT-DEFs. */
459 for (i
= 0; i
< size
; i
++)
460 ASET (fontset_element
, i
+ 3, new_vec
[i
]);
464 /* Load a font matching the font related attributes in FACE->lface and
465 font pattern in FONT_DEF of FONTSET, and return an index of the
466 font. FONT_DEF has this form:
467 [ FONT-SPEC ENCODING REPERTORY ]
468 If REPERTORY is nil, generate a char-table representing the font
469 repertory by looking into the font itself. */
472 load_font_get_repertory (f
, face
, font_def
, fontset
)
475 Lisp_Object font_def
;
479 struct font_info
*font_info
;
482 font_name
= choose_face_font (f
, face
->lface
, AREF (font_def
, 0), NULL
);
483 if (NATNUMP (AREF (font_def
, 1)))
484 charset
= XINT (AREF (font_def
, 1));
487 if (! (font_info
= fs_load_font (f
, font_name
, charset
)))
490 if (NILP (AREF (font_def
, 2))
491 && NILP (Fassq (make_number (font_info
->font_idx
),
492 FONTSET_REPERTORY (fontset
))))
494 /* We must look into the font to get the correct repertory as a
496 Lisp_Object repertory
;
498 repertory
= (*get_font_repertory_func
) (f
, font_info
);
499 FONTSET_REPERTORY (fontset
)
500 = Fcons (Fcons (make_number (font_info
->font_idx
), repertory
),
501 FONTSET_REPERTORY (fontset
));
504 return font_info
->font_idx
;
508 /* Return a face ID registerd in the realized fontset FONTSET for the
509 character C. If a face is not yet set, return -1 (if FACE is NULL)
510 or realize a proper face from FACE and return it. */
513 fontset_face (fontset
, c
, face
, id
)
519 Lisp_Object base_fontset
, elt
, vec
;
522 FRAME_PTR f
= XFRAME (FONTSET_FRAME (fontset
));
524 base_fontset
= FONTSET_BASE (fontset
);
525 vec
= CHAR_TABLE_REF (fontset
, c
);
531 /* We have not yet decided a face for C. */
536 elt
= FONTSET_REF_AND_RANGE (base_fontset
, c
, from
, to
);
537 range
= Fcons (make_number (from
), make_number (to
));
540 /* Record that we have no font for characters of this
543 FONTSET_SET (fontset
, range
, vec
);
546 /* Build a vector [ -1 -1 nil NEW-ELT0 NEW-ELT1 NEW-ELT2 ... ],
547 where the first -1 is to force reordering of NEW-ELTn,
548 NEW-ETLn is [nil nil AREF (elt, n)]. */
549 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
551 for (i
= 0; i
< ASIZE (elt
); i
++)
555 tmp
= Fmake_vector (make_number (3), Qnil
);
556 ASET (tmp
, 2, AREF (elt
, i
));
557 ASET (vec
, 3 + i
, tmp
);
559 /* Then store it in the fontset. */
560 FONTSET_SET (fontset
, range
, vec
);
564 if (XINT (AREF (vec
, 0)) != charset_ordered_list_tick
)
565 /* The priority of charsets is changed after we selected a face
567 reorder_font_vector (vec
);
571 else if (id
== XFASTINT (AREF (vec
, 1)))
575 ASET (vec
, 1, make_number (id
));
576 for (i
= 3; i
< ASIZE (vec
); i
++)
577 if (id
== XFASTINT (AREF (AREF (AREF (vec
, i
), 2), 1)))
581 ASET (vec
, 2, AREF (vec
, i
));
591 /* Find the first available font in the font vector VEC. */
592 for (; i
< ASIZE (vec
); i
++)
594 Lisp_Object font_def
;
599 /* ELT == [ FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ] ] */
600 font_def
= AREF (elt
, 2);
601 if (INTEGERP (AREF (elt
, 1)) && XINT (AREF (elt
, 1)) < 0)
602 /* We couldn't open this font last time. */
605 if (!face
&& (NILP (AREF (elt
, 1)) || NILP (AREF (elt
, 0))))
606 /* We have not yet opened the font, or we have not yet made a
607 realized face for the font. */
610 if (INTEGERP (AREF (font_def
, 2)))
612 /* The repertory is specified by charset ID. */
613 struct charset
*charset
614 = CHARSET_FROM_ID (XINT (AREF (font_def
, 2)));
616 if (! CHAR_CHARSET_P (c
, charset
))
617 /* This font can't display C. */
620 else if (CHAR_TABLE_P (AREF (font_def
, 2)))
622 /* The repertory is specified by a char table. */
623 if (NILP (CHAR_TABLE_REF (AREF (font_def
, 2), c
)))
624 /* This font can't display C. */
631 if (! INTEGERP (AREF (elt
, 1)))
633 /* We have not yet opened a font matching this spec.
634 Open the best matching font now and register the
636 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
637 ASET (elt
, 1, make_number (font_idx
));
639 /* This means that we couldn't find a font matching
644 slot
= Fassq (AREF (elt
, 1), FONTSET_REPERTORY (fontset
));
647 if (NILP (CHAR_TABLE_REF (XCDR (slot
), c
)))
648 /* This fond can't display C. */
652 /* Now we have decided to use this font spec to display C. */
653 if (INTEGERP (AREF (elt
, 1)))
654 font_idx
= XINT (AREF (elt
, 1));
657 /* But not yet opened the best matching font. */
658 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
659 ASET (elt
, 1, make_number (font_idx
));
664 /* Now we have the opened font. */
665 if (NILP (AREF (elt
, 0)))
667 /* But not yet made a realized face that uses this font. */
668 int face_id
= lookup_non_ascii_face (f
, font_idx
, face
);
670 ASET (elt
, 0, make_number (face_id
));
673 /* Ok, this face can display C. */
674 return XINT (AREF (elt
, 0));
678 if (! EQ (vec
, FONTSET_FALLBACK (fontset
)))
680 vec
= FONTSET_FALLBACK (fontset
);
685 elt
= FONTSET_FALLBACK (base_fontset
);
688 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
690 for (i
= 0; i
< ASIZE (elt
); i
++)
694 tmp
= Fmake_vector (make_number (3), Qnil
);
695 ASET (tmp
, 2, AREF (elt
, i
));
696 ASET (vec
, 3 + i
, tmp
);
698 FONTSET_FALLBACK (fontset
) = vec
;
701 /* Record that this fontset has no fallback fonts. */
702 FONTSET_FALLBACK (fontset
) = Qt
;
705 /* Try the default fontset. */
707 if (! EQ (base_fontset
, Vdefault_fontset
))
709 if (NILP (FONTSET_DEFAULT (fontset
)))
710 FONTSET_DEFAULT (fontset
)
711 = make_fontset (FONTSET_FRAME (fontset
), Qnil
, Vdefault_fontset
);
712 return fontset_face (FONTSET_DEFAULT (fontset
), c
, face
, id
);
715 /* We have tried all the fonts for C, but none of them can be opened
716 nor can display C. */
717 if (NILP (FONTSET_NOFONT_FACE (fontset
)))
723 face_id
= lookup_non_ascii_face (f
, -1, face
);
724 FONTSET_NOFONT_FACE (fontset
) = make_number (face_id
);
726 return XINT (FONTSET_NOFONT_FACE (fontset
));
730 /* Return a newly created fontset with NAME. If BASE is nil, make a
731 base fontset. Otherwise make a realized fontset whose base is
735 make_fontset (frame
, name
, base
)
736 Lisp_Object frame
, name
, base
;
739 int size
= ASIZE (Vfontset_table
);
740 int id
= next_fontset_id
;
742 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
743 the next available fontset ID. So it is expected that this loop
744 terminates quickly. In addition, as the last element of
745 Vfontset_table is always nil, we don't have to check the range of
747 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
751 /* We must grow Vfontset_table. */
755 tem
= Fmake_vector (make_number (size
+ 32), Qnil
);
756 for (i
= 0; i
< size
; i
++)
757 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
758 Vfontset_table
= tem
;
761 fontset
= Fmake_char_table (Qfontset
, Qnil
);
763 FONTSET_ID (fontset
) = make_number (id
);
766 FONTSET_NAME (fontset
) = name
;
770 FONTSET_NAME (fontset
) = Qnil
;
771 FONTSET_FRAME (fontset
) = frame
;
772 FONTSET_BASE (fontset
) = base
;
775 ASET (Vfontset_table
, id
, fontset
);
776 next_fontset_id
= id
+ 1;
782 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
784 /* Return the name of the fontset who has ID. */
792 fontset
= FONTSET_FROM_ID (id
);
793 return FONTSET_NAME (fontset
);
797 /* Return the ASCII font name of the fontset who has ID. */
803 Lisp_Object fontset
, elt
;
805 fontset
= FONTSET_FROM_ID (id
);
806 elt
= FONTSET_ASCII (fontset
);
807 /* It is assured that ELT is always a string (i.e. fontname
813 /* Free fontset of FACE defined on frame F. Called from
814 free_realized_face. */
817 free_face_fontset (f
, face
)
823 fontset
= AREF (Vfontset_table
, face
->fontset
);
824 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
825 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
826 ASET (Vfontset_table
, face
->fontset
, Qnil
);
827 if (face
->fontset
< next_fontset_id
)
828 next_fontset_id
= face
->fontset
;
829 if (! NILP (FONTSET_DEFAULT (fontset
)))
831 int id
= XINT (FONTSET_ID (FONTSET_DEFAULT (fontset
)));
833 fontset
= AREF (Vfontset_table
, id
);
834 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
835 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
836 ASET (Vfontset_table
, id
, Qnil
);
837 if (id
< next_fontset_id
)
838 next_fontset_id
= face
->fontset
;
843 /* Return 1 iff FACE is suitable for displaying character C.
844 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
845 when C is not an ASCII character. */
848 face_suitable_for_char_p (face
, c
)
854 fontset
= FONTSET_FROM_ID (face
->fontset
);
855 return (face
->id
== fontset_face (fontset
, c
, NULL
, -1));
859 /* Return ID of face suitable for displaying character C on frame F.
860 FACE must be reazlied for ASCII characters in advance. Called from
861 the macro FACE_FOR_CHAR. */
864 face_for_char (f
, face
, c
, pos
, object
)
870 Lisp_Object fontset
, charset
;
873 if (ASCII_CHAR_P (c
))
874 return face
->ascii_face
->id
;
876 xassert (fontset_id_valid_p (face
->fontset
));
877 fontset
= FONTSET_FROM_ID (face
->fontset
);
878 xassert (!BASE_FONTSET_P (fontset
));
883 charset
= Fget_char_property (make_number (pos
), Qcharset
, object
);
886 else if (CHARSETP (charset
))
887 id
= XINT (CHARSET_SYMBOL_ID (charset
));
889 return fontset_face (fontset
, c
, face
, id
);
893 /* Make a realized fontset for ASCII face FACE on frame F from the
894 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
895 default fontset as the base. Value is the id of the new fontset.
896 Called from realize_x_face. */
899 make_fontset_for_ascii_face (f
, base_fontset_id
, face
)
904 Lisp_Object base_fontset
, fontset
, frame
;
906 XSETFRAME (frame
, f
);
907 if (base_fontset_id
>= 0)
909 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
910 if (!BASE_FONTSET_P (base_fontset
))
911 base_fontset
= FONTSET_BASE (base_fontset
);
912 xassert (BASE_FONTSET_P (base_fontset
));
913 if (! BASE_FONTSET_P (base_fontset
))
917 base_fontset
= Vdefault_fontset
;
919 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
923 elt
= FONTSET_REF (base_fontset
, 0);
924 elt
= Fmake_vector (make_number (4), AREF (elt
, 0));
925 ASET (elt
, 0, make_number (charset_ordered_list_tick
));
926 ASET (elt
, 1, make_number (face
->id
));
927 ASET (elt
, 2, make_number (face
->font_info_id
));
928 char_table_set_range (fontset
, 0, 127, elt
);
930 return XINT (FONTSET_ID (fontset
));
934 #if defined(WINDOWSNT) && defined (_MSC_VER)
935 #pragma optimize("", off)
938 /* Load a font named FONTNAME on frame F. Return a pointer to the
939 struct font_info of the loaded font. If loading fails, return
940 NULL. CHARSET is an ID of charset to encode characters for this
941 font. If it is -1, find one from Vfont_encoding_alist. */
944 fs_load_font (f
, fontname
, charset
)
949 struct font_info
*fontp
;
952 /* No way to get fontname. */
955 fontp
= (*load_font_func
) (f
, fontname
, 0);
956 if (! fontp
|| fontp
->charset
>= 0)
959 fontname
= fontp
->full_name
;
963 Lisp_Object charset_symbol
;
965 charset_symbol
= find_font_encoding (fontname
);
966 if (CONSP (charset_symbol
))
967 charset_symbol
= XCAR (charset_symbol
);
968 charset
= XINT (CHARSET_SYMBOL_ID (charset_symbol
));
970 fontp
->charset
= charset
;
971 fontp
->vertical_centering
= 0;
972 fontp
->font_encoder
= NULL
;
974 if (charset
!= charset_ascii
)
976 fontp
->vertical_centering
977 = (STRINGP (Vvertical_centering_font_regexp
)
978 && (fast_c_string_match_ignore_case
979 (Vvertical_centering_font_regexp
, fontname
) >= 0));
981 if (find_ccl_program_func
)
982 (*find_ccl_program_func
) (fontp
);
988 #if defined(WINDOWSNT) && defined (_MSC_VER)
989 #pragma optimize("", on)
993 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
994 FONTNAME. ENCODING is a charset symbol that specifies the encoding
995 of the font. REPERTORY is a charset symbol or nil. */
999 find_font_encoding (fontname
)
1002 Lisp_Object tail
, elt
;
1004 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
1008 && STRINGP (XCAR (elt
))
1009 && fast_c_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
1010 && (SYMBOLP (XCDR (elt
))
1011 ? CHARSETP (XCDR (elt
))
1012 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
1013 return (XCDR (elt
));
1015 /* We don't know the encoding of this font. */
1020 /* Cache data used by fontset_pattern_regexp. The car part is a
1021 pattern string containing at least one wild card, the cdr part is
1022 the corresponding regular expression. */
1023 static Lisp_Object Vcached_fontset_data
;
1025 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
1026 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1028 /* If fontset name PATTERN contains any wild card, return regular
1029 expression corresponding to PATTERN. */
1032 fontset_pattern_regexp (pattern
)
1033 Lisp_Object pattern
;
1035 if (!index (SDATA (pattern
), '*')
1036 && !index (SDATA (pattern
), '?'))
1037 /* PATTERN does not contain any wild cards. */
1040 if (!CONSP (Vcached_fontset_data
)
1041 || strcmp (SDATA (pattern
), CACHED_FONTSET_NAME
))
1043 /* We must at first update the cached data. */
1044 char *regex
= (char *) alloca (SCHARS (pattern
) * 2 + 3);
1045 char *p0
, *p1
= regex
;
1047 /* Convert "*" to ".*", "?" to ".". */
1049 for (p0
= (char *) SDATA (pattern
); *p0
; p0
++)
1056 else if (*p0
== '?')
1064 Vcached_fontset_data
= Fcons (build_string (SDATA (pattern
)),
1065 build_string (regex
));
1068 return CACHED_FONTSET_REGEX
;
1071 /* Return ID of the base fontset named NAME. If there's no such
1072 fontset, return -1. */
1075 fs_query_fontset (name
, regexpp
)
1082 name
= Fdowncase (name
);
1085 tem
= Frassoc (name
, Vfontset_alias_alist
);
1087 tem
= Fassoc (name
, Vfontset_alias_alist
);
1088 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1092 tem
= fontset_pattern_regexp (name
);
1101 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1103 Lisp_Object fontset
;
1104 unsigned char *this_name
;
1106 fontset
= FONTSET_FROM_ID (i
);
1108 || !BASE_FONTSET_P (fontset
))
1111 this_name
= SDATA (FONTSET_NAME (fontset
));
1113 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
1114 : !strcmp (SDATA (name
), this_name
))
1121 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
1122 doc
: /* Return the name of a fontset that matches PATTERN.
1123 The value is nil if there is no matching fontset.
1124 PATTERN can contain `*' or `?' as a wildcard
1125 just as X font name matching algorithm allows.
1126 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1128 Lisp_Object pattern
, regexpp
;
1130 Lisp_Object fontset
;
1133 (*check_window_system_func
) ();
1135 CHECK_STRING (pattern
);
1137 if (SCHARS (pattern
) == 0)
1140 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
1144 fontset
= FONTSET_FROM_ID (id
);
1145 return FONTSET_NAME (fontset
);
1148 /* Return a list of base fontset names matching PATTERN on frame F. */
1151 list_fontsets (f
, pattern
, size
)
1153 Lisp_Object pattern
;
1156 Lisp_Object frame
, regexp
, val
;
1159 XSETFRAME (frame
, f
);
1161 regexp
= fontset_pattern_regexp (pattern
);
1164 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1166 Lisp_Object fontset
;
1167 unsigned char *name
;
1169 fontset
= FONTSET_FROM_ID (id
);
1171 || !BASE_FONTSET_P (fontset
)
1172 || !EQ (frame
, FONTSET_FRAME (fontset
)))
1174 name
= SDATA (FONTSET_NAME (fontset
));
1176 if (STRINGP (regexp
)
1177 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
1178 : strcmp (SDATA (pattern
), name
))
1181 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
1188 /* Free all realized fontsets whose base fontset is BASE. */
1191 free_realized_fontsets (base
)
1197 /* For the moment, this doesn't work because free_realized_face
1198 doesn't remove FACE from a cache. Until we find a solution, we
1199 suppress this code, and simply use Fclear_face_cache even though
1200 that is not efficient. */
1202 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1204 Lisp_Object
this = AREF (Vfontset_table
, id
);
1206 if (EQ (FONTSET_BASE (this), base
))
1210 for (tail
= FONTSET_FACE_ALIST (this); CONSP (tail
);
1213 FRAME_PTR f
= XFRAME (FONTSET_FRAME (this));
1214 int face_id
= XINT (XCDR (XCAR (tail
)));
1215 struct face
*face
= FACE_FROM_ID (f
, face_id
);
1217 /* Face THIS itself is also freed by the following call. */
1218 free_realized_face (f
, face
);
1224 Fclear_face_cache (Qt
);
1229 /* Check validity of NAME as a fontset name and return the
1230 corresponding fontset. If not valid, signal an error.
1231 If NAME is t, return Vdefault_fontset. */
1234 check_fontset_name (name
)
1240 return Vdefault_fontset
;
1242 CHECK_STRING (name
);
1243 id
= fs_query_fontset (name
, 0);
1245 error ("Fontset `%s' does not exist", SDATA (name
));
1246 return FONTSET_FROM_ID (id
);
1250 accumulate_script_ranges (arg
, range
, val
)
1251 Lisp_Object arg
, range
, val
;
1253 if (EQ (XCAR (arg
), val
))
1256 XSETCDR (arg
, Fcons (Fcons (XCAR (range
), XCDR (range
)), XCDR (arg
)));
1258 XSETCDR (arg
, Fcons (Fcons (range
, range
), XCDR (arg
)));
1263 /* Return an ASCII font name generated from fontset name NAME and
1264 ASCII font specification ASCII_SPEC. NAME is a string conforming
1265 to XLFD. ASCII_SPEC is a vector:
1266 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
1268 static INLINE Lisp_Object
1269 generate_ascii_font_name (name
, ascii_spec
)
1270 Lisp_Object name
, ascii_spec
;
1275 vec
= split_font_name_into_vector (name
);
1276 for (i
= FONT_SPEC_FAMILY_INDEX
; i
<= FONT_SPEC_ADSTYLE_INDEX
; i
++)
1277 if (! NILP (AREF (ascii_spec
, i
)))
1278 ASET (vec
, 1 + i
, AREF (ascii_spec
, i
));
1279 if (! NILP (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
)))
1280 ASET (vec
, 12, AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
1281 return build_font_name_from_vector (vec
);
1285 set_fontset_font (arg
, range
)
1286 Lisp_Object arg
, range
;
1288 Lisp_Object fontset
, font_def
, add
;
1290 fontset
= XCAR (arg
);
1291 font_def
= XCAR (XCDR (arg
));
1292 add
= XCAR (XCDR (XCDR (arg
)));
1293 FONTSET_ADD (fontset
, range
, font_def
, add
);
1294 free_realized_fontsets (fontset
);
1298 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 5, 0,
1300 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1302 TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
1303 In that case, use FONT-SPEC for all characters in the range FROM and
1306 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1307 all characters that belong to the script.
1309 TARGET may be a charset. In that case, use FONT-SPEC for all
1310 characters in the charset.
1312 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1313 that no FONT-SPEC is specified.
1316 * A vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ].
1317 See the documentation of `set-face-attribute' for the detail of
1318 these vector elements;
1319 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1320 REGISTRY is a font registry name;
1321 * A font name string.
1323 Optional 4th argument FRAME, if non-nil, is a frame. This argument is
1324 kept for backward compatibility and has no meaning.
1326 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1327 to the font specifications for TARGET previously set. If it is
1328 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1329 appended. By default, FONT-SPEC overrides the previous settings. */)
1330 (name
, target
, font_spec
, frame
, add
)
1331 Lisp_Object name
, target
, font_spec
, frame
, add
;
1333 Lisp_Object fontset
;
1334 Lisp_Object font_def
, registry
;
1335 Lisp_Object encoding
, repertory
;
1336 Lisp_Object range_list
;
1338 fontset
= check_fontset_name (name
);
1340 /* The arg FRAME is kept for backward compatibility. We only check
1343 CHECK_LIVE_FRAME (frame
);
1345 if (VECTORP (font_spec
))
1349 if (ASIZE (font_spec
) != FONT_SPEC_MAX_INDEX
)
1350 args_out_of_range (make_number (FONT_SPEC_MAX_INDEX
),
1351 make_number (ASIZE (font_spec
)));
1353 font_spec
= Fcopy_sequence (font_spec
);
1354 for (j
= 0; j
< FONT_SPEC_MAX_INDEX
- 1; j
++)
1355 if (! NILP (AREF (font_spec
, j
)))
1357 CHECK_STRING (AREF (font_spec
, j
));
1358 ASET (font_spec
, j
, Fdowncase (AREF (font_spec
, j
)));
1360 /* REGISTRY should not be omitted. */
1361 CHECK_STRING (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1362 registry
= Fdowncase (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1363 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1366 else if (CONSP (font_spec
))
1370 family
= XCAR (font_spec
);
1371 registry
= XCDR (font_spec
);
1373 if (! NILP (family
))
1375 CHECK_STRING (family
);
1376 family
= Fdowncase (family
);
1378 CHECK_STRING (registry
);
1379 registry
= Fdowncase (registry
);
1380 font_spec
= Fmake_vector (make_number (FONT_SPEC_MAX_INDEX
), Qnil
);
1381 ASET (font_spec
, FONT_SPEC_FAMILY_INDEX
, family
);
1382 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1386 CHECK_STRING (font_spec
);
1387 font_spec
= Fdowncase (font_spec
);
1390 if (STRINGP (font_spec
))
1391 encoding
= find_font_encoding ((char *) SDATA (font_spec
));
1393 encoding
= find_font_encoding ((char *) SDATA (registry
));
1394 if (NILP (encoding
))
1395 /* We don't know how to use this font. */
1397 if (SYMBOLP (encoding
))
1399 CHECK_CHARSET (encoding
);
1400 encoding
= repertory
= CHARSET_SYMBOL_ID (encoding
);
1404 repertory
= XCDR (encoding
);
1405 encoding
= XCAR (encoding
);
1406 CHECK_CHARSET (encoding
);
1407 encoding
= CHARSET_SYMBOL_ID (encoding
);
1408 if (! NILP (repertory
) && SYMBOLP (repertory
))
1410 CHECK_CHARSET (repertory
);
1411 repertory
= CHARSET_SYMBOL_ID (repertory
);
1414 font_def
= Fmake_vector (make_number (3), font_spec
);
1415 ASET (font_def
, 1, encoding
);
1416 ASET (font_def
, 2, repertory
);
1418 if (CHARACTERP (target
))
1419 range_list
= Fcons (Fcons (target
, target
), Qnil
);
1420 else if (CONSP (target
))
1422 Lisp_Object from
, to
;
1424 from
= Fcar (target
);
1426 CHECK_CHARACTER (from
);
1427 CHECK_CHARACTER (to
);
1428 range_list
= Fcons (target
, Qnil
);
1430 else if (SYMBOLP (target
) && !NILP (target
))
1432 Lisp_Object script_list
;
1436 script_list
= XCHAR_TABLE (Vchar_script_table
)->extras
[0];
1437 if (! NILP (Fmemq (target
, script_list
)))
1439 val
= Fcons (target
, Qnil
);
1440 map_char_table (accumulate_script_ranges
, Qnil
, Vchar_script_table
,
1442 range_list
= XCDR (val
);
1444 else if (CHARSETP (target
))
1446 struct charset
*charset
;
1448 CHECK_CHARSET_GET_CHARSET (target
, charset
);
1449 if (EQ (target
, Qascii
))
1451 if (VECTORP (font_spec
))
1452 font_spec
= generate_ascii_font_name (FONTSET_NAME (fontset
),
1454 FONTSET_ASCII (fontset
) = font_spec
;
1455 range_list
= Fcons (Fcons (make_number (0), make_number (127)),
1460 map_charset_chars (set_fontset_font
, Qnil
,
1461 list3 (fontset
, font_def
, add
), charset
,
1462 CHARSET_MIN_CODE (charset
),
1463 CHARSET_MAX_CODE (charset
));
1468 if (NILP (range_list
))
1469 error ("Invalid script or charset name: %s",
1470 SDATA (SYMBOL_NAME (target
)));
1472 else if (NILP (target
))
1473 range_list
= Fcons (Qnil
, Qnil
);
1475 error ("Invalid target for setting a font");
1477 for (; CONSP (range_list
); range_list
= XCDR (range_list
))
1478 FONTSET_ADD (fontset
, XCAR (range_list
), font_def
, add
);
1480 /* Free all realized fontsets whose base is FONTSET. This way, the
1481 specified character(s) are surely redisplayed by a correct
1483 free_realized_fontsets (fontset
);
1489 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
1490 doc
: /* Create a new fontset NAME from font information in FONTLIST.
1492 FONTLIST is an alist of scripts vs the corresponding font specification list.
1493 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1494 character of SCRIPT is displayed by a font that matches one of
1497 SCRIPT is a symbol that appears in the first extra slot of the
1498 char-table `char-script-table'.
1500 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1501 `set-fontset-font' for the meaning. */)
1503 Lisp_Object name
, fontlist
;
1505 Lisp_Object fontset
;
1509 CHECK_STRING (name
);
1510 CHECK_LIST (fontlist
);
1512 id
= fs_query_fontset (name
, 0);
1515 name
= Fdowncase (name
);
1516 val
= split_font_name_into_vector (name
);
1517 if (NILP (val
) || NILP (AREF (val
, 12)) || NILP (AREF (val
, 13)))
1518 error ("Fontset name must be in XLFD format");
1519 if (strcmp (SDATA (AREF (val
, 12)), "fontset"))
1520 error ("Registry field of fontset name must be \"fontset\"");
1521 Vfontset_alias_alist
1522 = Fcons (Fcons (name
,
1523 concat2 (concat2 (AREF (val
, 12), build_string ("-")),
1525 Vfontset_alias_alist
);
1526 ASET (val
, 12, build_string ("iso8859-1"));
1527 fontset
= make_fontset (Qnil
, name
, Qnil
);
1528 FONTSET_ASCII (fontset
) = build_font_name_from_vector (val
);
1532 fontset
= FONTSET_FROM_ID (id
);;
1533 free_realized_fontsets (fontset
);
1534 Fset_char_table_range (fontset
, Qt
, Qnil
);
1537 for (; ! NILP (fontlist
); fontlist
= Fcdr (fontlist
))
1539 Lisp_Object elt
, script
;
1541 elt
= Fcar (fontlist
);
1542 script
= Fcar (elt
);
1544 if (CONSP (elt
) && (NILP (XCDR (elt
)) || CONSP (XCDR (elt
))))
1545 for (; CONSP (elt
); elt
= XCDR (elt
))
1546 Fset_fontset_font (name
, script
, XCAR (elt
), Qnil
, Qappend
);
1548 Fset_fontset_font (name
, script
, elt
, Qnil
, Qappend
);
1554 /* Alist of automatically created fontsets. Each element is a cons
1555 (FONTNAME . FONTSET-ID). */
1556 static Lisp_Object auto_fontset_alist
;
1559 new_fontset_from_font_name (Lisp_Object fontname
)
1566 fontname
= Fdowncase (fontname
);
1567 val
= Fassoc (fontname
, auto_fontset_alist
);
1569 return XINT (XCDR (val
));
1571 vec
= split_font_name_into_vector (fontname
);
1573 vec
= Fmake_vector (make_number (14), build_string (""));
1574 ASET (vec
, 12, build_string ("fontset"));
1575 if (NILP (auto_fontset_alist
))
1577 ASET (vec
, 13, build_string ("startup"));
1578 name
= build_font_name_from_vector (vec
);
1583 int len
= XINT (Flength (auto_fontset_alist
));
1585 sprintf (temp
, "auto%d", len
);
1586 ASET (vec
, 13, build_string (temp
));
1587 name
= build_font_name_from_vector (vec
);
1589 name
= Fnew_fontset (name
, Fcons (Fcons (Fcons (make_number (0),
1590 make_number (MAX_CHAR
)),
1591 Fcons (fontname
, Qnil
)),
1593 id
= fs_query_fontset (name
, 0);
1595 = Fcons (Fcons (fontname
, make_number (id
)), auto_fontset_alist
);
1600 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1601 doc
: /* Return information about a font named NAME on frame FRAME.
1602 If FRAME is omitted or nil, use the selected frame.
1603 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1604 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1606 OPENED-NAME is the name used for opening the font,
1607 FULL-NAME is the full name of the font,
1608 SIZE is the maximum bound width of the font,
1609 HEIGHT is the height of the font,
1610 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1611 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1612 how to compose characters.
1613 If the named font is not yet loaded, return nil. */)
1615 Lisp_Object name
, frame
;
1618 struct font_info
*fontp
;
1621 (*check_window_system_func
) ();
1623 CHECK_STRING (name
);
1624 name
= Fdowncase (name
);
1626 frame
= selected_frame
;
1627 CHECK_LIVE_FRAME (frame
);
1630 if (!query_font_func
)
1631 error ("Font query function is not supported");
1633 fontp
= (*query_font_func
) (f
, SDATA (name
));
1637 info
= Fmake_vector (make_number (7), Qnil
);
1639 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1640 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1641 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1642 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1643 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1644 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1645 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1651 /* Return the font name for the character at POSITION in the current
1652 buffer. This is computed from all the text properties and overlays
1653 that apply to POSITION. It returns nil in the following cases:
1655 (1) The window system doesn't have a font for the character (thus
1656 it is displayed by an empty box).
1658 (2) The character code is invalid.
1660 (3) The current buffer is not displayed in any window.
1662 In addition, the returned font name may not take into account of
1663 such redisplay engine hooks as what used in jit-lock-mode if
1664 POSITION is currently not visible. */
1667 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1668 doc
: /* For internal use only. */)
1670 Lisp_Object position
;
1672 int pos
, pos_byte
, dummy
;
1680 CHECK_NUMBER_COERCE_MARKER (position
);
1681 pos
= XINT (position
);
1682 if (pos
< BEGV
|| pos
>= ZV
)
1683 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1684 pos_byte
= CHAR_TO_BYTE (pos
);
1685 c
= FETCH_CHAR (pos_byte
);
1686 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1689 w
= XWINDOW (window
);
1690 f
= XFRAME (w
->frame
);
1691 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1692 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
, pos
, Qnil
);
1693 face
= FACE_FROM_ID (f
, face_id
);
1694 return (face
->font
&& face
->font_name
1695 ? build_string (face
->font_name
)
1700 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1701 doc
: /* Return information about a fontset FONTSET on frame FRAME.
1702 The value is a char-table of which elements has this form.
1704 ((FONT-PATTERN OPENED-FONT ...) ...)
1706 FONT-PATTERN is a vector:
1708 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
1710 or a string of font name pattern.
1712 OPENED-FONT is a name of a font actually opened.
1714 The char-table has one extra slot. The value is a char-table
1715 containing the information about the derived fonts from the default
1716 fontset. The format is the same as abobe. */)
1718 Lisp_Object fontset
, frame
;
1721 Lisp_Object
*realized
[2], fontsets
[2], tables
[2];
1722 Lisp_Object val
, elt
;
1725 (*check_window_system_func
) ();
1727 fontset
= check_fontset_name (fontset
);
1730 frame
= selected_frame
;
1731 CHECK_LIVE_FRAME (frame
);
1734 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1735 in the table `realized'. */
1736 realized
[0] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1737 * ASIZE (Vfontset_table
));
1738 for (i
= j
= 0; i
< ASIZE (Vfontset_table
); i
++)
1740 elt
= FONTSET_FROM_ID (i
);
1742 && EQ (FONTSET_BASE (elt
), fontset
)
1743 && EQ (FONTSET_FRAME (elt
), frame
))
1744 realized
[0][j
++] = elt
;
1746 realized
[0][j
] = Qnil
;
1748 realized
[1] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1749 * ASIZE (Vfontset_table
));
1750 for (i
= j
= 0; ! NILP (realized
[0][i
]); i
++)
1752 elt
= FONTSET_DEFAULT (realized
[0][i
]);
1754 realized
[1][j
++] = elt
;
1756 realized
[1][j
] = Qnil
;
1758 tables
[0] = Fmake_char_table (Qfontset_info
, Qnil
);
1759 tables
[1] = Fmake_char_table (Qnil
, Qnil
);
1760 XCHAR_TABLE (tables
[0])->extras
[0] = tables
[1];
1761 fontsets
[0] = fontset
;
1762 fontsets
[1] = Vdefault_fontset
;
1764 /* Accumulate information of the fontset in TABLE. The format of
1765 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1766 for (k
= 0; k
<= 1; k
++)
1768 for (c
= 0; c
<= MAX_CHAR
; )
1772 if (c
<= MAX_5_BYTE_CHAR
)
1774 val
= char_table_ref_and_range (fontsets
[k
], c
, &from
, &to
);
1775 if (to
> MAX_5_BYTE_CHAR
)
1776 to
= MAX_5_BYTE_CHAR
;
1780 val
= FONTSET_FALLBACK (fontsets
[k
]);
1787 /* At first, set ALIST to ((FONT-SPEC) ...). */
1788 for (alist
= Qnil
, i
= 0; i
< ASIZE (val
); i
++)
1789 alist
= Fcons (Fcons (AREF (AREF (val
, i
), 0), Qnil
), alist
);
1790 alist
= Fnreverse (alist
);
1792 /* Then store opend font names to cdr of each elements. */
1793 for (i
= 0; ! NILP (realized
[k
][i
]); i
++)
1795 if (c
<= MAX_5_BYTE_CHAR
)
1796 val
= FONTSET_REF (realized
[k
][i
], c
);
1798 val
= FONTSET_FALLBACK (realized
[k
][i
]);
1799 if (! VECTORP (val
))
1801 /* VAL is [int int int [FACE-ID FONT-INDEX FONT-DEF] ...].
1802 If a font of an element is already opened,
1803 FONT-INDEX of the element is integer. */
1804 for (j
= 3; j
< ASIZE (val
); j
++)
1805 if (INTEGERP (AREF (AREF (val
, j
), 0)))
1807 Lisp_Object font_idx
;
1809 font_idx
= AREF (AREF (val
, j
), 1);
1810 elt
= Fassq (AREF (AREF (AREF (val
, j
), 2), 0), alist
);
1812 && NILP (Fmemq (font_idx
, XCDR(elt
))))
1813 nconc2 (elt
, Fcons (font_idx
, Qnil
));
1816 for (val
= alist
; CONSP (val
); val
= XCDR (val
))
1817 for (elt
= XCDR (XCAR (val
)); CONSP (elt
); elt
= XCDR (elt
))
1819 struct font_info
*font_info
1820 = (*get_font_info_func
) (f
, XINT (XCAR (elt
)));
1821 XSETCAR (elt
, build_string (font_info
->full_name
));
1824 /* Store ALIST in TBL for characters C..TO. */
1825 if (c
<= MAX_5_BYTE_CHAR
)
1826 char_table_set_range (tables
[k
], c
, to
, alist
);
1828 XCHAR_TABLE (tables
[k
])->defalt
= alist
;
1838 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1839 doc
: /* Return a font name pattern for character CH in fontset NAME.
1840 If NAME is t, find a font name pattern in the default fontset. */)
1842 Lisp_Object name
, ch
;
1845 Lisp_Object fontset
, elt
;
1847 fontset
= check_fontset_name (name
);
1849 CHECK_CHARACTER (ch
);
1851 elt
= FONTSET_REF (fontset
, c
);
1852 return Fcopy_sequence (elt
);
1855 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1856 doc
: /* Return a list of all defined fontset names. */)
1859 Lisp_Object fontset
, list
;
1863 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1865 fontset
= FONTSET_FROM_ID (i
);
1867 && BASE_FONTSET_P (fontset
))
1868 list
= Fcons (FONTSET_NAME (fontset
), list
);
1875 #ifdef FONTSET_DEBUG
1878 dump_fontset (fontset
)
1879 Lisp_Object fontset
;
1883 vec
= Fmake_vector (make_number (3), Qnil
);
1884 ASET (vec
, 0, FONTSET_ID (fontset
));
1886 if (BASE_FONTSET_P (fontset
))
1888 ASET (vec
, 1, FONTSET_NAME (fontset
));
1894 frame
= FONTSET_FRAME (fontset
);
1897 FRAME_PTR f
= XFRAME (frame
);
1899 if (FRAME_LIVE_P (f
))
1900 ASET (vec
, 1, f
->name
);
1904 if (!NILP (FONTSET_DEFAULT (fontset
)))
1905 ASET (vec
, 2, FONTSET_ID (FONTSET_DEFAULT (fontset
)));
1910 DEFUN ("fontset-list-all", Ffontset_list_all
, Sfontset_list_all
, 0, 0, 0,
1911 doc
: /* Return a brief summary of all fontsets for debug use. */)
1917 for (i
= 0, val
= Qnil
; i
< ASIZE (Vfontset_table
); i
++)
1918 if (! NILP (AREF (Vfontset_table
, i
)))
1919 val
= Fcons (dump_fontset (AREF (Vfontset_table
, i
)), val
);
1920 return (Fnreverse (val
));
1922 #endif /* FONTSET_DEBUG */
1927 if (!load_font_func
)
1928 /* Window system initializer should have set proper functions. */
1931 DEFSYM (Qfontset
, "fontset");
1932 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (9));
1933 DEFSYM (Qfontset_info
, "fontset-info");
1934 Fput (Qfontset_info
, Qchar_table_extra_slots
, make_number (1));
1936 DEFSYM (Qprepend
, "prepend");
1937 DEFSYM (Qappend
, "append");
1939 Vcached_fontset_data
= Qnil
;
1940 staticpro (&Vcached_fontset_data
);
1942 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1943 staticpro (&Vfontset_table
);
1945 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1946 staticpro (&Vdefault_fontset
);
1947 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1948 FONTSET_NAME (Vdefault_fontset
)
1949 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1951 Lisp_Object default_ascii_font
;
1953 #if defined (macintosh)
1955 = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman");
1956 #elif defined (WINDOWSNT)
1958 = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
1961 = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
1963 FONTSET_ASCII (Vdefault_fontset
) = default_ascii_font
;
1965 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1966 next_fontset_id
= 1;
1968 auto_fontset_alist
= Qnil
;
1969 staticpro (&auto_fontset_alist
);
1971 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1973 Alist of fontname patterns vs the corresponding encoding and repertory info.
1974 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
1975 where ENCODING is a charset or a char-table,
1976 and REPERTORY is a charset, a char-table, or nil.
1978 ENCODING is for converting a character to a glyph code of the font.
1979 If ENCODING is a charset, encoding a character by the charset gives
1980 the corresponding glyph code. If ENCODING is a char-table, looking up
1981 the table by a character gives the corresponding glyph code.
1983 REPERTORY specifies a repertory of characters supported by the font.
1984 If REPERTORY is a charset, all characters beloging to the charset are
1985 supported. If REPERTORY is a char-table, all characters who have a
1986 non-nil value in the table are supported. It REPERTORY is nil, Emacs
1987 gets the repertory information by an opened font and ENCODING. */);
1988 Vfont_encoding_alist
= Qnil
;
1990 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1992 Char table of characters whose ascent values should be ignored.
1993 If an entry for a character is non-nil, the ascent value of the glyph
1994 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
1996 This affects how a composite character which contains
1997 such a character is displayed on screen. */);
1998 Vuse_default_ascent
= Qnil
;
2000 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
2002 Char table of characters which is not composed relatively.
2003 If an entry for a character is non-nil, a composition sequence
2004 which contains that character is displayed so that
2005 the glyph of that character is put without considering
2006 an ascent and descent value of a previous character. */);
2007 Vignore_relative_composition
= Qnil
;
2009 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
2010 doc
: /* Alist of fontname vs list of the alternate fontnames.
2011 When a specified font name is not found, the corresponding
2012 alternate fontnames (if any) are tried instead. */);
2013 Valternate_fontname_alist
= Qnil
;
2015 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
2016 doc
: /* Alist of fontset names vs the aliases. */);
2017 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
2018 build_string ("fontset-default")),
2021 DEFVAR_LISP ("vertical-centering-font-regexp",
2022 &Vvertical_centering_font_regexp
,
2023 doc
: /* *Regexp matching font names that require vertical centering on display.
2024 When a character is displayed with such fonts, the character is displayed
2025 at the vertical center of lines. */);
2026 Vvertical_centering_font_regexp
= Qnil
;
2028 defsubr (&Squery_fontset
);
2029 defsubr (&Snew_fontset
);
2030 defsubr (&Sset_fontset_font
);
2031 defsubr (&Sfont_info
);
2032 defsubr (&Sinternal_char_font
);
2033 defsubr (&Sfontset_info
);
2034 defsubr (&Sfontset_font
);
2035 defsubr (&Sfontset_list
);
2036 #ifdef FONTSET_DEBUG
2037 defsubr (&Sfontset_list_all
);