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"
57 #define xassert(X) do {if (!(X)) abort ();} while (0)
60 #else /* not FONTSET_DEBUG */
61 #define xassert(X) (void) 0
62 #endif /* not FONTSET_DEBUG */
64 EXFUN (Fclear_face_cache
, 1);
68 A fontset is a collection of font related information to give
69 similar appearance (style, etc) of characters. A fontset has two
70 roles. One is to use for the frame parameter `font' as if it is an
71 ASCII font. In that case, Emacs uses the font specified for
72 `ascii' script for the frame's default font.
74 Another role, the more important one, is to provide information
75 about which font to use for each non-ASCII character.
77 There are two kinds of fontsets; base and realized. A base fontset
78 is created by `new-fontset' from Emacs Lisp explicitly. A realized
79 fontset is created implicitly when a face is realized for ASCII
80 characters. A face is also realized for non-ASCII characters based
81 on an ASCII face. All of non-ASCII faces based on the same ASCII
82 face share the same realized fontset.
84 A fontset object is implemented by a char-table whose default value
85 and parent are always nil.
87 An element of a base fontset is a vector of FONT-DEFs which itself
88 is a vector [ FONT-SPEC ENCODING REPERTORY ].
91 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
94 where FAMILY, WEIGHT, SLANT, SWIDTH, ADSTYLE, REGISTRY, and
95 FONT-NAME are strings.
97 Note: Currently WEIGHT through ADSTYLE are ignored.
99 ENCODING is a charset ID that can convert characters to glyph codes
100 of the corresponding font.
102 REPERTORY is a charset ID, a char-table, or nil. If REPERTORY is a
103 charset ID, the repertory of the charset exactly matches with that
104 of the font. If REPERTORY is a char-table, all characters who have
105 a non-nil value in the table are supported. If REPERTORY is nil,
106 we consult with the font itself to get the repertory.
108 ENCODING and REPERTORY are extracted from the variable
109 Vfont_encoding_alist by using a font name generated from FONT-SPEC
110 (if it is a vector) or FONT-NAME as a matching target.
113 An element of a realized fontset is nil or t, or has this form:
115 [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID
116 PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ...].
118 RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
120 [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ]
122 RFONT-DEFn is automatically reordered by the current charset
125 The value nil means that we have not yet generated the above vector
126 from the base of the fontset.
128 The value t means that no font is available for the corresponding
132 A fontset has 9 extra slots.
134 The 1st slot: the ID number of the fontset
137 base: the name of the fontset
142 realized: the base fontset
146 realized: the frame that the fontset belongs to
149 base: the font name for ASCII characters
154 realized: the ID number of a face to use for characters that
155 has no font in a realized fontset.
159 realized: Alist of font index vs the corresponding repertory
164 realized: If the base is not the default fontset, a fontset
165 realized from the default fontset, else nil.
168 base: Same as element value (but for fallback fonts).
171 All fontsets are recorded in the vector Vfontset_table.
176 There's a special base fontset named `default fontset' which
177 defines the default font specifications. When a base fontset
178 doesn't specify a font for a specific character, the corresponding
179 value in the default fontset is used.
181 The parent of a realized fontset created for such a face that has
182 no fontset is the default fontset.
185 These structures are hidden from the other codes than this file.
186 The other codes handle fontsets only by their ID numbers. They
187 usually use the variable name `fontset' for IDs. But, in this
188 file, we always use varialbe name `id' for IDs, and name `fontset'
189 for an actual fontset object, i.e., char-table.
193 /********** VARIABLES and FUNCTION PROTOTYPES **********/
195 extern Lisp_Object Qfont
;
196 static Lisp_Object Qfontset
;
197 static Lisp_Object Qfontset_info
;
198 static Lisp_Object Qprepend
, Qappend
;
200 /* Vector containing all fontsets. */
201 static Lisp_Object Vfontset_table
;
203 /* Next possibly free fontset ID. Usually this keeps the minimum
204 fontset ID not yet used. */
205 static int next_fontset_id
;
207 /* The default fontset. This gives default FAMILY and REGISTRY of
208 font for each character. */
209 static Lisp_Object Vdefault_fontset
;
211 Lisp_Object Vfont_encoding_alist
;
212 Lisp_Object Vuse_default_ascent
;
213 Lisp_Object Vignore_relative_composition
;
214 Lisp_Object Valternate_fontname_alist
;
215 Lisp_Object Vfontset_alias_alist
;
216 Lisp_Object Vvertical_centering_font_regexp
;
218 /* The following six are declarations of callback functions depending
219 on window system. See the comments in src/fontset.h for more
222 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
223 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
225 /* Return a list of font names which matches PATTERN. See the documentation
226 of `x-list-fonts' for more details. */
227 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
232 /* Load a font named NAME for frame F and return a pointer to the
233 information of the loaded font. If loading is failed, return 0. */
234 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
236 /* Return a pointer to struct font_info of a font named NAME for frame F. */
237 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
239 /* Additional function for setting fontset or changing fontset
240 contents of frame F. */
241 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
242 Lisp_Object oldval
));
244 /* To find a CCL program, fs_load_font calls this function.
245 The argument is a pointer to the struct font_info.
246 This function set the member `encoder' of the structure. */
247 void (*find_ccl_program_func
) P_ ((struct font_info
*));
249 Lisp_Object (*get_font_repertory_func
) P_ ((struct frame
*,
250 struct font_info
*));
252 /* Check if any window system is used now. */
253 void (*check_window_system_func
) P_ ((void));
256 /* Prototype declarations for static functions. */
257 static Lisp_Object fontset_add
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
259 static Lisp_Object fontset_font
P_ ((Lisp_Object
, int, struct face
*, int));
260 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
261 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
262 static void accumulate_script_ranges
P_ ((Lisp_Object
, Lisp_Object
,
264 static Lisp_Object find_font_encoding
P_ ((char *));
266 static void set_fontset_font
P_ ((Lisp_Object
, Lisp_Object
));
270 /* Return 1 if ID is a valid fontset id, else return 0. */
273 fontset_id_valid_p (id
)
276 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
283 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
285 /* Return the fontset with ID. No check of ID's validness. */
286 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
288 /* Macros to access special values of FONTSET. */
289 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
291 /* Macros to access special values of (base) FONTSET. */
292 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
293 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
295 /* Macros to access special values of (realized) FONTSET. */
296 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
297 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
298 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
299 #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
300 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
302 /* For both base and realized fontset. */
303 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
305 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
308 /* Return the element of FONTSET for the character C. If FONTSET is a
309 base fontset other then the default fontset and FONTSET doesn't
310 contain information for C, return the information in the default
313 #define FONTSET_REF(fontset, c) \
314 (EQ (fontset, Vdefault_fontset) \
315 ? CHAR_TABLE_REF (fontset, c) \
316 : fontset_ref ((fontset), (c)))
319 fontset_ref (fontset
, c
)
325 elt
= CHAR_TABLE_REF (fontset
, c
);
326 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
327 /* Don't check Vdefault_fontset for a realized fontset. */
328 && NILP (FONTSET_BASE (fontset
)))
329 elt
= CHAR_TABLE_REF (Vdefault_fontset
, c
);
334 /* Return the element of FONTSET for the character C, set FROM and TO
335 to the range of characters around C that have the same value as C.
336 If FONTSET is a base fontset other then the default fontset and
337 FONTSET doesn't contain information for C, return the information
338 in the default fontset. */
340 #define FONTSET_REF_AND_RANGE(fontset, c, form, to) \
341 (EQ (fontset, Vdefault_fontset) \
342 ? char_table_ref_and_range (fontset, c, &from, &to) \
343 : fontset_ref_and_range (fontset, c, &from, &to))
346 fontset_ref_and_range (fontset
, c
, from
, to
)
353 elt
= char_table_ref_and_range (fontset
, c
, from
, to
);
354 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
355 /* Don't check Vdefault_fontset for a realized fontset. */
356 && NILP (FONTSET_BASE (fontset
)))
360 elt
= char_table_ref_and_range (Vdefault_fontset
, c
, &from1
, &to1
);
370 /* Set elements of FONTSET for characters in RANGE to the value ELT.
371 RANGE is a cons (FROM . TO), where FROM and TO are character codes
372 specifying a range. */
374 #define FONTSET_SET(fontset, range, elt) \
375 Fset_char_table_range ((fontset), (range), (elt))
378 /* Modify the elements of FONTSET for characters in RANGE by replacing
379 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
380 and TO are character codes specifying a range. If ADD is nil,
381 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
384 #define FONTSET_ADD(fontset, range, elt, add) \
387 ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
388 : Fset_char_table_range ((fontset), (range), \
389 Fmake_vector (make_number (1), (elt)))) \
390 : fontset_add ((fontset), (range), (elt), (add)))
393 fontset_add (fontset
, range
, elt
, add
)
394 Lisp_Object fontset
, range
, elt
, add
;
397 int idx
= (EQ (add
, Qappend
) ? 0 : 1);
399 args
[1 - idx
] = Fmake_vector (make_number (1), elt
);
403 int from
= XINT (XCAR (range
));
404 int to
= XINT (XCDR (range
));
408 args
[idx
] = char_table_ref_and_range (fontset
, from
, &from1
, &to1
);
411 char_table_set_range (fontset
, from
, to1
,
412 NILP (args
[idx
]) ? args
[1 - idx
]
413 : Fvconcat (2, args
));
419 args
[idx
] = FONTSET_FALLBACK (fontset
);
420 FONTSET_FALLBACK (fontset
)
421 = NILP (args
[idx
]) ? args
[1 - idx
] : Fvconcat (2, args
);
427 /* Update FONTSET_ELEMENT which has this form:
428 [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-RFONT-DEF
429 RFONT-DEF0 RFONT-DEF1 ...].
430 Reorder RFONT-DEFs according to the current order of charset
431 (Vcharset_ordered_list), and update CHARSET-ORDERED-LIST-TICK to
435 reorder_font_vector (fontset_element
)
436 Lisp_Object fontset_element
;
438 Lisp_Object vec
, list
, *new_vec
;
439 Lisp_Object font_def
;
441 int *charset_id_table
;
444 ASET (fontset_element
, 0, make_number (charset_ordered_list_tick
));
445 size
= ASIZE (fontset_element
) - 3;
447 /* No need to reorder VEC. */
449 charset_id_table
= (int *) alloca (sizeof (int) * size
);
450 new_vec
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
) * size
);
452 /* At first, extract ENCODING (a chaset ID) from each FONT-DEF.
453 FONT-DEF has this form:
454 [FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] */
455 for (i
= 0; i
< size
; i
++)
457 font_def
= AREF (fontset_element
, i
+ 3);
458 charset_id_table
[i
] = XINT (AREF (AREF (font_def
, 2), 1));
461 /* Then, store FONT-DEFs in NEW_VEC in the correct order. */
462 for (idx
= 0, list
= Vcharset_ordered_list
;
463 idx
< size
&& CONSP (list
); list
= XCDR (list
))
465 for (i
= 0; i
< size
; i
++)
466 if (charset_id_table
[i
] == XINT (XCAR (list
)))
467 new_vec
[idx
++] = AREF (fontset_element
, i
+ 3);
470 /* At last, update FONT-DEFs. */
471 for (i
= 0; i
< size
; i
++)
472 ASET (fontset_element
, i
+ 3, new_vec
[i
]);
476 /* Load a font matching the font related attributes in FACE->lface and
477 font pattern in FONT_DEF of FONTSET, and return an index of the
478 font. FONT_DEF has this form:
479 [ FONT-SPEC ENCODING REPERTORY ]
480 If REPERTORY is nil, generate a char-table representing the font
481 repertory by looking into the font itself. */
484 load_font_get_repertory (f
, face
, font_def
, fontset
)
487 Lisp_Object font_def
;
491 struct font_info
*font_info
;
494 font_name
= choose_face_font (f
, face
->lface
, AREF (font_def
, 0), NULL
);
495 charset
= XINT (AREF (font_def
, 1));
496 if (! (font_info
= fs_load_font (f
, font_name
, charset
)))
499 if (NILP (AREF (font_def
, 2))
500 && NILP (Fassq (make_number (font_info
->font_idx
),
501 FONTSET_REPERTORY (fontset
))))
503 /* We must look into the font to get the correct repertory as a
505 Lisp_Object repertory
;
507 repertory
= (*get_font_repertory_func
) (f
, font_info
);
508 FONTSET_REPERTORY (fontset
)
509 = Fcons (Fcons (make_number (font_info
->font_idx
), repertory
),
510 FONTSET_REPERTORY (fontset
));
513 return font_info
->font_idx
;
517 /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
518 character C. If the corresponding font is not yet opened, open it
519 (if FACE is not NULL) or return Qnil (if FACE is NULL).
520 If no proper font is found for C, return Qnil. */
523 fontset_font (fontset
, c
, face
, id
)
529 Lisp_Object base_fontset
, elt
, vec
;
532 FRAME_PTR f
= XFRAME (FONTSET_FRAME (fontset
));
534 base_fontset
= FONTSET_BASE (fontset
);
535 vec
= CHAR_TABLE_REF (fontset
, c
);
541 /* We have not yet decided a face for C. */
546 elt
= FONTSET_REF_AND_RANGE (base_fontset
, c
, from
, to
);
547 range
= Fcons (make_number (from
), make_number (to
));
550 /* Record that we have no font for characters of this
553 FONTSET_SET (fontset
, range
, vec
);
556 /* Build a vector [ -1 -1 nil NEW-ELT0 NEW-ELT1 NEW-ELT2 ... ],
557 where the first -1 is to force reordering of NEW-ELTn,
558 NEW-ETLn is [nil nil AREF (elt, n) nil]. */
559 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
561 for (i
= 0; i
< ASIZE (elt
); i
++)
565 tmp
= Fmake_vector (make_number (4), Qnil
);
566 ASET (tmp
, 2, AREF (elt
, i
));
567 ASET (vec
, 3 + i
, tmp
);
569 /* Then store it in the fontset. */
570 FONTSET_SET (fontset
, range
, vec
);
574 if (XINT (AREF (vec
, 0)) != charset_ordered_list_tick
)
575 /* The priority of charsets is changed after we selected a face
577 reorder_font_vector (vec
);
581 else if (id
== XFASTINT (AREF (vec
, 1)))
585 ASET (vec
, 1, make_number (id
));
586 for (i
= 3; i
< ASIZE (vec
); i
++)
587 if (id
== XFASTINT (AREF (AREF (AREF (vec
, i
), 2), 1)))
591 ASET (vec
, 2, AREF (vec
, i
));
601 /* Find the first available font in the vector of RFONT-DEF. */
602 for (; i
< ASIZE (vec
); i
++)
604 Lisp_Object font_def
;
609 /* ELT == [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ] */
610 if (INTEGERP (AREF (elt
, 1)) && XINT (AREF (elt
, 1)) < 0)
611 /* We couldn't open this font last time. */
614 if (!face
&& NILP (AREF (elt
, 1)))
615 /* We have not yet opened the font. */
618 font_def
= AREF (elt
, 2);
619 /* FONT_DEF == [ FONT-SPEC ENCODING REPERTORY ] */
620 if (INTEGERP (AREF (font_def
, 2)))
622 /* The repertory is specified by charset ID. */
623 struct charset
*charset
624 = CHARSET_FROM_ID (XINT (AREF (font_def
, 2)));
626 if (! CHAR_CHARSET_P (c
, charset
))
627 /* This font can't display C. */
630 else if (CHAR_TABLE_P (AREF (font_def
, 2)))
632 /* The repertory is specified by a char table. */
633 if (NILP (CHAR_TABLE_REF (AREF (font_def
, 2), c
)))
634 /* This font can't display C. */
641 if (! INTEGERP (AREF (elt
, 1)))
643 /* We have not yet opened a font matching this spec.
644 Open the best matching font now and register the
646 struct font_info
*font_info
;
648 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
649 ASET (elt
, 1, make_number (font_idx
));
651 /* This means that we couldn't find a font matching
654 font_info
= (*get_font_info_func
) (f
, font_idx
);
655 ASET (elt
, 3, build_string (font_info
->full_name
));
658 slot
= Fassq (AREF (elt
, 1), FONTSET_REPERTORY (fontset
));
659 xassert (CONSP (slot
));
660 if (NILP (CHAR_TABLE_REF (XCDR (slot
), c
)))
661 /* This font can't display C. */
665 /* Now we have decided to use this font spec to display C. */
666 if (! INTEGERP (AREF (elt
, 1)))
668 /* But not yet opened the best matching font. */
669 struct font_info
*font_info
;
671 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
672 ASET (elt
, 1, make_number (font_idx
));
674 /* Can't open it. Try the other one. */
676 font_info
= (*get_font_info_func
) (f
, font_idx
);
677 ASET (elt
, 3, build_string (font_info
->full_name
));
680 /* Now we have the opened font. */
685 if (! EQ (vec
, FONTSET_FALLBACK (fontset
)))
687 vec
= FONTSET_FALLBACK (fontset
);
692 elt
= FONTSET_FALLBACK (base_fontset
);
695 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
697 for (i
= 0; i
< ASIZE (elt
); i
++)
701 tmp
= Fmake_vector (make_number (4), Qnil
);
702 ASET (tmp
, 2, AREF (elt
, i
));
703 ASET (vec
, 3 + i
, tmp
);
705 FONTSET_FALLBACK (fontset
) = vec
;
708 /* Record that this fontset has no fallback fonts. */
709 FONTSET_FALLBACK (fontset
) = Qt
;
712 /* Try the default fontset. */
714 if (! EQ (base_fontset
, Vdefault_fontset
))
716 if (NILP (FONTSET_DEFAULT (fontset
)))
717 FONTSET_DEFAULT (fontset
)
718 = make_fontset (FONTSET_FRAME (fontset
), Qnil
, Vdefault_fontset
);
719 return fontset_font (FONTSET_DEFAULT (fontset
), c
, face
, id
);
725 /* Return a newly created fontset with NAME. If BASE is nil, make a
726 base fontset. Otherwise make a realized fontset whose base is
730 make_fontset (frame
, name
, base
)
731 Lisp_Object frame
, name
, base
;
734 int size
= ASIZE (Vfontset_table
);
735 int id
= next_fontset_id
;
737 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
738 the next available fontset ID. So it is expected that this loop
739 terminates quickly. In addition, as the last element of
740 Vfontset_table is always nil, we don't have to check the range of
742 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
746 /* We must grow Vfontset_table. */
750 tem
= Fmake_vector (make_number (size
+ 32), Qnil
);
751 for (i
= 0; i
< size
; i
++)
752 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
753 Vfontset_table
= tem
;
756 fontset
= Fmake_char_table (Qfontset
, Qnil
);
758 FONTSET_ID (fontset
) = make_number (id
);
761 FONTSET_NAME (fontset
) = name
;
765 FONTSET_NAME (fontset
) = Qnil
;
766 FONTSET_FRAME (fontset
) = frame
;
767 FONTSET_BASE (fontset
) = base
;
770 ASET (Vfontset_table
, id
, fontset
);
771 next_fontset_id
= id
+ 1;
777 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
779 /* Return the name of the fontset who has ID. */
787 fontset
= FONTSET_FROM_ID (id
);
788 return FONTSET_NAME (fontset
);
792 /* Return the ASCII font name of the fontset who has ID. */
798 Lisp_Object fontset
, elt
;
800 fontset
= FONTSET_FROM_ID (id
);
801 elt
= FONTSET_ASCII (fontset
);
802 /* It is assured that ELT is always a string (i.e. fontname
808 /* Free fontset of FACE defined on frame F. Called from
809 free_realized_face. */
812 free_face_fontset (f
, face
)
818 fontset
= AREF (Vfontset_table
, face
->fontset
);
819 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
820 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
821 ASET (Vfontset_table
, face
->fontset
, Qnil
);
822 if (face
->fontset
< next_fontset_id
)
823 next_fontset_id
= face
->fontset
;
824 if (! NILP (FONTSET_DEFAULT (fontset
)))
826 int id
= XINT (FONTSET_ID (FONTSET_DEFAULT (fontset
)));
828 fontset
= AREF (Vfontset_table
, id
);
829 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
830 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
831 ASET (Vfontset_table
, id
, Qnil
);
832 if (id
< next_fontset_id
)
833 next_fontset_id
= face
->fontset
;
838 /* Return 1 iff FACE is suitable for displaying character C.
839 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
840 when C is not an ASCII character. */
843 face_suitable_for_char_p (face
, c
)
847 Lisp_Object fontset
, rfont_def
;
849 fontset
= FONTSET_FROM_ID (face
->fontset
);
850 rfont_def
= fontset_font (fontset
, c
, NULL
, -1);
851 return (VECTORP (rfont_def
)
852 && INTEGERP (AREF (rfont_def
, 0))
853 && face
->id
== XINT (AREF (rfont_def
, 0)));
857 /* Return ID of face suitable for displaying character C on frame F.
858 FACE must be reazlied for ASCII characters in advance. Called from
859 the macro FACE_FOR_CHAR. */
862 face_for_char (f
, face
, c
, pos
, object
)
868 Lisp_Object fontset
, charset
, rfont_def
;
872 if (ASCII_CHAR_P (c
))
873 return face
->ascii_face
->id
;
875 xassert (fontset_id_valid_p (face
->fontset
));
876 fontset
= FONTSET_FROM_ID (face
->fontset
);
877 xassert (!BASE_FONTSET_P (fontset
));
882 charset
= Fget_char_property (make_number (pos
), Qcharset
, object
);
885 else if (CHARSETP (charset
))
886 id
= XINT (CHARSET_SYMBOL_ID (charset
));
888 rfont_def
= fontset_font (fontset
, c
, face
, id
);
889 if (VECTORP (rfont_def
))
891 if (NILP (AREF (rfont_def
, 0)))
893 /* We have not yet made a realized face that uses this font. */
894 int font_idx
= XINT (AREF (rfont_def
, 1));
896 face_id
= lookup_non_ascii_face (f
, font_idx
, face
);
897 ASET (rfont_def
, 0, make_number (face_id
));
899 return XINT (AREF (rfont_def
, 0));
902 if (NILP (FONTSET_NOFONT_FACE (fontset
)))
904 face_id
= lookup_non_ascii_face (f
, -1, face
);
905 FONTSET_NOFONT_FACE (fontset
) = make_number (face_id
);
907 return XINT (FONTSET_NOFONT_FACE (fontset
));
911 /* Make a realized fontset for ASCII face FACE on frame F from the
912 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
913 default fontset as the base. Value is the id of the new fontset.
914 Called from realize_x_face. */
917 make_fontset_for_ascii_face (f
, base_fontset_id
, face
)
922 Lisp_Object base_fontset
, fontset
, frame
;
924 XSETFRAME (frame
, f
);
925 if (base_fontset_id
>= 0)
927 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
928 if (!BASE_FONTSET_P (base_fontset
))
929 base_fontset
= FONTSET_BASE (base_fontset
);
930 xassert (BASE_FONTSET_P (base_fontset
));
931 if (! BASE_FONTSET_P (base_fontset
))
935 base_fontset
= Vdefault_fontset
;
937 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
939 Lisp_Object elt
, rfont_def
;
941 elt
= FONTSET_REF (base_fontset
, 0);
942 xassert (VECTORP (elt
) && ASIZE (elt
) > 0);
943 rfont_def
= Fmake_vector (make_number (4), Qnil
);
944 ASET (rfont_def
, 0, make_number (face
->id
));
945 ASET (rfont_def
, 1, make_number (face
->font_info_id
));
946 ASET (rfont_def
, 2, AREF (elt
, 0));
947 ASET (rfont_def
, 3, build_string (face
->font_name
));
948 elt
= Fmake_vector (make_number (4), Qnil
);
949 ASET (elt
, 0, make_number (charset_ordered_list_tick
));
950 ASET (elt
, 1, make_number (charset_ascii
));
951 ASET (elt
, 2, rfont_def
);
952 ASET (elt
, 3, rfont_def
);
953 char_table_set_range (fontset
, 0, 127, elt
);
955 return XINT (FONTSET_ID (fontset
));
959 #if defined(WINDOWSNT) && defined (_MSC_VER)
960 #pragma optimize("", off)
963 /* Load a font named FONTNAME on frame F. Return a pointer to the
964 struct font_info of the loaded font. If loading fails, return
965 NULL. CHARSET is an ID of charset to encode characters for this
966 font. If it is -1, find one from Vfont_encoding_alist. */
969 fs_load_font (f
, fontname
, charset
)
974 struct font_info
*fontp
;
977 /* No way to get fontname. */
980 fontp
= (*load_font_func
) (f
, fontname
, 0);
981 if (! fontp
|| fontp
->charset
>= 0)
984 fontname
= fontp
->full_name
;
988 Lisp_Object charset_symbol
;
990 charset_symbol
= find_font_encoding (fontname
);
991 if (CONSP (charset_symbol
))
992 charset_symbol
= XCAR (charset_symbol
);
993 charset
= XINT (CHARSET_SYMBOL_ID (charset_symbol
));
995 fontp
->charset
= charset
;
996 fontp
->vertical_centering
= 0;
997 fontp
->font_encoder
= NULL
;
999 if (charset
!= charset_ascii
)
1001 fontp
->vertical_centering
1002 = (STRINGP (Vvertical_centering_font_regexp
)
1003 && (fast_c_string_match_ignore_case
1004 (Vvertical_centering_font_regexp
, fontname
) >= 0));
1006 if (find_ccl_program_func
)
1007 (*find_ccl_program_func
) (fontp
);
1013 #if defined(WINDOWSNT) && defined (_MSC_VER)
1014 #pragma optimize("", on)
1018 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
1019 FONTNAME. ENCODING is a charset symbol that specifies the encoding
1020 of the font. REPERTORY is a charset symbol or nil. */
1024 find_font_encoding (fontname
)
1027 Lisp_Object tail
, elt
;
1029 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
1033 && STRINGP (XCAR (elt
))
1034 && fast_c_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
1035 && (SYMBOLP (XCDR (elt
))
1036 ? CHARSETP (XCDR (elt
))
1037 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
1038 return (XCDR (elt
));
1040 /* We don't know the encoding of this font. Let's assume `ascii'. */
1045 /* Cache data used by fontset_pattern_regexp. The car part is a
1046 pattern string containing at least one wild card, the cdr part is
1047 the corresponding regular expression. */
1048 static Lisp_Object Vcached_fontset_data
;
1050 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
1051 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1053 /* If fontset name PATTERN contains any wild card, return regular
1054 expression corresponding to PATTERN. */
1057 fontset_pattern_regexp (pattern
)
1058 Lisp_Object pattern
;
1060 if (!index (SDATA (pattern
), '*')
1061 && !index (SDATA (pattern
), '?'))
1062 /* PATTERN does not contain any wild cards. */
1065 if (!CONSP (Vcached_fontset_data
)
1066 || strcmp (SDATA (pattern
), CACHED_FONTSET_NAME
))
1068 /* We must at first update the cached data. */
1069 char *regex
= (char *) alloca (SCHARS (pattern
) * 2 + 3);
1070 char *p0
, *p1
= regex
;
1072 /* Convert "*" to ".*", "?" to ".". */
1074 for (p0
= (char *) SDATA (pattern
); *p0
; p0
++)
1081 else if (*p0
== '?')
1089 Vcached_fontset_data
= Fcons (build_string (SDATA (pattern
)),
1090 build_string (regex
));
1093 return CACHED_FONTSET_REGEX
;
1096 /* Return ID of the base fontset named NAME. If there's no such
1097 fontset, return -1. */
1100 fs_query_fontset (name
, regexpp
)
1107 name
= Fdowncase (name
);
1110 tem
= Frassoc (name
, Vfontset_alias_alist
);
1112 tem
= Fassoc (name
, Vfontset_alias_alist
);
1113 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1117 tem
= fontset_pattern_regexp (name
);
1126 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1128 Lisp_Object fontset
;
1129 unsigned char *this_name
;
1131 fontset
= FONTSET_FROM_ID (i
);
1133 || !BASE_FONTSET_P (fontset
))
1136 this_name
= SDATA (FONTSET_NAME (fontset
));
1138 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
1139 : !strcmp (SDATA (name
), this_name
))
1146 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
1147 doc
: /* Return the name of a fontset that matches PATTERN.
1148 The value is nil if there is no matching fontset.
1149 PATTERN can contain `*' or `?' as a wildcard
1150 just as X font name matching algorithm allows.
1151 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1153 Lisp_Object pattern
, regexpp
;
1155 Lisp_Object fontset
;
1158 (*check_window_system_func
) ();
1160 CHECK_STRING (pattern
);
1162 if (SCHARS (pattern
) == 0)
1165 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
1169 fontset
= FONTSET_FROM_ID (id
);
1170 return FONTSET_NAME (fontset
);
1173 /* Return a list of base fontset names matching PATTERN on frame F. */
1176 list_fontsets (f
, pattern
, size
)
1178 Lisp_Object pattern
;
1181 Lisp_Object frame
, regexp
, val
;
1184 XSETFRAME (frame
, f
);
1186 regexp
= fontset_pattern_regexp (pattern
);
1189 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1191 Lisp_Object fontset
;
1192 unsigned char *name
;
1194 fontset
= FONTSET_FROM_ID (id
);
1196 || !BASE_FONTSET_P (fontset
)
1197 || !EQ (frame
, FONTSET_FRAME (fontset
)))
1199 name
= SDATA (FONTSET_NAME (fontset
));
1201 if (STRINGP (regexp
)
1202 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
1203 : strcmp (SDATA (pattern
), name
))
1206 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
1213 /* Free all realized fontsets whose base fontset is BASE. */
1216 free_realized_fontsets (base
)
1222 /* For the moment, this doesn't work because free_realized_face
1223 doesn't remove FACE from a cache. Until we find a solution, we
1224 suppress this code, and simply use Fclear_face_cache even though
1225 that is not efficient. */
1227 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1229 Lisp_Object
this = AREF (Vfontset_table
, id
);
1231 if (EQ (FONTSET_BASE (this), base
))
1235 for (tail
= FONTSET_FACE_ALIST (this); CONSP (tail
);
1238 FRAME_PTR f
= XFRAME (FONTSET_FRAME (this));
1239 int face_id
= XINT (XCDR (XCAR (tail
)));
1240 struct face
*face
= FACE_FROM_ID (f
, face_id
);
1242 /* Face THIS itself is also freed by the following call. */
1243 free_realized_face (f
, face
);
1249 Fclear_face_cache (Qt
);
1254 /* Check validity of NAME as a fontset name and return the
1255 corresponding fontset. If not valid, signal an error.
1256 If NAME is t, return Vdefault_fontset. */
1259 check_fontset_name (name
)
1265 return Vdefault_fontset
;
1267 CHECK_STRING (name
);
1268 id
= fs_query_fontset (name
, 0);
1270 error ("Fontset `%s' does not exist", SDATA (name
));
1271 return FONTSET_FROM_ID (id
);
1275 accumulate_script_ranges (arg
, range
, val
)
1276 Lisp_Object arg
, range
, val
;
1278 if (EQ (XCAR (arg
), val
))
1281 XSETCDR (arg
, Fcons (Fcons (XCAR (range
), XCDR (range
)), XCDR (arg
)));
1283 XSETCDR (arg
, Fcons (Fcons (range
, range
), XCDR (arg
)));
1288 /* Return an ASCII font name generated from fontset name NAME and
1289 ASCII font specification ASCII_SPEC. NAME is a string conforming
1290 to XLFD. ASCII_SPEC is a vector:
1291 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
1293 static INLINE Lisp_Object
1294 generate_ascii_font_name (name
, ascii_spec
)
1295 Lisp_Object name
, ascii_spec
;
1300 vec
= split_font_name_into_vector (name
);
1301 for (i
= FONT_SPEC_FAMILY_INDEX
; i
<= FONT_SPEC_ADSTYLE_INDEX
; i
++)
1302 if (! NILP (AREF (ascii_spec
, i
)))
1303 ASET (vec
, 1 + i
, AREF (ascii_spec
, i
));
1304 if (! NILP (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
)))
1305 ASET (vec
, 12, AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
1306 return build_font_name_from_vector (vec
);
1309 /* Variables referred in set_fontset_font. They are set before
1310 map_charset_chars is called in Fset_fontset_font. */
1311 static Lisp_Object font_def_arg
, add_arg
;
1312 static int from_arg
, to_arg
;
1314 /* Callback function for map_charset_chars in Fset_fontset_font. In
1315 FONTSET, set font_def_arg in a fashion specified by add_arg for
1316 characters in RANGE while ignoring the range between from_arg and
1320 set_fontset_font (fontset
, range
)
1321 Lisp_Object fontset
, range
;
1323 if (from_arg
< to_arg
)
1325 int from
= XINT (XCAR (range
)), to
= XINT (XCDR (range
));
1327 if (from
< from_arg
)
1333 range2
= Fcons (make_number (to_arg
), XCDR (range
));
1334 FONTSET_ADD (fontset
, range
, font_def_arg
, add_arg
);
1338 range
= Fcons (XCAR (range
), make_number (from_arg
));
1340 else if (to
<= to_arg
)
1345 range
= Fcons (make_number (to_arg
), XCDR (range
));
1348 FONTSET_ADD (fontset
, range
, font_def_arg
, add_arg
);
1352 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 5, 0,
1354 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1356 TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
1357 In that case, use FONT-SPEC for all characters in the range FROM and
1360 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1361 all characters that belong to the script.
1363 TARGET may be a charset. In that case, use FONT-SPEC for all
1364 characters in the charset.
1366 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1367 that no FONT-SPEC is specified.
1370 * A vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ].
1371 See the documentation of `set-face-attribute' for the detail of
1372 these vector elements;
1373 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1374 REGISTRY is a font registry name;
1375 * A font name string.
1377 Optional 4th argument FRAME, if non-nil, is a frame. This argument is
1378 kept for backward compatibility and has no meaning.
1380 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1381 to the font specifications for TARGET previously set. If it is
1382 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1383 appended. By default, FONT-SPEC overrides the previous settings. */)
1384 (name
, target
, font_spec
, frame
, add
)
1385 Lisp_Object name
, target
, font_spec
, frame
, add
;
1387 Lisp_Object fontset
;
1388 Lisp_Object font_def
, registry
;
1389 Lisp_Object encoding
, repertory
;
1390 Lisp_Object range_list
;
1391 struct charset
*charset
= NULL
;
1393 fontset
= check_fontset_name (name
);
1395 /* The arg FRAME is kept for backward compatibility. We only check
1398 CHECK_LIVE_FRAME (frame
);
1400 if (VECTORP (font_spec
))
1404 if (ASIZE (font_spec
) != FONT_SPEC_MAX_INDEX
)
1405 args_out_of_range (make_number (FONT_SPEC_MAX_INDEX
),
1406 make_number (ASIZE (font_spec
)));
1408 font_spec
= Fcopy_sequence (font_spec
);
1409 for (j
= 0; j
< FONT_SPEC_MAX_INDEX
- 1; j
++)
1410 if (! NILP (AREF (font_spec
, j
)))
1412 CHECK_STRING (AREF (font_spec
, j
));
1413 ASET (font_spec
, j
, Fdowncase (AREF (font_spec
, j
)));
1415 /* REGISTRY should not be omitted. */
1416 CHECK_STRING (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1417 registry
= Fdowncase (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1418 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1421 else if (CONSP (font_spec
))
1425 family
= XCAR (font_spec
);
1426 registry
= XCDR (font_spec
);
1428 if (! NILP (family
))
1430 CHECK_STRING (family
);
1431 family
= Fdowncase (family
);
1433 CHECK_STRING (registry
);
1434 registry
= Fdowncase (registry
);
1435 font_spec
= Fmake_vector (make_number (FONT_SPEC_MAX_INDEX
), Qnil
);
1436 ASET (font_spec
, FONT_SPEC_FAMILY_INDEX
, family
);
1437 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1441 CHECK_STRING (font_spec
);
1442 font_spec
= Fdowncase (font_spec
);
1445 if (STRINGP (font_spec
))
1446 encoding
= find_font_encoding ((char *) SDATA (font_spec
));
1448 encoding
= find_font_encoding ((char *) SDATA (registry
));
1449 if (SYMBOLP (encoding
))
1451 CHECK_CHARSET (encoding
);
1452 encoding
= repertory
= CHARSET_SYMBOL_ID (encoding
);
1456 repertory
= XCDR (encoding
);
1457 encoding
= XCAR (encoding
);
1458 CHECK_CHARSET (encoding
);
1459 encoding
= CHARSET_SYMBOL_ID (encoding
);
1460 if (! NILP (repertory
) && SYMBOLP (repertory
))
1462 CHECK_CHARSET (repertory
);
1463 repertory
= CHARSET_SYMBOL_ID (repertory
);
1466 font_def
= Fmake_vector (make_number (3), font_spec
);
1467 ASET (font_def
, 1, encoding
);
1468 ASET (font_def
, 2, repertory
);
1470 if (CHARACTERP (target
))
1471 range_list
= Fcons (Fcons (target
, target
), Qnil
);
1472 else if (CONSP (target
))
1474 Lisp_Object from
, to
;
1476 from
= Fcar (target
);
1478 CHECK_CHARACTER (from
);
1479 CHECK_CHARACTER (to
);
1480 range_list
= Fcons (target
, Qnil
);
1482 else if (SYMBOLP (target
) && !NILP (target
))
1484 Lisp_Object script_list
;
1488 script_list
= XCHAR_TABLE (Vchar_script_table
)->extras
[0];
1489 if (! NILP (Fmemq (target
, script_list
)))
1491 val
= Fcons (target
, Qnil
);
1492 map_char_table (accumulate_script_ranges
, Qnil
, Vchar_script_table
,
1494 range_list
= XCDR (val
);
1496 if (CHARSETP (target
))
1498 if (EQ (target
, Qascii
))
1500 if (VECTORP (font_spec
))
1501 font_spec
= generate_ascii_font_name (FONTSET_NAME (fontset
),
1503 FONTSET_ASCII (fontset
) = font_spec
;
1504 range_list
= Fcons (Fcons (make_number (0), make_number (127)),
1509 CHECK_CHARSET_GET_CHARSET (target
, charset
);
1512 else if (NILP (range_list
))
1513 error ("Invalid script or charset name: %s",
1514 SDATA (SYMBOL_NAME (target
)));
1516 else if (NILP (target
))
1517 range_list
= Fcons (Qnil
, Qnil
);
1519 error ("Invalid target for setting a font");
1524 font_def_arg
= font_def
;
1526 if (NILP (range_list
))
1527 from_arg
= to_arg
= 0;
1529 from_arg
= XINT (XCAR (XCAR (range_list
))),
1530 to_arg
= XINT (XCDR (XCAR (range_list
)));
1532 map_charset_chars (set_fontset_font
, Qnil
, fontset
, charset
,
1533 CHARSET_MIN_CODE (charset
),
1534 CHARSET_MAX_CODE (charset
));
1536 for (; CONSP (range_list
); range_list
= XCDR (range_list
))
1537 FONTSET_ADD (fontset
, XCAR (range_list
), font_def
, add
);
1539 /* Free all realized fontsets whose base is FONTSET. This way, the
1540 specified character(s) are surely redisplayed by a correct
1542 free_realized_fontsets (fontset
);
1548 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
1549 doc
: /* Create a new fontset NAME from font information in FONTLIST.
1551 FONTLIST is an alist of scripts vs the corresponding font specification list.
1552 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1553 character of SCRIPT is displayed by a font that matches one of
1556 SCRIPT is a symbol that appears in the first extra slot of the
1557 char-table `char-script-table'.
1559 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1560 `set-fontset-font' for the meaning. */)
1562 Lisp_Object name
, fontlist
;
1564 Lisp_Object fontset
;
1568 CHECK_STRING (name
);
1569 CHECK_LIST (fontlist
);
1571 id
= fs_query_fontset (name
, 0);
1574 name
= Fdowncase (name
);
1575 val
= split_font_name_into_vector (name
);
1576 if (NILP (val
) || NILP (AREF (val
, 12)) || NILP (AREF (val
, 13)))
1577 error ("Fontset name must be in XLFD format");
1578 if (strcmp (SDATA (AREF (val
, 12)), "fontset"))
1579 error ("Registry field of fontset name must be \"fontset\"");
1580 Vfontset_alias_alist
1581 = Fcons (Fcons (name
,
1582 concat2 (concat2 (AREF (val
, 12), build_string ("-")),
1584 Vfontset_alias_alist
);
1585 ASET (val
, 12, build_string ("iso8859-1"));
1586 fontset
= make_fontset (Qnil
, name
, Qnil
);
1587 FONTSET_ASCII (fontset
) = build_font_name_from_vector (val
);
1591 fontset
= FONTSET_FROM_ID (id
);;
1592 free_realized_fontsets (fontset
);
1593 Fset_char_table_range (fontset
, Qt
, Qnil
);
1596 for (; ! NILP (fontlist
); fontlist
= Fcdr (fontlist
))
1598 Lisp_Object elt
, script
;
1600 elt
= Fcar (fontlist
);
1601 script
= Fcar (elt
);
1603 if (CONSP (elt
) && (NILP (XCDR (elt
)) || CONSP (XCDR (elt
))))
1604 for (; CONSP (elt
); elt
= XCDR (elt
))
1605 Fset_fontset_font (name
, script
, XCAR (elt
), Qnil
, Qappend
);
1607 Fset_fontset_font (name
, script
, elt
, Qnil
, Qappend
);
1613 /* Alist of automatically created fontsets. Each element is a cons
1614 (FONTNAME . FONTSET-ID). */
1615 static Lisp_Object auto_fontset_alist
;
1618 new_fontset_from_font_name (Lisp_Object fontname
)
1625 fontname
= Fdowncase (fontname
);
1626 val
= Fassoc (fontname
, auto_fontset_alist
);
1628 return XINT (XCDR (val
));
1630 vec
= split_font_name_into_vector (fontname
);
1632 vec
= Fmake_vector (make_number (14), build_string (""));
1633 ASET (vec
, 12, build_string ("fontset"));
1634 if (NILP (auto_fontset_alist
))
1636 ASET (vec
, 13, build_string ("startup"));
1637 name
= build_font_name_from_vector (vec
);
1642 int len
= XINT (Flength (auto_fontset_alist
));
1644 sprintf (temp
, "auto%d", len
);
1645 ASET (vec
, 13, build_string (temp
));
1646 name
= build_font_name_from_vector (vec
);
1648 name
= Fnew_fontset (name
, list2 (list2 (Qascii
, fontname
),
1649 list2 (Fcons (make_number (0),
1650 make_number (MAX_CHAR
)),
1652 id
= fs_query_fontset (name
, 0);
1654 = Fcons (Fcons (fontname
, make_number (id
)), auto_fontset_alist
);
1659 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1660 doc
: /* Return information about a font named NAME on frame FRAME.
1661 If FRAME is omitted or nil, use the selected frame.
1662 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1663 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1665 OPENED-NAME is the name used for opening the font,
1666 FULL-NAME is the full name of the font,
1667 SIZE is the maximum bound width of the font,
1668 HEIGHT is the height of the font,
1669 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1670 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1671 how to compose characters.
1672 If the named font is not yet loaded, return nil. */)
1674 Lisp_Object name
, frame
;
1677 struct font_info
*fontp
;
1680 (*check_window_system_func
) ();
1682 CHECK_STRING (name
);
1683 name
= Fdowncase (name
);
1685 frame
= selected_frame
;
1686 CHECK_LIVE_FRAME (frame
);
1689 if (!query_font_func
)
1690 error ("Font query function is not supported");
1692 fontp
= (*query_font_func
) (f
, SDATA (name
));
1696 info
= Fmake_vector (make_number (7), Qnil
);
1698 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1699 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1700 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1701 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1702 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1703 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1704 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1710 /* Return a cons (FONT-NAME . GLYPH-CODE).
1711 FONT-NAME is the font name for the character at POSITION in the current
1712 buffer. This is computed from all the text properties and overlays
1713 that apply to POSITION.
1714 GLYPH-CODE is the glyph code in the font to use for the character.
1716 If the 2nd optional arg CH is non-nil, it is a character to check
1717 the font instead of the character at POSITION.
1719 It returns nil in the following cases:
1721 (1) The window system doesn't have a font for the character (thus
1722 it is displayed by an empty box).
1724 (2) The character code is invalid.
1726 (3) The current buffer is not displayed in any window.
1728 In addition, the returned font name may not take into account of
1729 such redisplay engine hooks as what used in jit-lock-mode if
1730 POSITION is currently not visible. */
1733 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 2, 0,
1734 doc
: /* For internal use only. */)
1736 Lisp_Object position
, ch
;
1738 int pos
, pos_byte
, dummy
;
1745 Lisp_Object charset
, rfont_def
;
1748 CHECK_NUMBER_COERCE_MARKER (position
);
1749 pos
= XINT (position
);
1750 if (pos
< BEGV
|| pos
>= ZV
)
1751 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1752 pos_byte
= CHAR_TO_BYTE (pos
);
1754 c
= FETCH_CHAR (pos_byte
);
1757 CHECK_CHARACTER (ch
);
1760 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1763 w
= XWINDOW (window
);
1764 f
= XFRAME (w
->frame
);
1765 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1766 face
= FACE_FROM_ID (f
, face_id
);
1767 charset
= Fget_char_property (position
, Qcharset
, Qnil
);
1768 if (CHARSETP (charset
))
1769 charset_id
= XINT (CHARSET_SYMBOL_ID (charset
));
1772 rfont_def
= fontset_font (FONTSET_FROM_ID (face
->fontset
),
1773 c
, face
, charset_id
);
1774 if (VECTORP (rfont_def
) && STRINGP (AREF (rfont_def
, 3)))
1776 Lisp_Object font_def
;
1777 struct font_info
*fontp
;
1778 struct charset
*charset
;
1782 font_def
= AREF (rfont_def
, 2);
1783 charset
= CHARSET_FROM_ID (XINT (AREF (font_def
, 1)));
1784 code
= ENCODE_CHAR (charset
, c
);
1785 if (code
== CHARSET_INVALID_CODE (charset
))
1786 return (Fcons (AREF (rfont_def
, 3), Qnil
));
1787 STORE_XCHAR2B (&char2b
, ((code
>> 8) & 0xFF), (code
& 0xFF));
1788 fontp
= (*get_font_info_func
) (f
, XINT (AREF (rfont_def
, 1)));
1789 rif
->encode_char (c
, &char2b
, fontp
, charset
, NULL
);
1790 code
= (XCHAR2B_BYTE1 (&char2b
) << 8) | XCHAR2B_BYTE2 (&char2b
);
1791 return (Fcons (AREF (rfont_def
, 3), make_number (code
)));
1797 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1798 doc
: /* Return information about a fontset FONTSET on frame FRAME.
1799 The value is a char-table of which elements has this form.
1801 ((FONT-PATTERN OPENED-FONT ...) ...)
1803 FONT-PATTERN is a vector:
1805 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
1807 or a string of font name pattern.
1809 OPENED-FONT is a name of a font actually opened.
1811 The char-table has one extra slot. The value is a char-table
1812 containing the information about the derived fonts from the default
1813 fontset. The format is the same as abobe. */)
1815 Lisp_Object fontset
, frame
;
1818 Lisp_Object
*realized
[2], fontsets
[2], tables
[2];
1819 Lisp_Object val
, elt
;
1822 (*check_window_system_func
) ();
1824 fontset
= check_fontset_name (fontset
);
1827 frame
= selected_frame
;
1828 CHECK_LIVE_FRAME (frame
);
1831 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1832 in the table `realized'. */
1833 realized
[0] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1834 * ASIZE (Vfontset_table
));
1835 for (i
= j
= 0; i
< ASIZE (Vfontset_table
); i
++)
1837 elt
= FONTSET_FROM_ID (i
);
1839 && EQ (FONTSET_BASE (elt
), fontset
)
1840 && EQ (FONTSET_FRAME (elt
), frame
))
1841 realized
[0][j
++] = elt
;
1843 realized
[0][j
] = Qnil
;
1845 realized
[1] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1846 * ASIZE (Vfontset_table
));
1847 for (i
= j
= 0; ! NILP (realized
[0][i
]); i
++)
1849 elt
= FONTSET_DEFAULT (realized
[0][i
]);
1851 realized
[1][j
++] = elt
;
1853 realized
[1][j
] = Qnil
;
1855 tables
[0] = Fmake_char_table (Qfontset_info
, Qnil
);
1856 tables
[1] = Fmake_char_table (Qnil
, Qnil
);
1857 XCHAR_TABLE (tables
[0])->extras
[0] = tables
[1];
1858 fontsets
[0] = fontset
;
1859 fontsets
[1] = Vdefault_fontset
;
1861 /* Accumulate information of the fontset in TABLE. The format of
1862 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1863 for (k
= 0; k
<= 1; k
++)
1865 for (c
= 0; c
<= MAX_CHAR
; )
1869 if (c
<= MAX_5_BYTE_CHAR
)
1871 val
= char_table_ref_and_range (fontsets
[k
], c
, &from
, &to
);
1872 if (to
> MAX_5_BYTE_CHAR
)
1873 to
= MAX_5_BYTE_CHAR
;
1877 val
= FONTSET_FALLBACK (fontsets
[k
]);
1884 /* At first, set ALIST to ((FONT-SPEC) ...). */
1885 for (alist
= Qnil
, i
= 0; i
< ASIZE (val
); i
++)
1886 alist
= Fcons (Fcons (AREF (AREF (val
, i
), 0), Qnil
), alist
);
1887 alist
= Fnreverse (alist
);
1889 /* Then store opend font names to cdr of each elements. */
1890 for (i
= 0; ! NILP (realized
[k
][i
]); i
++)
1892 if (c
<= MAX_5_BYTE_CHAR
)
1893 val
= FONTSET_REF (realized
[k
][i
], c
);
1895 val
= FONTSET_FALLBACK (realized
[k
][i
]);
1896 if (! VECTORP (val
))
1898 /* VAL is [int int ?
1899 [FACE-ID FONT-INDEX FONT-DEF FONT-NAME] ...].
1900 If a font of an element is already opened,
1901 FONT-NAME is the name of a opened font. */
1902 for (j
= 3; j
< ASIZE (val
); j
++)
1903 if (STRINGP (AREF (AREF (val
, j
), 3)))
1905 Lisp_Object font_idx
;
1907 font_idx
= AREF (AREF (val
, j
), 1);
1908 elt
= Fassq (AREF (AREF (AREF (val
, j
), 2), 0), alist
);
1910 && NILP (Fmemq (font_idx
, XCDR(elt
))))
1911 nconc2 (elt
, Fcons (font_idx
, Qnil
));
1914 for (val
= alist
; CONSP (val
); val
= XCDR (val
))
1915 for (elt
= XCDR (XCAR (val
)); CONSP (elt
); elt
= XCDR (elt
))
1917 struct font_info
*font_info
1918 = (*get_font_info_func
) (f
, XINT (XCAR (elt
)));
1919 XSETCAR (elt
, build_string (font_info
->full_name
));
1922 /* Store ALIST in TBL for characters C..TO. */
1923 if (c
<= MAX_5_BYTE_CHAR
)
1924 char_table_set_range (tables
[k
], c
, to
, alist
);
1926 XCHAR_TABLE (tables
[k
])->defalt
= alist
;
1936 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1937 doc
: /* Return a font name pattern for character CH in fontset NAME.
1938 If NAME is t, find a font name pattern in the default fontset. */)
1940 Lisp_Object name
, ch
;
1943 Lisp_Object fontset
, elt
;
1945 fontset
= check_fontset_name (name
);
1947 CHECK_CHARACTER (ch
);
1949 elt
= FONTSET_REF (fontset
, c
);
1950 return Fcopy_sequence (elt
);
1953 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1954 doc
: /* Return a list of all defined fontset names. */)
1957 Lisp_Object fontset
, list
;
1961 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1963 fontset
= FONTSET_FROM_ID (i
);
1965 && BASE_FONTSET_P (fontset
))
1966 list
= Fcons (FONTSET_NAME (fontset
), list
);
1973 #ifdef FONTSET_DEBUG
1976 dump_fontset (fontset
)
1977 Lisp_Object fontset
;
1981 vec
= Fmake_vector (make_number (3), Qnil
);
1982 ASET (vec
, 0, FONTSET_ID (fontset
));
1984 if (BASE_FONTSET_P (fontset
))
1986 ASET (vec
, 1, FONTSET_NAME (fontset
));
1992 frame
= FONTSET_FRAME (fontset
);
1995 FRAME_PTR f
= XFRAME (frame
);
1997 if (FRAME_LIVE_P (f
))
1998 ASET (vec
, 1, f
->name
);
2002 if (!NILP (FONTSET_DEFAULT (fontset
)))
2003 ASET (vec
, 2, FONTSET_ID (FONTSET_DEFAULT (fontset
)));
2008 DEFUN ("fontset-list-all", Ffontset_list_all
, Sfontset_list_all
, 0, 0, 0,
2009 doc
: /* Return a brief summary of all fontsets for debug use. */)
2015 for (i
= 0, val
= Qnil
; i
< ASIZE (Vfontset_table
); i
++)
2016 if (! NILP (AREF (Vfontset_table
, i
)))
2017 val
= Fcons (dump_fontset (AREF (Vfontset_table
, i
)), val
);
2018 return (Fnreverse (val
));
2020 #endif /* FONTSET_DEBUG */
2025 if (!load_font_func
)
2026 /* Window system initializer should have set proper functions. */
2029 DEFSYM (Qfontset
, "fontset");
2030 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (9));
2031 DEFSYM (Qfontset_info
, "fontset-info");
2032 Fput (Qfontset_info
, Qchar_table_extra_slots
, make_number (1));
2034 DEFSYM (Qprepend
, "prepend");
2035 DEFSYM (Qappend
, "append");
2037 Vcached_fontset_data
= Qnil
;
2038 staticpro (&Vcached_fontset_data
);
2040 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
2041 staticpro (&Vfontset_table
);
2043 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
2044 staticpro (&Vdefault_fontset
);
2045 FONTSET_ID (Vdefault_fontset
) = make_number (0);
2046 FONTSET_NAME (Vdefault_fontset
)
2047 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
2049 Lisp_Object default_ascii_font
;
2051 #if defined (macintosh)
2053 = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman");
2054 #elif defined (WINDOWSNT)
2056 = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
2059 = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
2061 FONTSET_ASCII (Vdefault_fontset
) = default_ascii_font
;
2063 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
2064 next_fontset_id
= 1;
2066 auto_fontset_alist
= Qnil
;
2067 staticpro (&auto_fontset_alist
);
2069 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
2071 Alist of fontname patterns vs the corresponding encoding and repertory info.
2072 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
2073 where ENCODING is a charset or a char-table,
2074 and REPERTORY is a charset, a char-table, or nil.
2076 ENCODING is for converting a character to a glyph code of the font.
2077 If ENCODING is a charset, encoding a character by the charset gives
2078 the corresponding glyph code. If ENCODING is a char-table, looking up
2079 the table by a character gives the corresponding glyph code.
2081 REPERTORY specifies a repertory of characters supported by the font.
2082 If REPERTORY is a charset, all characters beloging to the charset are
2083 supported. If REPERTORY is a char-table, all characters who have a
2084 non-nil value in the table are supported. It REPERTORY is nil, Emacs
2085 gets the repertory information by an opened font and ENCODING. */);
2086 Vfont_encoding_alist
= Qnil
;
2088 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
2090 Char table of characters whose ascent values should be ignored.
2091 If an entry for a character is non-nil, the ascent value of the glyph
2092 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
2094 This affects how a composite character which contains
2095 such a character is displayed on screen. */);
2096 Vuse_default_ascent
= Qnil
;
2098 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
2100 Char table of characters which is not composed relatively.
2101 If an entry for a character is non-nil, a composition sequence
2102 which contains that character is displayed so that
2103 the glyph of that character is put without considering
2104 an ascent and descent value of a previous character. */);
2105 Vignore_relative_composition
= Qnil
;
2107 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
2108 doc
: /* Alist of fontname vs list of the alternate fontnames.
2109 When a specified font name is not found, the corresponding
2110 alternate fontnames (if any) are tried instead. */);
2111 Valternate_fontname_alist
= Qnil
;
2113 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
2114 doc
: /* Alist of fontset names vs the aliases. */);
2115 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
2116 build_string ("fontset-default")),
2119 DEFVAR_LISP ("vertical-centering-font-regexp",
2120 &Vvertical_centering_font_regexp
,
2121 doc
: /* *Regexp matching font names that require vertical centering on display.
2122 When a character is displayed with such fonts, the character is displayed
2123 at the vertical center of lines. */);
2124 Vvertical_centering_font_regexp
= Qnil
;
2126 defsubr (&Squery_fontset
);
2127 defsubr (&Snew_fontset
);
2128 defsubr (&Sset_fontset_font
);
2129 defsubr (&Sfont_info
);
2130 defsubr (&Sinternal_char_font
);
2131 defsubr (&Sfontset_info
);
2132 defsubr (&Sfontset_font
);
2133 defsubr (&Sfontset_list
);
2134 #ifdef FONTSET_DEBUG
2135 defsubr (&Sfontset_list_all
);
2139 /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
2140 (do not change this comment) */