2 Copyright (C) 2004 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
4 Licensed to the Free Software Foundation.
6 National Institute of Advanced Industrial Science and Technology (AIST)
7 Registration Number H13PRO009
9 This file is part of GNU Emacs.
11 GNU Emacs is free software; you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
13 the Free Software Foundation; either version 2, or (at your option)
16 GNU Emacs is distributed in the hope that it will be useful,
17 but WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 GNU General Public License for more details.
21 You should have received a copy of the GNU General Public License
22 along with GNU Emacs; see the file COPYING. If not, write to
23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 Boston, MA 02111-1307, USA. */
26 /* #define FONTSET_DEBUG */
35 #include "blockinput.h"
37 #include "character.h"
42 #include "dispextern.h"
43 #include "intervals.h"
58 #define xassert(X) do {if (!(X)) abort ();} while (0)
61 #else /* not FONTSET_DEBUG */
62 #define xassert(X) (void) 0
63 #endif /* not FONTSET_DEBUG */
65 EXFUN (Fclear_face_cache
, 1);
69 A fontset is a collection of font related information to give
70 similar appearance (style, etc) of characters. A fontset has two
71 roles. One is to use for the frame parameter `font' as if it is an
72 ASCII font. In that case, Emacs uses the font specified for
73 `ascii' script for the frame's default font.
75 Another role, the more important one, is to provide information
76 about which font to use for each non-ASCII character.
78 There are two kinds of fontsets; base and realized. A base fontset
79 is created by `new-fontset' from Emacs Lisp explicitly. A realized
80 fontset is created implicitly when a face is realized for ASCII
81 characters. A face is also realized for non-ASCII characters based
82 on an ASCII face. All of non-ASCII faces based on the same ASCII
83 face share the same realized fontset.
85 A fontset object is implemented by a char-table whose default value
86 and parent are always nil.
88 An element of a base fontset is a vector of FONT-DEFs which itself
89 is a vector [ FONT-SPEC ENCODING REPERTORY ].
92 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
95 where FAMILY, WEIGHT, SLANT, SWIDTH, ADSTYLE, REGISTRY, and
96 FONT-NAME are strings.
98 Note: Currently WEIGHT through ADSTYLE are ignored.
100 ENCODING is a charset ID that can convert characters to glyph codes
101 of the corresponding font.
103 REPERTORY is a charset ID, a char-table, or nil. If REPERTORY is a
104 charset ID, the repertory of the charset exactly matches with that
105 of the font. If REPERTORY is a char-table, all characters who have
106 a non-nil value in the table are supported. If REPERTORY is nil,
107 we consult with the font itself to get the repertory.
109 ENCODING and REPERTORY are extracted from the variable
110 Vfont_encoding_alist by using a font name generated from FONT-SPEC
111 (if it is a vector) or FONT-NAME as a matching target.
114 An element of a realized fontset is nil or t, or has this form:
116 [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID
117 PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ...].
119 RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
121 [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ]
123 RFONT-DEFn is automatically reordered by the current charset
126 The value nil means that we have not yet generated the above vector
127 from the base of the fontset.
129 The value t means that no font is available for the corresponding
133 A fontset has 9 extra slots.
135 The 1st slot: the ID number of the fontset
138 base: the name of the fontset
143 realized: the base fontset
147 realized: the frame that the fontset belongs to
150 base: the font name for ASCII characters
155 realized: the ID number of a face to use for characters that
156 has no font in a realized fontset.
160 realized: Alist of font index vs the corresponding repertory
165 realized: If the base is not the default fontset, a fontset
166 realized from the default fontset, else nil.
169 base: Same as element value (but for fallback fonts).
172 All fontsets are recorded in the vector Vfontset_table.
177 There's a special base fontset named `default fontset' which
178 defines the default font specifications. When a base fontset
179 doesn't specify a font for a specific character, the corresponding
180 value in the default fontset is used.
182 The parent of a realized fontset created for such a face that has
183 no fontset is the default fontset.
186 These structures are hidden from the other codes than this file.
187 The other codes handle fontsets only by their ID numbers. They
188 usually use the variable name `fontset' for IDs. But, in this
189 file, we always use varialbe name `id' for IDs, and name `fontset'
190 for an actual fontset object, i.e., char-table.
194 /********** VARIABLES and FUNCTION PROTOTYPES **********/
196 extern Lisp_Object Qfont
;
197 static Lisp_Object Qfontset
;
198 static Lisp_Object Qfontset_info
;
199 static Lisp_Object Qprepend
, Qappend
;
201 /* Vector containing all fontsets. */
202 static Lisp_Object Vfontset_table
;
204 /* Next possibly free fontset ID. Usually this keeps the minimum
205 fontset ID not yet used. */
206 static int next_fontset_id
;
208 /* The default fontset. This gives default FAMILY and REGISTRY of
209 font for each character. */
210 static Lisp_Object Vdefault_fontset
;
212 Lisp_Object Vfont_encoding_alist
;
213 Lisp_Object Vuse_default_ascent
;
214 Lisp_Object Vignore_relative_composition
;
215 Lisp_Object Valternate_fontname_alist
;
216 Lisp_Object Vfontset_alias_alist
;
217 Lisp_Object Vvertical_centering_font_regexp
;
219 /* The following six are declarations of callback functions depending
220 on window system. See the comments in src/fontset.h for more
223 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
224 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
226 /* Return a list of font names which matches PATTERN. See the documentation
227 of `x-list-fonts' for more details. */
228 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
233 /* Load a font named NAME for frame F and return a pointer to the
234 information of the loaded font. If loading is failed, return 0. */
235 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
237 /* Return a pointer to struct font_info of a font named NAME for frame F. */
238 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
240 /* Additional function for setting fontset or changing fontset
241 contents of frame F. */
242 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
243 Lisp_Object oldval
));
245 /* To find a CCL program, fs_load_font calls this function.
246 The argument is a pointer to the struct font_info.
247 This function set the member `encoder' of the structure. */
248 void (*find_ccl_program_func
) P_ ((struct font_info
*));
250 Lisp_Object (*get_font_repertory_func
) P_ ((struct frame
*,
251 struct font_info
*));
253 /* Check if any window system is used now. */
254 void (*check_window_system_func
) P_ ((void));
257 /* Prototype declarations for static functions. */
258 static Lisp_Object fontset_add
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
260 static Lisp_Object fontset_font
P_ ((Lisp_Object
, int, struct face
*, int));
261 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
262 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
263 static void accumulate_script_ranges
P_ ((Lisp_Object
, Lisp_Object
,
265 static Lisp_Object find_font_encoding
P_ ((char *));
267 static void set_fontset_font
P_ ((Lisp_Object
, Lisp_Object
));
271 /* Return 1 if ID is a valid fontset id, else return 0. */
274 fontset_id_valid_p (id
)
277 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
284 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
286 /* Return the fontset with ID. No check of ID's validness. */
287 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
289 /* Macros to access special values of FONTSET. */
290 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
292 /* Macros to access special values of (base) FONTSET. */
293 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
294 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
296 /* Macros to access special values of (realized) FONTSET. */
297 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
298 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
299 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
300 #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
301 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
303 /* For both base and realized fontset. */
304 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
306 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
309 /* Return the element of FONTSET for the character C. If FONTSET is a
310 base fontset other then the default fontset and FONTSET doesn't
311 contain information for C, return the information in the default
314 #define FONTSET_REF(fontset, c) \
315 (EQ (fontset, Vdefault_fontset) \
316 ? CHAR_TABLE_REF (fontset, c) \
317 : fontset_ref ((fontset), (c)))
320 fontset_ref (fontset
, c
)
326 elt
= CHAR_TABLE_REF (fontset
, c
);
327 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
328 /* Don't check Vdefault_fontset for a realized fontset. */
329 && NILP (FONTSET_BASE (fontset
)))
330 elt
= CHAR_TABLE_REF (Vdefault_fontset
, c
);
335 /* Return the element of FONTSET for the character C, set FROM and TO
336 to the range of characters around C that have the same value as C.
337 If FONTSET is a base fontset other then the default fontset and
338 FONTSET doesn't contain information for C, return the information
339 in the default fontset. */
341 #define FONTSET_REF_AND_RANGE(fontset, c, form, to) \
342 (EQ (fontset, Vdefault_fontset) \
343 ? char_table_ref_and_range (fontset, c, &from, &to) \
344 : fontset_ref_and_range (fontset, c, &from, &to))
347 fontset_ref_and_range (fontset
, c
, from
, to
)
354 elt
= char_table_ref_and_range (fontset
, c
, from
, to
);
355 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
356 /* Don't check Vdefault_fontset for a realized fontset. */
357 && NILP (FONTSET_BASE (fontset
)))
361 elt
= char_table_ref_and_range (Vdefault_fontset
, c
, &from1
, &to1
);
371 /* Set elements of FONTSET for characters in RANGE to the value ELT.
372 RANGE is a cons (FROM . TO), where FROM and TO are character codes
373 specifying a range. */
375 #define FONTSET_SET(fontset, range, elt) \
376 Fset_char_table_range ((fontset), (range), (elt))
379 /* Modify the elements of FONTSET for characters in RANGE by replacing
380 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
381 and TO are character codes specifying a range. If ADD is nil,
382 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
385 #define FONTSET_ADD(fontset, range, elt, add) \
388 ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
389 : Fset_char_table_range ((fontset), (range), \
390 Fmake_vector (make_number (1), (elt)))) \
391 : fontset_add ((fontset), (range), (elt), (add)))
394 fontset_add (fontset
, range
, elt
, add
)
395 Lisp_Object fontset
, range
, elt
, add
;
398 int idx
= (EQ (add
, Qappend
) ? 0 : 1);
400 args
[1 - idx
] = Fmake_vector (make_number (1), elt
);
404 int from
= XINT (XCAR (range
));
405 int to
= XINT (XCDR (range
));
409 args
[idx
] = char_table_ref_and_range (fontset
, from
, &from1
, &to1
);
412 char_table_set_range (fontset
, from
, to1
,
413 NILP (args
[idx
]) ? args
[1 - idx
]
414 : Fvconcat (2, args
));
420 args
[idx
] = FONTSET_FALLBACK (fontset
);
421 FONTSET_FALLBACK (fontset
)
422 = NILP (args
[idx
]) ? args
[1 - idx
] : Fvconcat (2, args
);
428 /* Update FONTSET_ELEMENT which has this form:
429 [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-RFONT-DEF
430 RFONT-DEF0 RFONT-DEF1 ...].
431 Reorder RFONT-DEFs according to the current order of charset
432 (Vcharset_ordered_list), and update CHARSET-ORDERED-LIST-TICK to
436 reorder_font_vector (fontset_element
)
437 Lisp_Object fontset_element
;
439 Lisp_Object list
, *new_vec
;
440 Lisp_Object font_def
;
442 int *charset_id_table
;
445 ASET (fontset_element
, 0, make_number (charset_ordered_list_tick
));
446 size
= ASIZE (fontset_element
) - 3;
448 /* No need to reorder VEC. */
450 charset_id_table
= (int *) alloca (sizeof (int) * size
);
451 new_vec
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
) * size
);
453 /* At first, extract ENCODING (a chaset ID) from each FONT-DEF.
454 FONT-DEF has this form:
455 [FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] */
456 for (i
= 0; i
< size
; i
++)
458 font_def
= AREF (fontset_element
, i
+ 3);
459 charset_id_table
[i
] = XINT (AREF (AREF (font_def
, 2), 1));
462 /* Then, store FONT-DEFs in NEW_VEC in the correct order. */
463 for (idx
= 0, list
= Vcharset_ordered_list
;
464 idx
< size
&& CONSP (list
); list
= XCDR (list
))
466 for (i
= 0; i
< size
; i
++)
467 if (charset_id_table
[i
] == XINT (XCAR (list
)))
468 new_vec
[idx
++] = AREF (fontset_element
, i
+ 3);
471 /* At last, update FONT-DEFs. */
472 for (i
= 0; i
< size
; i
++)
473 ASET (fontset_element
, i
+ 3, new_vec
[i
]);
477 /* Load a font matching the font related attributes in FACE->lface and
478 font pattern in FONT_DEF of FONTSET, and return an index of the
479 font. FONT_DEF has this form:
480 [ FONT-SPEC ENCODING REPERTORY ]
481 If REPERTORY is nil, generate a char-table representing the font
482 repertory by looking into the font itself. */
485 load_font_get_repertory (f
, face
, font_def
, fontset
)
488 Lisp_Object font_def
;
492 struct font_info
*font_info
;
495 font_name
= choose_face_font (f
, face
->lface
, AREF (font_def
, 0), NULL
);
496 charset
= XINT (AREF (font_def
, 1));
497 if (! (font_info
= fs_load_font (f
, font_name
, charset
)))
500 if (NILP (AREF (font_def
, 2))
501 && NILP (Fassq (make_number (font_info
->font_idx
),
502 FONTSET_REPERTORY (fontset
))))
504 /* We must look into the font to get the correct repertory as a
506 Lisp_Object repertory
;
508 repertory
= (*get_font_repertory_func
) (f
, font_info
);
509 FONTSET_REPERTORY (fontset
)
510 = Fcons (Fcons (make_number (font_info
->font_idx
), repertory
),
511 FONTSET_REPERTORY (fontset
));
514 return font_info
->font_idx
;
518 /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
519 character C. If the corresponding font is not yet opened, open it
520 (if FACE is not NULL) or return Qnil (if FACE is NULL).
521 If no proper font is found for C, return Qnil. */
524 fontset_font (fontset
, c
, face
, id
)
530 Lisp_Object base_fontset
, elt
, vec
;
533 FRAME_PTR f
= XFRAME (FONTSET_FRAME (fontset
));
535 base_fontset
= FONTSET_BASE (fontset
);
536 vec
= CHAR_TABLE_REF (fontset
, c
);
542 /* We have not yet decided a face for C. */
547 elt
= FONTSET_REF_AND_RANGE (base_fontset
, c
, from
, to
);
548 range
= Fcons (make_number (from
), make_number (to
));
551 /* Record that we have no font for characters of this
554 FONTSET_SET (fontset
, range
, vec
);
557 /* Build a vector [ -1 -1 nil NEW-ELT0 NEW-ELT1 NEW-ELT2 ... ],
558 where the first -1 is to force reordering of NEW-ELTn,
559 NEW-ETLn is [nil nil AREF (elt, n) nil]. */
560 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
562 for (i
= 0; i
< ASIZE (elt
); i
++)
566 tmp
= Fmake_vector (make_number (4), Qnil
);
567 ASET (tmp
, 2, AREF (elt
, i
));
568 ASET (vec
, 3 + i
, tmp
);
570 /* Then store it in the fontset. */
571 FONTSET_SET (fontset
, range
, vec
);
575 if (XINT (AREF (vec
, 0)) != charset_ordered_list_tick
)
576 /* The priority of charsets is changed after we selected a face
578 reorder_font_vector (vec
);
582 else if (id
== XFASTINT (AREF (vec
, 1)))
586 ASET (vec
, 1, make_number (id
));
587 for (i
= 3; i
< ASIZE (vec
); i
++)
588 if (id
== XFASTINT (AREF (AREF (AREF (vec
, i
), 2), 1)))
592 ASET (vec
, 2, AREF (vec
, i
));
602 /* Find the first available font in the vector of RFONT-DEF. */
603 for (; i
< ASIZE (vec
); i
++)
605 Lisp_Object font_def
;
610 /* ELT == [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ] */
611 if (INTEGERP (AREF (elt
, 1)) && XINT (AREF (elt
, 1)) < 0)
612 /* We couldn't open this font last time. */
615 if (!face
&& NILP (AREF (elt
, 1)))
616 /* We have not yet opened the font. */
619 font_def
= AREF (elt
, 2);
620 /* FONT_DEF == [ FONT-SPEC ENCODING REPERTORY ] */
621 if (INTEGERP (AREF (font_def
, 2)))
623 /* The repertory is specified by charset ID. */
624 struct charset
*charset
625 = CHARSET_FROM_ID (XINT (AREF (font_def
, 2)));
627 if (! CHAR_CHARSET_P (c
, charset
))
628 /* This font can't display C. */
631 else if (CHAR_TABLE_P (AREF (font_def
, 2)))
633 /* The repertory is specified by a char table. */
634 if (NILP (CHAR_TABLE_REF (AREF (font_def
, 2), c
)))
635 /* This font can't display C. */
642 if (! INTEGERP (AREF (elt
, 1)))
644 /* We have not yet opened a font matching this spec.
645 Open the best matching font now and register the
647 struct font_info
*font_info
;
649 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
650 ASET (elt
, 1, make_number (font_idx
));
652 /* This means that we couldn't find a font matching
655 font_info
= (*get_font_info_func
) (f
, font_idx
);
656 ASET (elt
, 3, build_string (font_info
->full_name
));
659 slot
= Fassq (AREF (elt
, 1), FONTSET_REPERTORY (fontset
));
660 xassert (CONSP (slot
));
661 if (NILP (CHAR_TABLE_REF (XCDR (slot
), c
)))
662 /* This font can't display C. */
666 /* Now we have decided to use this font spec to display C. */
667 if (! INTEGERP (AREF (elt
, 1)))
669 /* But not yet opened the best matching font. */
670 struct font_info
*font_info
;
672 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
673 ASET (elt
, 1, make_number (font_idx
));
675 /* Can't open it. Try the other one. */
677 font_info
= (*get_font_info_func
) (f
, font_idx
);
678 ASET (elt
, 3, build_string (font_info
->full_name
));
681 /* Now we have the opened font. */
686 if (! EQ (vec
, FONTSET_FALLBACK (fontset
)))
688 vec
= FONTSET_FALLBACK (fontset
);
693 elt
= FONTSET_FALLBACK (base_fontset
);
696 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
698 for (i
= 0; i
< ASIZE (elt
); i
++)
702 tmp
= Fmake_vector (make_number (4), Qnil
);
703 ASET (tmp
, 2, AREF (elt
, i
));
704 ASET (vec
, 3 + i
, tmp
);
706 FONTSET_FALLBACK (fontset
) = vec
;
709 /* Record that this fontset has no fallback fonts. */
710 FONTSET_FALLBACK (fontset
) = Qt
;
713 /* Try the default fontset. */
715 if (! EQ (base_fontset
, Vdefault_fontset
))
717 if (NILP (FONTSET_DEFAULT (fontset
)))
718 FONTSET_DEFAULT (fontset
)
719 = make_fontset (FONTSET_FRAME (fontset
), Qnil
, Vdefault_fontset
);
720 return fontset_font (FONTSET_DEFAULT (fontset
), c
, face
, id
);
726 /* Return a newly created fontset with NAME. If BASE is nil, make a
727 base fontset. Otherwise make a realized fontset whose base is
731 make_fontset (frame
, name
, base
)
732 Lisp_Object frame
, name
, base
;
735 int size
= ASIZE (Vfontset_table
);
736 int id
= next_fontset_id
;
738 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
739 the next available fontset ID. So it is expected that this loop
740 terminates quickly. In addition, as the last element of
741 Vfontset_table is always nil, we don't have to check the range of
743 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
747 /* We must grow Vfontset_table. */
751 tem
= Fmake_vector (make_number (size
+ 32), Qnil
);
752 for (i
= 0; i
< size
; i
++)
753 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
754 Vfontset_table
= tem
;
757 fontset
= Fmake_char_table (Qfontset
, Qnil
);
759 FONTSET_ID (fontset
) = make_number (id
);
762 FONTSET_NAME (fontset
) = name
;
766 FONTSET_NAME (fontset
) = Qnil
;
767 FONTSET_FRAME (fontset
) = frame
;
768 FONTSET_BASE (fontset
) = base
;
771 ASET (Vfontset_table
, id
, fontset
);
772 next_fontset_id
= id
+ 1;
778 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
780 /* Return the name of the fontset who has ID. */
788 fontset
= FONTSET_FROM_ID (id
);
789 return FONTSET_NAME (fontset
);
793 /* Return the ASCII font name of the fontset who has ID. */
799 Lisp_Object fontset
, elt
;
801 fontset
= FONTSET_FROM_ID (id
);
802 elt
= FONTSET_ASCII (fontset
);
803 /* It is assured that ELT is always a string (i.e. fontname
809 /* Free fontset of FACE defined on frame F. Called from
810 free_realized_face. */
813 free_face_fontset (f
, face
)
819 fontset
= AREF (Vfontset_table
, face
->fontset
);
820 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
821 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
822 ASET (Vfontset_table
, face
->fontset
, Qnil
);
823 if (face
->fontset
< next_fontset_id
)
824 next_fontset_id
= face
->fontset
;
825 if (! NILP (FONTSET_DEFAULT (fontset
)))
827 int id
= XINT (FONTSET_ID (FONTSET_DEFAULT (fontset
)));
829 fontset
= AREF (Vfontset_table
, id
);
830 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
831 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
832 ASET (Vfontset_table
, id
, Qnil
);
833 if (id
< next_fontset_id
)
834 next_fontset_id
= face
->fontset
;
839 /* Return 1 iff FACE is suitable for displaying character C.
840 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
841 when C is not an ASCII character. */
844 face_suitable_for_char_p (face
, c
)
848 Lisp_Object fontset
, rfont_def
;
850 fontset
= FONTSET_FROM_ID (face
->fontset
);
851 rfont_def
= fontset_font (fontset
, c
, NULL
, -1);
852 return (VECTORP (rfont_def
)
853 && INTEGERP (AREF (rfont_def
, 0))
854 && face
->id
== XINT (AREF (rfont_def
, 0)));
858 /* Return ID of face suitable for displaying character C on frame F.
859 FACE must be reazlied for ASCII characters in advance. Called from
860 the macro FACE_FOR_CHAR. */
863 face_for_char (f
, face
, c
, pos
, object
)
869 Lisp_Object fontset
, charset
, rfont_def
;
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 rfont_def
= fontset_font (fontset
, c
, face
, id
);
890 if (VECTORP (rfont_def
))
892 if (NILP (AREF (rfont_def
, 0)))
894 /* We have not yet made a realized face that uses this font. */
895 int font_idx
= XINT (AREF (rfont_def
, 1));
897 face_id
= lookup_non_ascii_face (f
, font_idx
, face
);
898 ASET (rfont_def
, 0, make_number (face_id
));
900 return XINT (AREF (rfont_def
, 0));
903 if (NILP (FONTSET_NOFONT_FACE (fontset
)))
905 face_id
= lookup_non_ascii_face (f
, -1, face
);
906 FONTSET_NOFONT_FACE (fontset
) = make_number (face_id
);
908 return XINT (FONTSET_NOFONT_FACE (fontset
));
912 /* Make a realized fontset for ASCII face FACE on frame F from the
913 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
914 default fontset as the base. Value is the id of the new fontset.
915 Called from realize_x_face. */
918 make_fontset_for_ascii_face (f
, base_fontset_id
, face
)
923 Lisp_Object base_fontset
, fontset
, frame
;
925 XSETFRAME (frame
, f
);
926 if (base_fontset_id
>= 0)
928 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
929 if (!BASE_FONTSET_P (base_fontset
))
930 base_fontset
= FONTSET_BASE (base_fontset
);
931 xassert (BASE_FONTSET_P (base_fontset
));
932 if (! BASE_FONTSET_P (base_fontset
))
936 base_fontset
= Vdefault_fontset
;
938 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
940 Lisp_Object elt
, rfont_def
;
942 elt
= FONTSET_REF (base_fontset
, 0);
943 xassert (VECTORP (elt
) && ASIZE (elt
) > 0);
944 rfont_def
= Fmake_vector (make_number (4), Qnil
);
945 ASET (rfont_def
, 0, make_number (face
->id
));
946 ASET (rfont_def
, 1, make_number (face
->font_info_id
));
947 ASET (rfont_def
, 2, AREF (elt
, 0));
948 ASET (rfont_def
, 3, build_string (face
->font_name
));
949 elt
= Fmake_vector (make_number (4), Qnil
);
950 ASET (elt
, 0, make_number (charset_ordered_list_tick
));
951 ASET (elt
, 1, make_number (charset_ascii
));
952 ASET (elt
, 2, rfont_def
);
953 ASET (elt
, 3, rfont_def
);
954 char_table_set_range (fontset
, 0, 127, elt
);
956 return XINT (FONTSET_ID (fontset
));
960 #if defined(WINDOWSNT) && defined (_MSC_VER)
961 #pragma optimize("", off)
964 /* Load a font named FONTNAME on frame F. Return a pointer to the
965 struct font_info of the loaded font. If loading fails, return
966 NULL. CHARSET is an ID of charset to encode characters for this
967 font. If it is -1, find one from Vfont_encoding_alist. */
970 fs_load_font (f
, fontname
, charset
)
975 struct font_info
*fontp
;
978 /* No way to get fontname. */
981 fontp
= (*load_font_func
) (f
, fontname
, 0);
982 if (! fontp
|| fontp
->charset
>= 0)
985 fontname
= fontp
->full_name
;
989 Lisp_Object charset_symbol
;
991 charset_symbol
= find_font_encoding (fontname
);
992 if (CONSP (charset_symbol
))
993 charset_symbol
= XCAR (charset_symbol
);
994 charset
= XINT (CHARSET_SYMBOL_ID (charset_symbol
));
996 fontp
->charset
= charset
;
997 fontp
->vertical_centering
= 0;
998 fontp
->font_encoder
= NULL
;
1000 if (charset
!= charset_ascii
)
1002 fontp
->vertical_centering
1003 = (STRINGP (Vvertical_centering_font_regexp
)
1004 && (fast_c_string_match_ignore_case
1005 (Vvertical_centering_font_regexp
, fontname
) >= 0));
1007 if (find_ccl_program_func
)
1008 (*find_ccl_program_func
) (fontp
);
1014 #if defined(WINDOWSNT) && defined (_MSC_VER)
1015 #pragma optimize("", on)
1019 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
1020 FONTNAME. ENCODING is a charset symbol that specifies the encoding
1021 of the font. REPERTORY is a charset symbol or nil. */
1025 find_font_encoding (fontname
)
1028 Lisp_Object tail
, elt
;
1030 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
1034 && STRINGP (XCAR (elt
))
1035 && fast_c_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
1036 && (SYMBOLP (XCDR (elt
))
1037 ? CHARSETP (XCDR (elt
))
1038 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
1039 return (XCDR (elt
));
1041 /* We don't know the encoding of this font. Let's assume `ascii'. */
1046 /* Cache data used by fontset_pattern_regexp. The car part is a
1047 pattern string containing at least one wild card, the cdr part is
1048 the corresponding regular expression. */
1049 static Lisp_Object Vcached_fontset_data
;
1051 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
1052 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1054 /* If fontset name PATTERN contains any wild card, return regular
1055 expression corresponding to PATTERN. */
1058 fontset_pattern_regexp (pattern
)
1059 Lisp_Object pattern
;
1061 if (!index (SDATA (pattern
), '*')
1062 && !index (SDATA (pattern
), '?'))
1063 /* PATTERN does not contain any wild cards. */
1066 if (!CONSP (Vcached_fontset_data
)
1067 || strcmp (SDATA (pattern
), CACHED_FONTSET_NAME
))
1069 /* We must at first update the cached data. */
1070 char *regex
= (char *) alloca (SCHARS (pattern
) * 2 + 3);
1071 char *p0
, *p1
= regex
;
1073 /* Convert "*" to ".*", "?" to ".". */
1075 for (p0
= (char *) SDATA (pattern
); *p0
; p0
++)
1082 else if (*p0
== '?')
1090 Vcached_fontset_data
= Fcons (build_string (SDATA (pattern
)),
1091 build_string (regex
));
1094 return CACHED_FONTSET_REGEX
;
1097 /* Return ID of the base fontset named NAME. If there's no such
1098 fontset, return -1. */
1101 fs_query_fontset (name
, regexpp
)
1108 name
= Fdowncase (name
);
1111 tem
= Frassoc (name
, Vfontset_alias_alist
);
1113 tem
= Fassoc (name
, Vfontset_alias_alist
);
1114 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1118 tem
= fontset_pattern_regexp (name
);
1127 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1129 Lisp_Object fontset
;
1130 unsigned char *this_name
;
1132 fontset
= FONTSET_FROM_ID (i
);
1134 || !BASE_FONTSET_P (fontset
))
1137 this_name
= SDATA (FONTSET_NAME (fontset
));
1139 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
1140 : !strcmp (SDATA (name
), this_name
))
1147 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
1148 doc
: /* Return the name of a fontset that matches PATTERN.
1149 The value is nil if there is no matching fontset.
1150 PATTERN can contain `*' or `?' as a wildcard
1151 just as X font name matching algorithm allows.
1152 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1154 Lisp_Object pattern
, regexpp
;
1156 Lisp_Object fontset
;
1159 (*check_window_system_func
) ();
1161 CHECK_STRING (pattern
);
1163 if (SCHARS (pattern
) == 0)
1166 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
1170 fontset
= FONTSET_FROM_ID (id
);
1171 return FONTSET_NAME (fontset
);
1174 /* Return a list of base fontset names matching PATTERN on frame F. */
1177 list_fontsets (f
, pattern
, size
)
1179 Lisp_Object pattern
;
1182 Lisp_Object frame
, regexp
, val
;
1185 XSETFRAME (frame
, f
);
1187 regexp
= fontset_pattern_regexp (pattern
);
1190 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1192 Lisp_Object fontset
;
1193 unsigned char *name
;
1195 fontset
= FONTSET_FROM_ID (id
);
1197 || !BASE_FONTSET_P (fontset
)
1198 || !EQ (frame
, FONTSET_FRAME (fontset
)))
1200 name
= SDATA (FONTSET_NAME (fontset
));
1202 if (STRINGP (regexp
)
1203 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
1204 : strcmp (SDATA (pattern
), name
))
1207 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
1214 /* Free all realized fontsets whose base fontset is BASE. */
1217 free_realized_fontsets (base
)
1223 /* For the moment, this doesn't work because free_realized_face
1224 doesn't remove FACE from a cache. Until we find a solution, we
1225 suppress this code, and simply use Fclear_face_cache even though
1226 that is not efficient. */
1228 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1230 Lisp_Object
this = AREF (Vfontset_table
, id
);
1232 if (EQ (FONTSET_BASE (this), base
))
1236 for (tail
= FONTSET_FACE_ALIST (this); CONSP (tail
);
1239 FRAME_PTR f
= XFRAME (FONTSET_FRAME (this));
1240 int face_id
= XINT (XCDR (XCAR (tail
)));
1241 struct face
*face
= FACE_FROM_ID (f
, face_id
);
1243 /* Face THIS itself is also freed by the following call. */
1244 free_realized_face (f
, face
);
1250 Fclear_face_cache (Qt
);
1255 /* Check validity of NAME as a fontset name and return the
1256 corresponding fontset. If not valid, signal an error.
1257 If NAME is t, return Vdefault_fontset. */
1260 check_fontset_name (name
)
1266 return Vdefault_fontset
;
1268 CHECK_STRING (name
);
1269 id
= fs_query_fontset (name
, 0);
1271 error ("Fontset `%s' does not exist", SDATA (name
));
1272 return FONTSET_FROM_ID (id
);
1276 accumulate_script_ranges (arg
, range
, val
)
1277 Lisp_Object arg
, range
, val
;
1279 if (EQ (XCAR (arg
), val
))
1282 XSETCDR (arg
, Fcons (Fcons (XCAR (range
), XCDR (range
)), XCDR (arg
)));
1284 XSETCDR (arg
, Fcons (Fcons (range
, range
), XCDR (arg
)));
1289 /* Return an ASCII font name generated from fontset name NAME and
1290 ASCII font specification ASCII_SPEC. NAME is a string conforming
1291 to XLFD. ASCII_SPEC is a vector:
1292 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
1294 static INLINE Lisp_Object
1295 generate_ascii_font_name (name
, ascii_spec
)
1296 Lisp_Object name
, ascii_spec
;
1301 vec
= split_font_name_into_vector (name
);
1302 for (i
= FONT_SPEC_FAMILY_INDEX
; i
<= FONT_SPEC_ADSTYLE_INDEX
; i
++)
1303 if (! NILP (AREF (ascii_spec
, i
)))
1304 ASET (vec
, 1 + i
, AREF (ascii_spec
, i
));
1305 if (! NILP (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
)))
1306 ASET (vec
, 12, AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
1307 return build_font_name_from_vector (vec
);
1310 /* Variables referred in set_fontset_font. They are set before
1311 map_charset_chars is called in Fset_fontset_font. */
1312 static Lisp_Object font_def_arg
, add_arg
;
1313 static int from_arg
, to_arg
;
1315 /* Callback function for map_charset_chars in Fset_fontset_font. In
1316 FONTSET, set font_def_arg in a fashion specified by add_arg for
1317 characters in RANGE while ignoring the range between from_arg and
1321 set_fontset_font (fontset
, range
)
1322 Lisp_Object fontset
, range
;
1324 if (from_arg
< to_arg
)
1326 int from
= XINT (XCAR (range
)), to
= XINT (XCDR (range
));
1328 if (from
< from_arg
)
1334 range2
= Fcons (make_number (to_arg
), XCDR (range
));
1335 FONTSET_ADD (fontset
, range
, font_def_arg
, add_arg
);
1339 range
= Fcons (XCAR (range
), make_number (from_arg
));
1341 else if (to
<= to_arg
)
1346 range
= Fcons (make_number (to_arg
), XCDR (range
));
1349 FONTSET_ADD (fontset
, range
, font_def_arg
, add_arg
);
1353 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 5, 0,
1355 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1357 TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
1358 In that case, use FONT-SPEC for all characters in the range FROM and
1361 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1362 all characters that belong to the script.
1364 TARGET may be a charset. In that case, use FONT-SPEC for all
1365 characters in the charset.
1367 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1368 that no FONT-SPEC is specified.
1370 FONT-SPEC may one of these:
1371 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1372 REGISTRY is a font registry name. FAMILY may contains foundry
1373 name, and REGISTRY may contains encoding name.
1374 * A font name string.
1376 Optional 4th argument FRAME, if non-nil, is a frame. This argument is
1377 kept for backward compatibility and has no meaning.
1379 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1380 to the font specifications for TARGET previously set. If it is
1381 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1382 appended. By default, FONT-SPEC overrides the previous settings. */)
1383 (name
, target
, font_spec
, frame
, add
)
1384 Lisp_Object name
, target
, font_spec
, frame
, add
;
1386 Lisp_Object fontset
;
1387 Lisp_Object font_def
, registry
;
1388 Lisp_Object encoding
, repertory
;
1389 Lisp_Object range_list
;
1390 struct charset
*charset
= NULL
;
1392 fontset
= check_fontset_name (name
);
1394 /* The arg FRAME is kept for backward compatibility. We only check
1397 CHECK_LIVE_FRAME (frame
);
1399 if (VECTORP (font_spec
))
1401 /* FONT_SPEC should have this form:
1402 [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ]
1403 This is a feature not yet documented because WEIGHT thru
1404 ADSTYLE are ignored for the moment. */
1407 if (ASIZE (font_spec
) != FONT_SPEC_MAX_INDEX
)
1408 args_out_of_range (make_number (FONT_SPEC_MAX_INDEX
),
1409 make_number (ASIZE (font_spec
)));
1411 font_spec
= Fcopy_sequence (font_spec
);
1412 for (j
= 0; j
< FONT_SPEC_MAX_INDEX
- 1; j
++)
1413 if (! NILP (AREF (font_spec
, j
)))
1415 CHECK_STRING (AREF (font_spec
, j
));
1416 ASET (font_spec
, j
, Fdowncase (AREF (font_spec
, j
)));
1418 /* REGISTRY should not be omitted. */
1419 CHECK_STRING (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1420 registry
= Fdowncase (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1421 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1424 else if (CONSP (font_spec
))
1428 family
= XCAR (font_spec
);
1429 registry
= XCDR (font_spec
);
1431 if (! NILP (family
))
1433 CHECK_STRING (family
);
1434 family
= Fdowncase (family
);
1436 CHECK_STRING (registry
);
1437 registry
= Fdowncase (registry
);
1438 font_spec
= Fmake_vector (make_number (FONT_SPEC_MAX_INDEX
), Qnil
);
1439 ASET (font_spec
, FONT_SPEC_FAMILY_INDEX
, family
);
1440 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1444 CHECK_STRING (font_spec
);
1445 font_spec
= Fdowncase (font_spec
);
1448 if (STRINGP (font_spec
))
1449 encoding
= find_font_encoding ((char *) SDATA (font_spec
));
1451 encoding
= find_font_encoding ((char *) SDATA (registry
));
1452 if (SYMBOLP (encoding
))
1454 CHECK_CHARSET (encoding
);
1455 encoding
= repertory
= CHARSET_SYMBOL_ID (encoding
);
1459 repertory
= XCDR (encoding
);
1460 encoding
= XCAR (encoding
);
1461 CHECK_CHARSET (encoding
);
1462 encoding
= CHARSET_SYMBOL_ID (encoding
);
1463 if (! NILP (repertory
) && SYMBOLP (repertory
))
1465 CHECK_CHARSET (repertory
);
1466 repertory
= CHARSET_SYMBOL_ID (repertory
);
1469 font_def
= Fmake_vector (make_number (3), font_spec
);
1470 ASET (font_def
, 1, encoding
);
1471 ASET (font_def
, 2, repertory
);
1473 if (CHARACTERP (target
))
1474 range_list
= Fcons (Fcons (target
, target
), Qnil
);
1475 else if (CONSP (target
))
1477 Lisp_Object from
, to
;
1479 from
= Fcar (target
);
1481 CHECK_CHARACTER (from
);
1482 CHECK_CHARACTER (to
);
1483 range_list
= Fcons (target
, Qnil
);
1485 else if (SYMBOLP (target
) && !NILP (target
))
1487 Lisp_Object script_list
;
1491 script_list
= XCHAR_TABLE (Vchar_script_table
)->extras
[0];
1492 if (! NILP (Fmemq (target
, script_list
)))
1494 val
= Fcons (target
, Qnil
);
1495 map_char_table (accumulate_script_ranges
, Qnil
, Vchar_script_table
,
1497 range_list
= XCDR (val
);
1499 if (CHARSETP (target
))
1501 if (EQ (target
, Qascii
))
1503 if (VECTORP (font_spec
))
1504 font_spec
= generate_ascii_font_name (FONTSET_NAME (fontset
),
1506 FONTSET_ASCII (fontset
) = font_spec
;
1507 range_list
= Fcons (Fcons (make_number (0), make_number (127)),
1512 CHECK_CHARSET_GET_CHARSET (target
, charset
);
1515 else if (NILP (range_list
))
1516 error ("Invalid script or charset name: %s",
1517 SDATA (SYMBOL_NAME (target
)));
1519 else if (NILP (target
))
1520 range_list
= Fcons (Qnil
, Qnil
);
1522 error ("Invalid target for setting a font");
1527 font_def_arg
= font_def
;
1529 if (NILP (range_list
))
1530 from_arg
= to_arg
= 0;
1532 from_arg
= XINT (XCAR (XCAR (range_list
))),
1533 to_arg
= XINT (XCDR (XCAR (range_list
)));
1535 map_charset_chars (set_fontset_font
, Qnil
, fontset
, charset
,
1536 CHARSET_MIN_CODE (charset
),
1537 CHARSET_MAX_CODE (charset
));
1539 for (; CONSP (range_list
); range_list
= XCDR (range_list
))
1540 FONTSET_ADD (fontset
, XCAR (range_list
), font_def
, add
);
1542 /* Free all realized fontsets whose base is FONTSET. This way, the
1543 specified character(s) are surely redisplayed by a correct
1545 free_realized_fontsets (fontset
);
1551 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
1552 doc
: /* Create a new fontset NAME from font information in FONTLIST.
1554 FONTLIST is an alist of scripts vs the corresponding font specification list.
1555 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1556 character of SCRIPT is displayed by a font that matches one of
1559 SCRIPT is a symbol that appears in the first extra slot of the
1560 char-table `char-script-table'.
1562 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1563 `set-fontset-font' for the meaning. */)
1565 Lisp_Object name
, fontlist
;
1567 Lisp_Object fontset
;
1571 CHECK_STRING (name
);
1572 CHECK_LIST (fontlist
);
1574 id
= fs_query_fontset (name
, 0);
1577 name
= Fdowncase (name
);
1578 val
= split_font_name_into_vector (name
);
1579 if (NILP (val
) || NILP (AREF (val
, 12)) || NILP (AREF (val
, 13)))
1580 error ("Fontset name must be in XLFD format");
1581 if (strcmp (SDATA (AREF (val
, 12)), "fontset"))
1582 error ("Registry field of fontset name must be \"fontset\"");
1583 Vfontset_alias_alist
1584 = Fcons (Fcons (name
,
1585 concat2 (concat2 (AREF (val
, 12), build_string ("-")),
1587 Vfontset_alias_alist
);
1588 ASET (val
, 12, build_string ("iso8859-1"));
1589 fontset
= make_fontset (Qnil
, name
, Qnil
);
1590 FONTSET_ASCII (fontset
) = build_font_name_from_vector (val
);
1594 fontset
= FONTSET_FROM_ID (id
);;
1595 free_realized_fontsets (fontset
);
1596 Fset_char_table_range (fontset
, Qt
, Qnil
);
1599 for (; ! NILP (fontlist
); fontlist
= Fcdr (fontlist
))
1601 Lisp_Object elt
, script
;
1603 elt
= Fcar (fontlist
);
1604 script
= Fcar (elt
);
1606 if (CONSP (elt
) && (NILP (XCDR (elt
)) || CONSP (XCDR (elt
))))
1607 for (; CONSP (elt
); elt
= XCDR (elt
))
1608 Fset_fontset_font (name
, script
, XCAR (elt
), Qnil
, Qappend
);
1610 Fset_fontset_font (name
, script
, elt
, Qnil
, Qappend
);
1616 /* Alist of automatically created fontsets. Each element is a cons
1617 (FONTNAME . FONTSET-ID). */
1618 static Lisp_Object auto_fontset_alist
;
1621 new_fontset_from_font_name (Lisp_Object fontname
)
1628 fontname
= Fdowncase (fontname
);
1629 val
= Fassoc (fontname
, auto_fontset_alist
);
1631 return XINT (XCDR (val
));
1633 vec
= split_font_name_into_vector (fontname
);
1635 vec
= Fmake_vector (make_number (14), build_string (""));
1636 ASET (vec
, 12, build_string ("fontset"));
1637 if (NILP (auto_fontset_alist
))
1639 ASET (vec
, 13, build_string ("startup"));
1640 name
= build_font_name_from_vector (vec
);
1645 int len
= XINT (Flength (auto_fontset_alist
));
1647 sprintf (temp
, "auto%d", len
);
1648 ASET (vec
, 13, build_string (temp
));
1649 name
= build_font_name_from_vector (vec
);
1651 name
= Fnew_fontset (name
, list2 (list2 (Qascii
, fontname
),
1652 list2 (Fcons (make_number (0),
1653 make_number (MAX_CHAR
)),
1655 id
= fs_query_fontset (name
, 0);
1657 = Fcons (Fcons (fontname
, make_number (id
)), auto_fontset_alist
);
1662 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1663 doc
: /* Return information about a font named NAME on frame FRAME.
1664 If FRAME is omitted or nil, use the selected frame.
1665 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1666 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1668 OPENED-NAME is the name used for opening the font,
1669 FULL-NAME is the full name of the font,
1670 SIZE is the maximum bound width of the font,
1671 HEIGHT is the height of the font,
1672 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1673 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1674 how to compose characters.
1675 If the named font is not yet loaded, return nil. */)
1677 Lisp_Object name
, frame
;
1680 struct font_info
*fontp
;
1683 (*check_window_system_func
) ();
1685 CHECK_STRING (name
);
1686 name
= Fdowncase (name
);
1688 frame
= selected_frame
;
1689 CHECK_LIVE_FRAME (frame
);
1692 if (!query_font_func
)
1693 error ("Font query function is not supported");
1695 fontp
= (*query_font_func
) (f
, SDATA (name
));
1699 info
= Fmake_vector (make_number (7), Qnil
);
1701 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1702 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1703 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1704 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1705 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1706 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1707 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1713 /* Return a cons (FONT-NAME . GLYPH-CODE).
1714 FONT-NAME is the font name for the character at POSITION in the current
1715 buffer. This is computed from all the text properties and overlays
1716 that apply to POSITION. POSTION may be nil, in which case,
1717 FONT-NAME is the font name for display the character CH with the
1720 GLYPH-CODE is the glyph code in the font to use for the character.
1722 If the 2nd optional arg CH is non-nil, it is a character to check
1723 the font instead of the character at POSITION.
1725 It returns nil in the following cases:
1727 (1) The window system doesn't have a font for the character (thus
1728 it is displayed by an empty box).
1730 (2) The character code is invalid.
1732 (3) If POSITION is not nil, and the current buffer is not displayed
1735 In addition, the returned font name may not take into account of
1736 such redisplay engine hooks as what used in jit-lock-mode if
1737 POSITION is currently not visible. */
1740 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 2, 0,
1741 doc
: /* For internal use only. */)
1743 Lisp_Object position
, ch
;
1745 int pos
, pos_byte
, dummy
;
1750 Lisp_Object charset
, rfont_def
;
1753 if (NILP (position
))
1755 CHECK_CHARACTER (ch
);
1757 f
= XFRAME (selected_frame
);
1758 face_id
= DEFAULT_FACE_ID
;
1766 CHECK_NUMBER_COERCE_MARKER (position
);
1767 pos
= XINT (position
);
1768 if (pos
< BEGV
|| pos
>= ZV
)
1769 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1770 pos_byte
= CHAR_TO_BYTE (pos
);
1772 c
= FETCH_CHAR (pos_byte
);
1778 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1781 w
= XWINDOW (window
);
1782 f
= XFRAME (w
->frame
);
1783 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1785 if (! CHAR_VALID_P (c
, 0))
1787 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
, pos
, Qnil
);
1788 face
= FACE_FROM_ID (f
, face_id
);
1789 charset
= Fget_char_property (position
, Qcharset
, Qnil
);
1790 if (CHARSETP (charset
))
1791 id
= XINT (CHARSET_SYMBOL_ID (charset
));
1794 rfont_def
= fontset_font (FONTSET_FROM_ID (face
->fontset
), c
, face
, id
);
1795 if (VECTORP (rfont_def
) && STRINGP (AREF (rfont_def
, 3)))
1797 Lisp_Object font_def
;
1798 struct font_info
*fontp
;
1799 struct charset
*charset
;
1803 font_def
= AREF (rfont_def
, 2);
1804 charset
= CHARSET_FROM_ID (XINT (AREF (font_def
, 1)));
1805 code
= ENCODE_CHAR (charset
, c
);
1806 if (code
== CHARSET_INVALID_CODE (charset
))
1807 return (Fcons (AREF (rfont_def
, 3), Qnil
));
1808 STORE_XCHAR2B (&char2b
, ((code
>> 8) & 0xFF), (code
& 0xFF));
1809 fontp
= (*get_font_info_func
) (f
, XINT (AREF (rfont_def
, 1)));
1810 rif
->encode_char (c
, &char2b
, fontp
, charset
, NULL
);
1811 code
= (XCHAR2B_BYTE1 (&char2b
) << 8) | XCHAR2B_BYTE2 (&char2b
);
1812 return (Fcons (AREF (rfont_def
, 3), make_number (code
)));
1818 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1819 doc
: /* Return information about a fontset FONTSET on frame FRAME.
1820 The value is a char-table of which elements has this form.
1822 ((FONT-PATTERN OPENED-FONT ...) ...)
1824 FONT-PATTERN is a vector:
1826 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
1828 or a string of font name pattern.
1830 OPENED-FONT is a name of a font actually opened.
1832 The char-table has one extra slot. The value is a char-table
1833 containing the information about the derived fonts from the default
1834 fontset. The format is the same as abobe. */)
1836 Lisp_Object fontset
, frame
;
1839 Lisp_Object
*realized
[2], fontsets
[2], tables
[2];
1840 Lisp_Object val
, elt
;
1843 (*check_window_system_func
) ();
1845 fontset
= check_fontset_name (fontset
);
1848 frame
= selected_frame
;
1849 CHECK_LIVE_FRAME (frame
);
1852 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1853 in the table `realized'. */
1854 realized
[0] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1855 * ASIZE (Vfontset_table
));
1856 for (i
= j
= 0; i
< ASIZE (Vfontset_table
); i
++)
1858 elt
= FONTSET_FROM_ID (i
);
1860 && EQ (FONTSET_BASE (elt
), fontset
)
1861 && EQ (FONTSET_FRAME (elt
), frame
))
1862 realized
[0][j
++] = elt
;
1864 realized
[0][j
] = Qnil
;
1866 realized
[1] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1867 * ASIZE (Vfontset_table
));
1868 for (i
= j
= 0; ! NILP (realized
[0][i
]); i
++)
1870 elt
= FONTSET_DEFAULT (realized
[0][i
]);
1872 realized
[1][j
++] = elt
;
1874 realized
[1][j
] = Qnil
;
1876 tables
[0] = Fmake_char_table (Qfontset_info
, Qnil
);
1877 tables
[1] = Fmake_char_table (Qnil
, Qnil
);
1878 XCHAR_TABLE (tables
[0])->extras
[0] = tables
[1];
1879 fontsets
[0] = fontset
;
1880 fontsets
[1] = Vdefault_fontset
;
1882 /* Accumulate information of the fontset in TABLE. The format of
1883 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1884 for (k
= 0; k
<= 1; k
++)
1886 for (c
= 0; c
<= MAX_CHAR
; )
1890 if (c
<= MAX_5_BYTE_CHAR
)
1892 val
= char_table_ref_and_range (fontsets
[k
], c
, &from
, &to
);
1893 if (to
> MAX_5_BYTE_CHAR
)
1894 to
= MAX_5_BYTE_CHAR
;
1898 val
= FONTSET_FALLBACK (fontsets
[k
]);
1905 /* At first, set ALIST to ((FONT-SPEC) ...). */
1906 for (alist
= Qnil
, i
= 0; i
< ASIZE (val
); i
++)
1907 alist
= Fcons (Fcons (AREF (AREF (val
, i
), 0), Qnil
), alist
);
1908 alist
= Fnreverse (alist
);
1910 /* Then store opend font names to cdr of each elements. */
1911 for (i
= 0; ! NILP (realized
[k
][i
]); i
++)
1913 if (c
<= MAX_5_BYTE_CHAR
)
1914 val
= FONTSET_REF (realized
[k
][i
], c
);
1916 val
= FONTSET_FALLBACK (realized
[k
][i
]);
1917 if (! VECTORP (val
))
1919 /* VAL is [int int ?
1920 [FACE-ID FONT-INDEX FONT-DEF FONT-NAME] ...].
1921 If a font of an element is already opened,
1922 FONT-NAME is the name of a opened font. */
1923 for (j
= 3; j
< ASIZE (val
); j
++)
1924 if (STRINGP (AREF (AREF (val
, j
), 3)))
1926 Lisp_Object font_idx
;
1928 font_idx
= AREF (AREF (val
, j
), 1);
1929 elt
= Fassq (AREF (AREF (AREF (val
, j
), 2), 0), alist
);
1931 && NILP (Fmemq (font_idx
, XCDR(elt
))))
1932 nconc2 (elt
, Fcons (font_idx
, Qnil
));
1935 for (val
= alist
; CONSP (val
); val
= XCDR (val
))
1936 for (elt
= XCDR (XCAR (val
)); CONSP (elt
); elt
= XCDR (elt
))
1938 struct font_info
*font_info
1939 = (*get_font_info_func
) (f
, XINT (XCAR (elt
)));
1940 XSETCAR (elt
, build_string (font_info
->full_name
));
1943 /* Store ALIST in TBL for characters C..TO. */
1944 if (c
<= MAX_5_BYTE_CHAR
)
1945 char_table_set_range (tables
[k
], c
, to
, alist
);
1947 XCHAR_TABLE (tables
[k
])->defalt
= alist
;
1957 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 3, 0,
1958 doc
: /* Return a font name pattern for character CH in fontset NAME.
1959 If NAME is t, find a pattern in the default fontset.
1961 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
1962 family name and REGISTRY is a font registry name. This is actually
1963 the first font name pattern for CH in the fontset or in the default
1966 If the 2nd optional arg ALL is non-nil, return a list of all font name
1969 Lisp_Object name
, ch
, all
;
1972 Lisp_Object fontset
, elt
, list
, repertory
, val
;
1975 fontset
= check_fontset_name (name
);
1977 CHECK_CHARACTER (ch
);
1982 for (i
= 0, elt
= FONTSET_REF (fontset
, c
); i
< 2;
1983 i
++, elt
= FONTSET_FALLBACK (fontset
))
1985 for (j
= 0; j
< ASIZE (elt
); j
++)
1987 val
= AREF (elt
, j
);
1988 repertory
= AREF (val
, 1);
1989 if (INTEGERP (repertory
))
1991 struct charset
*charset
= CHARSET_FROM_ID (XINT (repertory
));
1993 if (! CHAR_CHARSET_P (c
, charset
))
1996 else if (CHAR_TABLE_P (repertory
))
1998 if (NILP (CHAR_TABLE_REF (repertory
, c
)))
2001 val
= AREF (val
, 0);
2002 val
= Fcons (AREF (val
, 0), AREF (val
, 5));
2005 list
= Fcons (val
, list
);
2007 if (EQ (fontset
, Vdefault_fontset
))
2009 fontset
= Vdefault_fontset
;
2011 return (Fnreverse (list
));
2014 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
2015 doc
: /* Return a list of all defined fontset names. */)
2018 Lisp_Object fontset
, list
;
2022 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
2024 fontset
= FONTSET_FROM_ID (i
);
2026 && BASE_FONTSET_P (fontset
))
2027 list
= Fcons (FONTSET_NAME (fontset
), list
);
2034 #ifdef FONTSET_DEBUG
2037 dump_fontset (fontset
)
2038 Lisp_Object fontset
;
2042 vec
= Fmake_vector (make_number (3), Qnil
);
2043 ASET (vec
, 0, FONTSET_ID (fontset
));
2045 if (BASE_FONTSET_P (fontset
))
2047 ASET (vec
, 1, FONTSET_NAME (fontset
));
2053 frame
= FONTSET_FRAME (fontset
);
2056 FRAME_PTR f
= XFRAME (frame
);
2058 if (FRAME_LIVE_P (f
))
2059 ASET (vec
, 1, f
->name
);
2063 if (!NILP (FONTSET_DEFAULT (fontset
)))
2064 ASET (vec
, 2, FONTSET_ID (FONTSET_DEFAULT (fontset
)));
2069 DEFUN ("fontset-list-all", Ffontset_list_all
, Sfontset_list_all
, 0, 0, 0,
2070 doc
: /* Return a brief summary of all fontsets for debug use. */)
2076 for (i
= 0, val
= Qnil
; i
< ASIZE (Vfontset_table
); i
++)
2077 if (! NILP (AREF (Vfontset_table
, i
)))
2078 val
= Fcons (dump_fontset (AREF (Vfontset_table
, i
)), val
);
2079 return (Fnreverse (val
));
2081 #endif /* FONTSET_DEBUG */
2086 if (!load_font_func
)
2087 /* Window system initializer should have set proper functions. */
2090 DEFSYM (Qfontset
, "fontset");
2091 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (9));
2092 DEFSYM (Qfontset_info
, "fontset-info");
2093 Fput (Qfontset_info
, Qchar_table_extra_slots
, make_number (1));
2095 DEFSYM (Qprepend
, "prepend");
2096 DEFSYM (Qappend
, "append");
2098 Vcached_fontset_data
= Qnil
;
2099 staticpro (&Vcached_fontset_data
);
2101 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
2102 staticpro (&Vfontset_table
);
2104 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
2105 staticpro (&Vdefault_fontset
);
2106 FONTSET_ID (Vdefault_fontset
) = make_number (0);
2107 FONTSET_NAME (Vdefault_fontset
)
2108 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
2110 Lisp_Object default_ascii_font
;
2112 #if defined (macintosh)
2114 = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman");
2115 #elif defined (WINDOWSNT)
2117 = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
2120 = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
2122 FONTSET_ASCII (Vdefault_fontset
) = default_ascii_font
;
2124 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
2125 next_fontset_id
= 1;
2127 auto_fontset_alist
= Qnil
;
2128 staticpro (&auto_fontset_alist
);
2130 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
2132 Alist of fontname patterns vs the corresponding encoding and repertory info.
2133 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
2134 where ENCODING is a charset or a char-table,
2135 and REPERTORY is a charset, a char-table, or nil.
2137 ENCODING is for converting a character to a glyph code of the font.
2138 If ENCODING is a charset, encoding a character by the charset gives
2139 the corresponding glyph code. If ENCODING is a char-table, looking up
2140 the table by a character gives the corresponding glyph code.
2142 REPERTORY specifies a repertory of characters supported by the font.
2143 If REPERTORY is a charset, all characters beloging to the charset are
2144 supported. If REPERTORY is a char-table, all characters who have a
2145 non-nil value in the table are supported. It REPERTORY is nil, Emacs
2146 gets the repertory information by an opened font and ENCODING. */);
2147 Vfont_encoding_alist
= Qnil
;
2149 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
2151 Char table of characters whose ascent values should be ignored.
2152 If an entry for a character is non-nil, the ascent value of the glyph
2153 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
2155 This affects how a composite character which contains
2156 such a character is displayed on screen. */);
2157 Vuse_default_ascent
= Qnil
;
2159 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
2161 Char table of characters which is not composed relatively.
2162 If an entry for a character is non-nil, a composition sequence
2163 which contains that character is displayed so that
2164 the glyph of that character is put without considering
2165 an ascent and descent value of a previous character. */);
2166 Vignore_relative_composition
= Qnil
;
2168 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
2169 doc
: /* Alist of fontname vs list of the alternate fontnames.
2170 When a specified font name is not found, the corresponding
2171 alternate fontnames (if any) are tried instead. */);
2172 Valternate_fontname_alist
= Qnil
;
2174 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
2175 doc
: /* Alist of fontset names vs the aliases. */);
2176 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
2177 build_string ("fontset-default")),
2180 DEFVAR_LISP ("vertical-centering-font-regexp",
2181 &Vvertical_centering_font_regexp
,
2182 doc
: /* *Regexp matching font names that require vertical centering on display.
2183 When a character is displayed with such fonts, the character is displayed
2184 at the vertical center of lines. */);
2185 Vvertical_centering_font_regexp
= Qnil
;
2187 defsubr (&Squery_fontset
);
2188 defsubr (&Snew_fontset
);
2189 defsubr (&Sset_fontset_font
);
2190 defsubr (&Sfont_info
);
2191 defsubr (&Sinternal_char_font
);
2192 defsubr (&Sfontset_info
);
2193 defsubr (&Sfontset_font
);
2194 defsubr (&Sfontset_list
);
2195 #ifdef FONTSET_DEBUG
2196 defsubr (&Sfontset_list_all
);
2200 /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
2201 (do not change this comment) */