2 Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1997, 1998, 2000, 2003, 2004, 2005
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H14PRO021
7 National Institute of Advanced Industrial Science and Technology (AIST)
8 Registration Number H13PRO009
10 This file is part of GNU Emacs.
12 GNU Emacs is free software; you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation; either version 2, or (at your option)
17 GNU Emacs is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 GNU General Public License for more details.
22 You should have received a copy of the GNU General Public License
23 along with GNU Emacs; see the file COPYING. If not, write to
24 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 Boston, MA 02110-1301, USA. */
27 /* #define FONTSET_DEBUG */
36 #include "blockinput.h"
38 #include "character.h"
43 #include "dispextern.h"
44 #include "intervals.h"
59 #define xassert(X) do {if (!(X)) abort ();} while (0)
62 #else /* not FONTSET_DEBUG */
63 #define xassert(X) (void) 0
64 #endif /* not FONTSET_DEBUG */
66 EXFUN (Fclear_face_cache
, 1);
70 A fontset is a collection of font related information to give
71 similar appearance (style, etc) of characters. A fontset has two
72 roles. One is to use for the frame parameter `font' as if it is an
73 ASCII font. In that case, Emacs uses the font specified for
74 `ascii' script for the frame's default font.
76 Another role, the more important one, is to provide information
77 about which font to use for each non-ASCII character.
79 There are two kinds of fontsets; base and realized. A base fontset
80 is created by `new-fontset' from Emacs Lisp explicitly. A realized
81 fontset is created implicitly when a face is realized for ASCII
82 characters. A face is also realized for non-ASCII characters based
83 on an ASCII face. All of non-ASCII faces based on the same ASCII
84 face share the same realized fontset.
86 A fontset object is implemented by a char-table whose default value
87 and parent are always nil.
89 An element of a base fontset is a vector of FONT-DEFs which itself
90 is a vector [ FONT-SPEC ENCODING REPERTORY ].
93 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
96 where FAMILY, WEIGHT, SLANT, SWIDTH, ADSTYLE, REGISTRY, and
97 FONT-NAME are strings.
99 Note: Currently WEIGHT through ADSTYLE are ignored.
101 ENCODING is a charset ID that can convert characters to glyph codes
102 of the corresponding font.
104 REPERTORY is a charset ID, a char-table, or nil. If REPERTORY is a
105 charset ID, the repertory of the charset exactly matches with that
106 of the font. If REPERTORY is a char-table, all characters who have
107 a non-nil value in the table are supported. If REPERTORY is nil,
108 we consult with the font itself to get the repertory.
110 ENCODING and REPERTORY are extracted from the variable
111 Vfont_encoding_alist by using a font name generated from FONT-SPEC
112 (if it is a vector) or FONT-NAME as a matching target.
115 An element of a realized fontset is nil or t, or has this form:
117 [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID
118 PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ...].
120 RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
122 [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ]
124 RFONT-DEFn is automatically reordered by the current charset
127 The value nil means that we have not yet generated the above vector
128 from the base of the fontset.
130 The value t means that no font is available for the corresponding
134 A fontset has 9 extra slots.
136 The 1st slot: the ID number of the fontset
139 base: the name of the fontset
144 realized: the base fontset
148 realized: the frame that the fontset belongs to
151 base: the font name for ASCII characters
156 realized: the ID number of a face to use for characters that
157 has no font in a realized fontset.
161 realized: Alist of font index vs the corresponding repertory
166 realized: If the base is not the default fontset, a fontset
167 realized from the default fontset, else nil.
170 base: Same as element value (but for fallback fonts).
173 All fontsets are recorded in the vector Vfontset_table.
178 There's a special base fontset named `default fontset' which
179 defines the default font specifications. When a base fontset
180 doesn't specify a font for a specific character, the corresponding
181 value in the default fontset is used.
183 The parent of a realized fontset created for such a face that has
184 no fontset is the default fontset.
187 These structures are hidden from the other codes than this file.
188 The other codes handle fontsets only by their ID numbers. They
189 usually use the variable name `fontset' for IDs. But, in this
190 file, we always use varialbe name `id' for IDs, and name `fontset'
191 for an actual fontset object, i.e., char-table.
195 /********** VARIABLES and FUNCTION PROTOTYPES **********/
197 extern Lisp_Object Qfont
;
198 static Lisp_Object Qfontset
;
199 static Lisp_Object Qfontset_info
;
200 static Lisp_Object Qprepend
, Qappend
;
202 /* Vector containing all fontsets. */
203 static Lisp_Object Vfontset_table
;
205 /* Next possibly free fontset ID. Usually this keeps the minimum
206 fontset ID not yet used. */
207 static int next_fontset_id
;
209 /* The default fontset. This gives default FAMILY and REGISTRY of
210 font for each character. */
211 static Lisp_Object Vdefault_fontset
;
213 Lisp_Object Vfont_encoding_alist
;
214 Lisp_Object Vuse_default_ascent
;
215 Lisp_Object Vignore_relative_composition
;
216 Lisp_Object Valternate_fontname_alist
;
217 Lisp_Object Vfontset_alias_alist
;
218 Lisp_Object Vvertical_centering_font_regexp
;
220 /* The following six are declarations of callback functions depending
221 on window system. See the comments in src/fontset.h for more
224 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
225 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
227 /* Return a list of font names which matches PATTERN. See the documentation
228 of `x-list-fonts' for more details. */
229 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
234 /* Load a font named NAME for frame F and return a pointer to the
235 information of the loaded font. If loading is failed, return 0. */
236 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
238 /* Return a pointer to struct font_info of a font named NAME for frame F. */
239 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
241 /* Additional function for setting fontset or changing fontset
242 contents of frame F. */
243 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
244 Lisp_Object oldval
));
246 /* To find a CCL program, fs_load_font calls this function.
247 The argument is a pointer to the struct font_info.
248 This function set the member `encoder' of the structure. */
249 void (*find_ccl_program_func
) P_ ((struct font_info
*));
251 Lisp_Object (*get_font_repertory_func
) P_ ((struct frame
*,
252 struct font_info
*));
254 /* Check if any window system is used now. */
255 void (*check_window_system_func
) P_ ((void));
258 /* Prototype declarations for static functions. */
259 static Lisp_Object fontset_add
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
261 static Lisp_Object fontset_font
P_ ((Lisp_Object
, int, struct face
*, int));
262 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
263 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
264 static void accumulate_script_ranges
P_ ((Lisp_Object
, Lisp_Object
,
266 static Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
268 static void set_fontset_font
P_ ((Lisp_Object
, Lisp_Object
));
272 /* Return 1 if ID is a valid fontset id, else return 0. */
275 fontset_id_valid_p (id
)
278 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
285 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
287 /* Return the fontset with ID. No check of ID's validness. */
288 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
290 /* Macros to access special values of FONTSET. */
291 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
293 /* Macros to access special values of (base) FONTSET. */
294 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
295 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
297 /* Macros to access special values of (realized) FONTSET. */
298 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
299 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
300 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
301 #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
302 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
304 /* For both base and realized fontset. */
305 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
307 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
310 /* Return the element of FONTSET for the character C. If FONTSET is a
311 base fontset other then the default fontset and FONTSET doesn't
312 contain information for C, return the information in the default
315 #define FONTSET_REF(fontset, c) \
316 (EQ (fontset, Vdefault_fontset) \
317 ? CHAR_TABLE_REF (fontset, c) \
318 : fontset_ref ((fontset), (c)))
321 fontset_ref (fontset
, c
)
327 elt
= CHAR_TABLE_REF (fontset
, c
);
328 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
329 /* Don't check Vdefault_fontset for a realized fontset. */
330 && NILP (FONTSET_BASE (fontset
)))
331 elt
= CHAR_TABLE_REF (Vdefault_fontset
, c
);
336 /* Return the element of FONTSET for the character C, set FROM and TO
337 to the range of characters around C that have the same value as C.
338 If FONTSET is a base fontset other then the default fontset and
339 FONTSET doesn't contain information for C, return the information
340 in the default fontset. */
342 #define FONTSET_REF_AND_RANGE(fontset, c, form, to) \
343 (EQ (fontset, Vdefault_fontset) \
344 ? char_table_ref_and_range (fontset, c, &from, &to) \
345 : fontset_ref_and_range (fontset, c, &from, &to))
348 fontset_ref_and_range (fontset
, c
, from
, to
)
355 elt
= char_table_ref_and_range (fontset
, c
, from
, to
);
356 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
357 /* Don't check Vdefault_fontset for a realized fontset. */
358 && NILP (FONTSET_BASE (fontset
)))
362 elt
= char_table_ref_and_range (Vdefault_fontset
, c
, &from1
, &to1
);
372 /* Set elements of FONTSET for characters in RANGE to the value ELT.
373 RANGE is a cons (FROM . TO), where FROM and TO are character codes
374 specifying a range. */
376 #define FONTSET_SET(fontset, range, elt) \
377 Fset_char_table_range ((fontset), (range), (elt))
380 /* Modify the elements of FONTSET for characters in RANGE by replacing
381 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
382 and TO are character codes specifying a range. If ADD is nil,
383 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
386 #define FONTSET_ADD(fontset, range, elt, add) \
389 ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
390 : Fset_char_table_range ((fontset), (range), \
391 Fmake_vector (make_number (1), (elt)))) \
392 : fontset_add ((fontset), (range), (elt), (add)))
395 fontset_add (fontset
, range
, elt
, add
)
396 Lisp_Object fontset
, range
, elt
, add
;
399 int idx
= (EQ (add
, Qappend
) ? 0 : 1);
401 args
[1 - idx
] = Fmake_vector (make_number (1), elt
);
405 int from
= XINT (XCAR (range
));
406 int to
= XINT (XCDR (range
));
410 args
[idx
] = char_table_ref_and_range (fontset
, from
, &from1
, &to1
);
413 char_table_set_range (fontset
, from
, to1
,
414 NILP (args
[idx
]) ? args
[1 - idx
]
415 : Fvconcat (2, args
));
421 args
[idx
] = FONTSET_FALLBACK (fontset
);
422 FONTSET_FALLBACK (fontset
)
423 = NILP (args
[idx
]) ? args
[1 - idx
] : Fvconcat (2, args
);
429 /* Update FONTSET_ELEMENT which has this form:
430 [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-RFONT-DEF
431 RFONT-DEF0 RFONT-DEF1 ...].
432 Reorder RFONT-DEFs according to the current order of charset
433 (Vcharset_ordered_list), and update CHARSET-ORDERED-LIST-TICK to
437 reorder_font_vector (fontset_element
)
438 Lisp_Object fontset_element
;
440 Lisp_Object list
, *new_vec
;
441 Lisp_Object font_def
;
443 int *charset_id_table
;
446 ASET (fontset_element
, 0, make_number (charset_ordered_list_tick
));
447 size
= ASIZE (fontset_element
) - 3;
449 /* No need to reorder VEC. */
451 charset_id_table
= (int *) alloca (sizeof (int) * size
);
452 new_vec
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
) * size
);
454 /* At first, extract ENCODING (a chaset ID) from each FONT-DEF.
455 FONT-DEF has this form:
456 [FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] */
457 for (i
= 0; i
< size
; i
++)
459 font_def
= AREF (fontset_element
, i
+ 3);
460 charset_id_table
[i
] = XINT (AREF (AREF (font_def
, 2), 1));
463 /* Then, store FONT-DEFs in NEW_VEC in the correct order. */
464 for (idx
= 0, list
= Vcharset_ordered_list
;
465 idx
< size
&& CONSP (list
); list
= XCDR (list
))
467 for (i
= 0; i
< size
; i
++)
468 if (charset_id_table
[i
] == XINT (XCAR (list
)))
469 new_vec
[idx
++] = AREF (fontset_element
, i
+ 3);
472 /* At last, update FONT-DEFs. */
473 for (i
= 0; i
< size
; i
++)
474 ASET (fontset_element
, i
+ 3, new_vec
[i
]);
478 /* Load a font matching the font related attributes in FACE->lface and
479 font pattern in FONT_DEF of FONTSET, and return an index of the
480 font. FONT_DEF has this form:
481 [ FONT-SPEC ENCODING REPERTORY ]
482 If REPERTORY is nil, generate a char-table representing the font
483 repertory by looking into the font itself. */
486 load_font_get_repertory (f
, face
, font_def
, fontset
)
489 Lisp_Object font_def
;
493 struct font_info
*font_info
;
496 font_name
= choose_face_font (f
, face
->lface
, AREF (font_def
, 0), NULL
);
497 charset
= XINT (AREF (font_def
, 1));
498 if (! (font_info
= fs_load_font (f
, font_name
, charset
)))
501 if (NILP (AREF (font_def
, 2))
502 && NILP (Fassq (make_number (font_info
->font_idx
),
503 FONTSET_REPERTORY (fontset
))))
505 /* We must look into the font to get the correct repertory as a
507 Lisp_Object repertory
;
509 repertory
= (*get_font_repertory_func
) (f
, font_info
);
510 FONTSET_REPERTORY (fontset
)
511 = Fcons (Fcons (make_number (font_info
->font_idx
), repertory
),
512 FONTSET_REPERTORY (fontset
));
515 return font_info
->font_idx
;
519 /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
520 character C. If the corresponding font is not yet opened, open it
521 (if FACE is not NULL) or return Qnil (if FACE is NULL).
522 If no proper font is found for C, return Qnil. */
525 fontset_font (fontset
, c
, face
, id
)
531 Lisp_Object base_fontset
, elt
, vec
;
534 FRAME_PTR f
= XFRAME (FONTSET_FRAME (fontset
));
536 base_fontset
= FONTSET_BASE (fontset
);
537 vec
= CHAR_TABLE_REF (fontset
, c
);
543 /* We have not yet decided a face for C. */
548 elt
= FONTSET_REF_AND_RANGE (base_fontset
, c
, from
, to
);
549 range
= Fcons (make_number (from
), make_number (to
));
552 /* Record that we have no font for characters of this
555 FONTSET_SET (fontset
, range
, vec
);
558 /* Build a vector [ -1 -1 nil NEW-ELT0 NEW-ELT1 NEW-ELT2 ... ],
559 where the first -1 is to force reordering of NEW-ELTn,
560 NEW-ETLn is [nil nil AREF (elt, n) nil]. */
561 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
563 for (i
= 0; i
< ASIZE (elt
); i
++)
567 tmp
= Fmake_vector (make_number (4), Qnil
);
568 ASET (tmp
, 2, AREF (elt
, i
));
569 ASET (vec
, 3 + i
, tmp
);
571 /* Then store it in the fontset. */
572 FONTSET_SET (fontset
, range
, vec
);
576 if (XINT (AREF (vec
, 0)) != charset_ordered_list_tick
)
577 /* The priority of charsets is changed after we selected a face
579 reorder_font_vector (vec
);
583 else if (id
== XFASTINT (AREF (vec
, 1)))
587 ASET (vec
, 1, make_number (id
));
588 for (i
= 3; i
< ASIZE (vec
); i
++)
589 if (id
== XFASTINT (AREF (AREF (AREF (vec
, i
), 2), 1)))
593 ASET (vec
, 2, AREF (vec
, i
));
603 /* Find the first available font in the vector of RFONT-DEF. */
604 for (; i
< ASIZE (vec
); i
++)
606 Lisp_Object font_def
;
611 /* ELT == [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ] */
612 if (INTEGERP (AREF (elt
, 1)) && XINT (AREF (elt
, 1)) < 0)
613 /* We couldn't open this font last time. */
616 if (!face
&& NILP (AREF (elt
, 1)))
617 /* We have not yet opened the font. */
620 font_def
= AREF (elt
, 2);
621 /* FONT_DEF == [ FONT-SPEC ENCODING REPERTORY ] */
622 if (INTEGERP (AREF (font_def
, 2)))
624 /* The repertory is specified by charset ID. */
625 struct charset
*charset
626 = CHARSET_FROM_ID (XINT (AREF (font_def
, 2)));
628 if (! CHAR_CHARSET_P (c
, charset
))
629 /* This font can't display C. */
632 else if (CHAR_TABLE_P (AREF (font_def
, 2)))
634 /* The repertory is specified by a char table. */
635 if (NILP (CHAR_TABLE_REF (AREF (font_def
, 2), c
)))
636 /* This font can't display C. */
643 if (! INTEGERP (AREF (elt
, 1)))
645 /* We have not yet opened a font matching this spec.
646 Open the best matching font now and register the
648 struct font_info
*font_info
;
650 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
651 ASET (elt
, 1, make_number (font_idx
));
653 /* This means that we couldn't find a font matching
656 font_info
= (*get_font_info_func
) (f
, font_idx
);
657 ASET (elt
, 3, build_string (font_info
->full_name
));
660 slot
= Fassq (AREF (elt
, 1), FONTSET_REPERTORY (fontset
));
661 xassert (CONSP (slot
));
662 if (NILP (CHAR_TABLE_REF (XCDR (slot
), c
)))
663 /* This font can't display C. */
667 /* Now we have decided to use this font spec to display C. */
668 if (! INTEGERP (AREF (elt
, 1)))
670 /* But not yet opened the best matching font. */
671 struct font_info
*font_info
;
673 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
674 ASET (elt
, 1, make_number (font_idx
));
676 /* Can't open it. Try the other one. */
678 font_info
= (*get_font_info_func
) (f
, font_idx
);
679 ASET (elt
, 3, build_string (font_info
->full_name
));
682 /* Now we have the opened font. */
687 if (! EQ (vec
, FONTSET_FALLBACK (fontset
)))
689 vec
= FONTSET_FALLBACK (fontset
);
694 elt
= FONTSET_FALLBACK (base_fontset
);
697 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
699 for (i
= 0; i
< ASIZE (elt
); i
++)
703 tmp
= Fmake_vector (make_number (4), Qnil
);
704 ASET (tmp
, 2, AREF (elt
, i
));
705 ASET (vec
, 3 + i
, tmp
);
707 FONTSET_FALLBACK (fontset
) = vec
;
710 /* Record that this fontset has no fallback fonts. */
711 FONTSET_FALLBACK (fontset
) = Qt
;
714 /* Try the default fontset. */
716 if (! EQ (base_fontset
, Vdefault_fontset
))
718 if (NILP (FONTSET_DEFAULT (fontset
)))
719 FONTSET_DEFAULT (fontset
)
720 = make_fontset (FONTSET_FRAME (fontset
), Qnil
, Vdefault_fontset
);
721 return fontset_font (FONTSET_DEFAULT (fontset
), c
, face
, id
);
727 /* Return a newly created fontset with NAME. If BASE is nil, make a
728 base fontset. Otherwise make a realized fontset whose base is
732 make_fontset (frame
, name
, base
)
733 Lisp_Object frame
, name
, base
;
736 int size
= ASIZE (Vfontset_table
);
737 int id
= next_fontset_id
;
739 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
740 the next available fontset ID. So it is expected that this loop
741 terminates quickly. In addition, as the last element of
742 Vfontset_table is always nil, we don't have to check the range of
744 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
748 /* We must grow Vfontset_table. */
752 tem
= Fmake_vector (make_number (size
+ 32), Qnil
);
753 for (i
= 0; i
< size
; i
++)
754 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
755 Vfontset_table
= tem
;
758 fontset
= Fmake_char_table (Qfontset
, Qnil
);
760 FONTSET_ID (fontset
) = make_number (id
);
763 FONTSET_NAME (fontset
) = name
;
767 FONTSET_NAME (fontset
) = Qnil
;
768 FONTSET_FRAME (fontset
) = frame
;
769 FONTSET_BASE (fontset
) = base
;
772 ASET (Vfontset_table
, id
, fontset
);
773 next_fontset_id
= id
+ 1;
778 /* Set the ASCII font of the default fontset to FONTNAME if that is
781 set_default_ascii_font (fontname
)
782 Lisp_Object fontname
;
784 if (! STRINGP (FONTSET_ASCII (Vdefault_fontset
)))
786 int id
= fs_query_fontset (fontname
, 2);
789 fontname
= FONTSET_ASCII (FONTSET_FROM_ID (id
));
790 FONTSET_ASCII (Vdefault_fontset
)= fontname
;
795 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
797 /* Return the name of the fontset who has ID. */
805 fontset
= FONTSET_FROM_ID (id
);
806 return FONTSET_NAME (fontset
);
810 /* Return the ASCII font name of the fontset who has ID. */
816 Lisp_Object fontset
, elt
;
818 fontset
= FONTSET_FROM_ID (id
);
819 elt
= FONTSET_ASCII (fontset
);
820 /* It is assured that ELT is always a string (i.e. fontname
826 /* Free fontset of FACE defined on frame F. Called from
827 free_realized_face. */
830 free_face_fontset (f
, face
)
836 fontset
= AREF (Vfontset_table
, face
->fontset
);
837 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
838 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
839 ASET (Vfontset_table
, face
->fontset
, Qnil
);
840 if (face
->fontset
< next_fontset_id
)
841 next_fontset_id
= face
->fontset
;
842 if (! NILP (FONTSET_DEFAULT (fontset
)))
844 int id
= XINT (FONTSET_ID (FONTSET_DEFAULT (fontset
)));
846 fontset
= AREF (Vfontset_table
, id
);
847 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
848 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
849 ASET (Vfontset_table
, id
, Qnil
);
850 if (id
< next_fontset_id
)
851 next_fontset_id
= face
->fontset
;
856 /* Return 1 iff FACE is suitable for displaying character C.
857 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
858 when C is not an ASCII character. */
861 face_suitable_for_char_p (face
, c
)
865 Lisp_Object fontset
, rfont_def
;
867 fontset
= FONTSET_FROM_ID (face
->fontset
);
868 rfont_def
= fontset_font (fontset
, c
, NULL
, -1);
869 return (VECTORP (rfont_def
)
870 && INTEGERP (AREF (rfont_def
, 0))
871 && face
->id
== XINT (AREF (rfont_def
, 0)));
875 /* Return ID of face suitable for displaying character C on frame F.
876 FACE must be reazlied for ASCII characters in advance. Called from
877 the macro FACE_FOR_CHAR. */
880 face_for_char (f
, face
, c
, pos
, object
)
886 Lisp_Object fontset
, charset
, rfont_def
;
890 if (ASCII_CHAR_P (c
))
891 return face
->ascii_face
->id
;
893 xassert (fontset_id_valid_p (face
->fontset
));
894 fontset
= FONTSET_FROM_ID (face
->fontset
);
895 xassert (!BASE_FONTSET_P (fontset
));
900 charset
= Fget_char_property (make_number (pos
), Qcharset
, object
);
903 else if (CHARSETP (charset
))
904 id
= XINT (CHARSET_SYMBOL_ID (charset
));
906 rfont_def
= fontset_font (fontset
, c
, face
, id
);
907 if (VECTORP (rfont_def
))
909 if (NILP (AREF (rfont_def
, 0)))
911 /* We have not yet made a realized face that uses this font. */
912 int font_idx
= XINT (AREF (rfont_def
, 1));
914 face_id
= lookup_non_ascii_face (f
, font_idx
, face
);
915 ASET (rfont_def
, 0, make_number (face_id
));
917 return XINT (AREF (rfont_def
, 0));
920 if (NILP (FONTSET_NOFONT_FACE (fontset
)))
922 face_id
= lookup_non_ascii_face (f
, -1, face
);
923 FONTSET_NOFONT_FACE (fontset
) = make_number (face_id
);
925 return XINT (FONTSET_NOFONT_FACE (fontset
));
929 /* Make a realized fontset for ASCII face FACE on frame F from the
930 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
931 default fontset as the base. Value is the id of the new fontset.
932 Called from realize_x_face. */
935 make_fontset_for_ascii_face (f
, base_fontset_id
, face
)
940 Lisp_Object base_fontset
, fontset
, frame
;
942 XSETFRAME (frame
, f
);
943 if (base_fontset_id
>= 0)
945 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
946 if (!BASE_FONTSET_P (base_fontset
))
947 base_fontset
= FONTSET_BASE (base_fontset
);
948 xassert (BASE_FONTSET_P (base_fontset
));
949 if (! BASE_FONTSET_P (base_fontset
))
953 base_fontset
= Vdefault_fontset
;
955 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
957 Lisp_Object elt
, rfont_def
;
959 elt
= FONTSET_REF (base_fontset
, 0);
960 xassert (VECTORP (elt
) && ASIZE (elt
) > 0);
961 rfont_def
= Fmake_vector (make_number (4), Qnil
);
962 ASET (rfont_def
, 0, make_number (face
->id
));
963 ASET (rfont_def
, 1, make_number (face
->font_info_id
));
964 ASET (rfont_def
, 2, AREF (elt
, 0));
965 ASET (rfont_def
, 3, build_string (face
->font_name
));
966 elt
= Fmake_vector (make_number (4), Qnil
);
967 ASET (elt
, 0, make_number (charset_ordered_list_tick
));
968 ASET (elt
, 1, make_number (charset_ascii
));
969 ASET (elt
, 2, rfont_def
);
970 ASET (elt
, 3, rfont_def
);
971 char_table_set_range (fontset
, 0, 127, elt
);
973 return XINT (FONTSET_ID (fontset
));
977 #if defined(WINDOWSNT) && defined (_MSC_VER)
978 #pragma optimize("", off)
981 /* Load a font named FONTNAME on frame F. Return a pointer to the
982 struct font_info of the loaded font. If loading fails, return
983 NULL. CHARSET is an ID of charset to encode characters for this
984 font. If it is -1, find one from Vfont_encoding_alist. */
987 fs_load_font (f
, fontname
, charset
)
992 struct font_info
*fontp
;
993 Lisp_Object fullname
;
996 /* No way to get fontname. */
999 fontp
= (*load_font_func
) (f
, fontname
, 0);
1000 if (! fontp
|| fontp
->charset
>= 0)
1003 fontname
= fontp
->full_name
;
1004 fullname
= build_string (fontp
->full_name
);
1008 Lisp_Object charset_symbol
;
1010 charset_symbol
= find_font_encoding (fullname
);
1011 if (CONSP (charset_symbol
))
1012 charset_symbol
= XCAR (charset_symbol
);
1013 charset
= XINT (CHARSET_SYMBOL_ID (charset_symbol
));
1015 fontp
->charset
= charset
;
1016 fontp
->vertical_centering
= 0;
1017 fontp
->font_encoder
= NULL
;
1019 if (charset
!= charset_ascii
)
1021 fontp
->vertical_centering
1022 = (STRINGP (Vvertical_centering_font_regexp
)
1023 && (fast_string_match_ignore_case
1024 (Vvertical_centering_font_regexp
, fullname
) >= 0));
1026 if (find_ccl_program_func
)
1027 (*find_ccl_program_func
) (fontp
);
1033 #if defined(WINDOWSNT) && defined (_MSC_VER)
1034 #pragma optimize("", on)
1038 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
1039 FONTNAME. ENCODING is a charset symbol that specifies the encoding
1040 of the font. REPERTORY is a charset symbol or nil. */
1044 find_font_encoding (fontname
)
1045 Lisp_Object fontname
;
1047 Lisp_Object tail
, elt
;
1049 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
1053 && STRINGP (XCAR (elt
))
1054 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
1055 && (SYMBOLP (XCDR (elt
))
1056 ? CHARSETP (XCDR (elt
))
1057 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
1058 return (XCDR (elt
));
1060 /* We don't know the encoding of this font. Let's assume `ascii'. */
1065 /* Cache data used by fontset_pattern_regexp. The car part is a
1066 pattern string containing at least one wild card, the cdr part is
1067 the corresponding regular expression. */
1068 static Lisp_Object Vcached_fontset_data
;
1070 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
1071 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1073 /* If fontset name PATTERN contains any wild card, return regular
1074 expression corresponding to PATTERN. */
1077 fontset_pattern_regexp (pattern
)
1078 Lisp_Object pattern
;
1080 if (!index (SDATA (pattern
), '*')
1081 && !index (SDATA (pattern
), '?'))
1082 /* PATTERN does not contain any wild cards. */
1085 if (!CONSP (Vcached_fontset_data
)
1086 || strcmp (SDATA (pattern
), CACHED_FONTSET_NAME
))
1088 /* We must at first update the cached data. */
1089 unsigned char *regex
, *p0
, *p1
;
1090 int ndashes
= 0, nstars
= 0;
1092 for (p0
= SDATA (pattern
); *p0
; p0
++)
1096 else if (*p0
== '*')
1100 /* If PATTERN is not full XLFD we conert "*" to ".*". Otherwise
1101 we convert "*" to "[^-]*" which is much faster in regular
1102 expression matching. */
1104 p1
= regex
= (unsigned char *) alloca (SBYTES (pattern
) + 2 * nstars
+ 1);
1106 p1
= regex
= (unsigned char *) alloca (SBYTES (pattern
) + 5 * nstars
+ 1);
1109 for (p0
= SDATA (pattern
); *p0
; p0
++)
1116 *p1
++ = '[', *p1
++ = '^', *p1
++ = '-', *p1
++ = ']';
1119 else if (*p0
== '?')
1127 Vcached_fontset_data
= Fcons (build_string (SDATA (pattern
)),
1128 build_string (regex
));
1131 return CACHED_FONTSET_REGEX
;
1134 /* Return ID of the base fontset named NAME. If there's no such
1135 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
1136 0: pattern containing '*' and '?' as wildcards
1137 1: regular expression
1138 2: literal fontset name
1142 fs_query_fontset (name
, name_pattern
)
1149 name
= Fdowncase (name
);
1150 if (name_pattern
!= 1)
1152 tem
= Frassoc (name
, Vfontset_alias_alist
);
1154 tem
= Fassoc (name
, Vfontset_alias_alist
);
1155 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1157 else if (name_pattern
== 0)
1159 tem
= fontset_pattern_regexp (name
);
1168 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1170 Lisp_Object fontset
, this_name
;
1172 fontset
= FONTSET_FROM_ID (i
);
1174 || !BASE_FONTSET_P (fontset
))
1177 this_name
= FONTSET_NAME (fontset
);
1178 if (name_pattern
== 1
1179 ? fast_string_match (name
, this_name
) >= 0
1180 : !strcmp (SDATA (name
), SDATA (this_name
)))
1187 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
1188 doc
: /* Return the name of a fontset that matches PATTERN.
1189 The value is nil if there is no matching fontset.
1190 PATTERN can contain `*' or `?' as a wildcard
1191 just as X font name matching algorithm allows.
1192 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1194 Lisp_Object pattern
, regexpp
;
1196 Lisp_Object fontset
;
1199 (*check_window_system_func
) ();
1201 CHECK_STRING (pattern
);
1203 if (SCHARS (pattern
) == 0)
1206 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
1210 fontset
= FONTSET_FROM_ID (id
);
1211 return FONTSET_NAME (fontset
);
1214 /* Return a list of base fontset names matching PATTERN on frame F. */
1217 list_fontsets (f
, pattern
, size
)
1219 Lisp_Object pattern
;
1222 Lisp_Object frame
, regexp
, val
;
1225 XSETFRAME (frame
, f
);
1227 regexp
= fontset_pattern_regexp (pattern
);
1230 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1232 Lisp_Object fontset
, name
;
1234 fontset
= FONTSET_FROM_ID (id
);
1236 || !BASE_FONTSET_P (fontset
)
1237 || !EQ (frame
, FONTSET_FRAME (fontset
)))
1239 name
= FONTSET_NAME (fontset
);
1241 if (STRINGP (regexp
)
1242 ? (fast_string_match (regexp
, name
) < 0)
1243 : strcmp (SDATA (pattern
), SDATA (name
)))
1246 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
1253 /* Free all realized fontsets whose base fontset is BASE. */
1256 free_realized_fontsets (base
)
1262 /* For the moment, this doesn't work because free_realized_face
1263 doesn't remove FACE from a cache. Until we find a solution, we
1264 suppress this code, and simply use Fclear_face_cache even though
1265 that is not efficient. */
1267 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1269 Lisp_Object
this = AREF (Vfontset_table
, id
);
1271 if (EQ (FONTSET_BASE (this), base
))
1275 for (tail
= FONTSET_FACE_ALIST (this); CONSP (tail
);
1278 FRAME_PTR f
= XFRAME (FONTSET_FRAME (this));
1279 int face_id
= XINT (XCDR (XCAR (tail
)));
1280 struct face
*face
= FACE_FROM_ID (f
, face_id
);
1282 /* Face THIS itself is also freed by the following call. */
1283 free_realized_face (f
, face
);
1289 Fclear_face_cache (Qt
);
1294 /* Check validity of NAME as a fontset name and return the
1295 corresponding fontset. If not valid, signal an error.
1296 If NAME is t, return Vdefault_fontset. */
1299 check_fontset_name (name
)
1305 return Vdefault_fontset
;
1307 CHECK_STRING (name
);
1308 /* First try NAME as literal. */
1309 id
= fs_query_fontset (name
, 2);
1311 /* For backward compatibility, try again NAME as pattern. */
1312 id
= fs_query_fontset (name
, 0);
1314 error ("Fontset `%s' does not exist", SDATA (name
));
1315 return FONTSET_FROM_ID (id
);
1319 accumulate_script_ranges (arg
, range
, val
)
1320 Lisp_Object arg
, range
, val
;
1322 if (EQ (XCAR (arg
), val
))
1325 XSETCDR (arg
, Fcons (Fcons (XCAR (range
), XCDR (range
)), XCDR (arg
)));
1327 XSETCDR (arg
, Fcons (Fcons (range
, range
), XCDR (arg
)));
1332 /* Return an ASCII font name generated from fontset name NAME and
1333 ASCII font specification ASCII_SPEC. NAME is a string conforming
1334 to XLFD. ASCII_SPEC is a vector:
1335 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
1337 static INLINE Lisp_Object
1338 generate_ascii_font_name (name
, ascii_spec
)
1339 Lisp_Object name
, ascii_spec
;
1344 vec
= split_font_name_into_vector (name
);
1345 for (i
= FONT_SPEC_FAMILY_INDEX
; i
<= FONT_SPEC_ADSTYLE_INDEX
; i
++)
1346 if (! NILP (AREF (ascii_spec
, i
)))
1347 ASET (vec
, 1 + i
, AREF (ascii_spec
, i
));
1348 if (! NILP (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
)))
1349 ASET (vec
, 12, AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
1350 return build_font_name_from_vector (vec
);
1353 /* Variables referred in set_fontset_font. They are set before
1354 map_charset_chars is called in Fset_fontset_font. */
1355 static Lisp_Object font_def_arg
, add_arg
;
1356 static int from_arg
, to_arg
;
1358 /* Callback function for map_charset_chars in Fset_fontset_font. In
1359 FONTSET, set font_def_arg in a fashion specified by add_arg for
1360 characters in RANGE while ignoring the range between from_arg and
1364 set_fontset_font (fontset
, range
)
1365 Lisp_Object fontset
, range
;
1367 if (from_arg
< to_arg
)
1369 int from
= XINT (XCAR (range
)), to
= XINT (XCDR (range
));
1371 if (from
< from_arg
)
1377 range2
= Fcons (make_number (to_arg
), XCDR (range
));
1378 FONTSET_ADD (fontset
, range
, font_def_arg
, add_arg
);
1382 range
= Fcons (XCAR (range
), make_number (from_arg
));
1384 else if (to
<= to_arg
)
1389 range
= Fcons (make_number (to_arg
), XCDR (range
));
1392 FONTSET_ADD (fontset
, range
, font_def_arg
, add_arg
);
1396 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 5, 0,
1398 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1400 TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
1401 In that case, use FONT-SPEC for all characters in the range FROM and
1404 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1405 all characters that belong to the script.
1407 TARGET may be a charset. In that case, use FONT-SPEC for all
1408 characters in the charset.
1410 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1411 that no FONT-SPEC is specified.
1413 FONT-SPEC may one of these:
1414 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1415 REGISTRY is a font registry name. FAMILY may contains foundry
1416 name, and REGISTRY may contains encoding name.
1417 * A font name string.
1419 Optional 4th argument FRAME, if non-nil, is a frame. This argument is
1420 kept for backward compatibility and has no meaning.
1422 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1423 to the font specifications for TARGET previously set. If it is
1424 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1425 appended. By default, FONT-SPEC overrides the previous settings. */)
1426 (name
, target
, font_spec
, frame
, add
)
1427 Lisp_Object name
, target
, font_spec
, frame
, add
;
1429 Lisp_Object fontset
;
1430 Lisp_Object font_def
, registry
, family
;
1431 Lisp_Object encoding
, repertory
;
1432 Lisp_Object range_list
;
1433 struct charset
*charset
= NULL
;
1435 fontset
= check_fontset_name (name
);
1437 /* The arg FRAME is kept for backward compatibility. We only check
1440 CHECK_LIVE_FRAME (frame
);
1442 if (VECTORP (font_spec
))
1444 /* FONT_SPEC should have this form:
1445 [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ]
1446 This is a feature not yet documented because WEIGHT thru
1447 ADSTYLE are ignored for the moment. */
1450 if (ASIZE (font_spec
) != FONT_SPEC_MAX_INDEX
)
1451 args_out_of_range (make_number (FONT_SPEC_MAX_INDEX
),
1452 make_number (ASIZE (font_spec
)));
1454 font_spec
= Fcopy_sequence (font_spec
);
1455 for (j
= 0; j
< FONT_SPEC_MAX_INDEX
- 1; j
++)
1456 if (! NILP (AREF (font_spec
, j
)))
1458 CHECK_STRING (AREF (font_spec
, j
));
1459 ASET (font_spec
, j
, Fdowncase (AREF (font_spec
, j
)));
1461 family
= AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
);
1462 /* REGISTRY should not be omitted. */
1463 CHECK_STRING (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1464 registry
= AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
);
1466 else if (CONSP (font_spec
))
1468 family
= XCAR (font_spec
);
1469 registry
= XCDR (font_spec
);
1471 if (! NILP (family
))
1473 CHECK_STRING (family
);
1474 family
= Fdowncase (family
);
1476 CHECK_STRING (registry
);
1477 registry
= Fdowncase (registry
);
1478 font_spec
= Fmake_vector (make_number (FONT_SPEC_MAX_INDEX
), Qnil
);
1479 ASET (font_spec
, FONT_SPEC_FAMILY_INDEX
, family
);
1480 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1484 CHECK_STRING (font_spec
);
1485 font_spec
= Fdowncase (font_spec
);
1488 if (STRINGP (font_spec
))
1489 encoding
= find_font_encoding (font_spec
);
1491 encoding
= find_font_encoding (concat2 (family
, registry
));
1492 if (SYMBOLP (encoding
))
1494 CHECK_CHARSET (encoding
);
1495 encoding
= repertory
= CHARSET_SYMBOL_ID (encoding
);
1499 repertory
= XCDR (encoding
);
1500 encoding
= XCAR (encoding
);
1501 CHECK_CHARSET (encoding
);
1502 encoding
= CHARSET_SYMBOL_ID (encoding
);
1503 if (! NILP (repertory
) && SYMBOLP (repertory
))
1505 CHECK_CHARSET (repertory
);
1506 repertory
= CHARSET_SYMBOL_ID (repertory
);
1509 font_def
= Fmake_vector (make_number (3), font_spec
);
1510 ASET (font_def
, 1, encoding
);
1511 ASET (font_def
, 2, repertory
);
1513 if (CHARACTERP (target
))
1514 range_list
= Fcons (Fcons (target
, target
), Qnil
);
1515 else if (CONSP (target
))
1517 Lisp_Object from
, to
;
1519 from
= Fcar (target
);
1521 CHECK_CHARACTER (from
);
1522 CHECK_CHARACTER (to
);
1523 range_list
= Fcons (target
, Qnil
);
1525 else if (SYMBOLP (target
) && !NILP (target
))
1527 Lisp_Object script_list
;
1531 script_list
= XCHAR_TABLE (Vchar_script_table
)->extras
[0];
1532 if (! NILP (Fmemq (target
, script_list
)))
1534 val
= Fcons (target
, Qnil
);
1535 map_char_table (accumulate_script_ranges
, Qnil
, Vchar_script_table
,
1537 range_list
= XCDR (val
);
1539 if (CHARSETP (target
))
1541 if (EQ (target
, Qascii
))
1543 if (VECTORP (font_spec
))
1544 font_spec
= generate_ascii_font_name (FONTSET_NAME (fontset
),
1546 FONTSET_ASCII (fontset
) = font_spec
;
1547 range_list
= Fcons (Fcons (make_number (0), make_number (127)),
1552 CHECK_CHARSET_GET_CHARSET (target
, charset
);
1555 else if (NILP (range_list
))
1556 error ("Invalid script or charset name: %s",
1557 SDATA (SYMBOL_NAME (target
)));
1559 else if (NILP (target
))
1560 range_list
= Fcons (Qnil
, Qnil
);
1562 error ("Invalid target for setting a font");
1567 font_def_arg
= font_def
;
1569 if (NILP (range_list
))
1570 from_arg
= to_arg
= 0;
1572 from_arg
= XINT (XCAR (XCAR (range_list
))),
1573 to_arg
= XINT (XCDR (XCAR (range_list
)));
1575 map_charset_chars (set_fontset_font
, Qnil
, fontset
, charset
,
1576 CHARSET_MIN_CODE (charset
),
1577 CHARSET_MAX_CODE (charset
));
1579 for (; CONSP (range_list
); range_list
= XCDR (range_list
))
1580 FONTSET_ADD (fontset
, XCAR (range_list
), font_def
, add
);
1582 /* Free all realized fontsets whose base is FONTSET. This way, the
1583 specified character(s) are surely redisplayed by a correct
1585 free_realized_fontsets (fontset
);
1591 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
1592 doc
: /* Create a new fontset NAME from font information in FONTLIST.
1594 FONTLIST is an alist of scripts vs the corresponding font specification list.
1595 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1596 character of SCRIPT is displayed by a font that matches one of
1599 SCRIPT is a symbol that appears in the first extra slot of the
1600 char-table `char-script-table'.
1602 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1603 `set-fontset-font' for the meaning. */)
1605 Lisp_Object name
, fontlist
;
1607 Lisp_Object fontset
;
1611 CHECK_STRING (name
);
1612 CHECK_LIST (fontlist
);
1614 id
= fs_query_fontset (name
, 0);
1617 name
= Fdowncase (name
);
1618 val
= split_font_name_into_vector (name
);
1619 if (NILP (val
) || NILP (AREF (val
, 12)) || NILP (AREF (val
, 13)))
1620 error ("Fontset name must be in XLFD format");
1621 if (strcmp (SDATA (AREF (val
, 12)), "fontset"))
1622 error ("Registry field of fontset name must be \"fontset\"");
1623 Vfontset_alias_alist
1624 = Fcons (Fcons (name
,
1625 concat2 (concat2 (AREF (val
, 12), build_string ("-")),
1627 Vfontset_alias_alist
);
1628 ASET (val
, 12, build_string ("iso8859-1"));
1629 fontset
= make_fontset (Qnil
, name
, Qnil
);
1630 FONTSET_ASCII (fontset
) = build_font_name_from_vector (val
);
1634 fontset
= FONTSET_FROM_ID (id
);;
1635 free_realized_fontsets (fontset
);
1636 Fset_char_table_range (fontset
, Qt
, Qnil
);
1639 for (; ! NILP (fontlist
); fontlist
= Fcdr (fontlist
))
1641 Lisp_Object elt
, script
;
1643 elt
= Fcar (fontlist
);
1644 script
= Fcar (elt
);
1646 if (CONSP (elt
) && (NILP (XCDR (elt
)) || CONSP (XCDR (elt
))))
1647 for (; CONSP (elt
); elt
= XCDR (elt
))
1648 Fset_fontset_font (name
, script
, XCAR (elt
), Qnil
, Qappend
);
1650 Fset_fontset_font (name
, script
, elt
, Qnil
, Qappend
);
1656 /* Alist of automatically created fontsets. Each element is a cons
1657 (FONTNAME . FONTSET-ID). */
1658 static Lisp_Object auto_fontset_alist
;
1661 new_fontset_from_font_name (Lisp_Object fontname
)
1668 fontname
= Fdowncase (fontname
);
1669 val
= Fassoc (fontname
, auto_fontset_alist
);
1671 return XINT (XCDR (val
));
1673 vec
= split_font_name_into_vector (fontname
);
1675 vec
= Fmake_vector (make_number (14), build_string (""));
1676 ASET (vec
, 12, build_string ("fontset"));
1677 if (NILP (auto_fontset_alist
))
1679 ASET (vec
, 13, build_string ("startup"));
1680 name
= build_font_name_from_vector (vec
);
1685 int len
= XINT (Flength (auto_fontset_alist
));
1687 sprintf (temp
, "auto%d", len
);
1688 ASET (vec
, 13, build_string (temp
));
1689 name
= build_font_name_from_vector (vec
);
1691 name
= Fnew_fontset (name
, list2 (list2 (Qascii
, fontname
),
1692 list2 (Fcons (make_number (0),
1693 make_number (MAX_CHAR
)),
1695 id
= fs_query_fontset (name
, 0);
1697 = Fcons (Fcons (fontname
, make_number (id
)), auto_fontset_alist
);
1702 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1703 doc
: /* Return information about a font named NAME on frame FRAME.
1704 If FRAME is omitted or nil, use the selected frame.
1705 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1706 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1708 OPENED-NAME is the name used for opening the font,
1709 FULL-NAME is the full name of the font,
1710 SIZE is the maximum bound width of the font,
1711 HEIGHT is the height of the font,
1712 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1713 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1714 how to compose characters.
1715 If the named font is not yet loaded, return nil. */)
1717 Lisp_Object name
, frame
;
1720 struct font_info
*fontp
;
1723 (*check_window_system_func
) ();
1725 CHECK_STRING (name
);
1726 name
= Fdowncase (name
);
1728 frame
= selected_frame
;
1729 CHECK_LIVE_FRAME (frame
);
1732 if (!query_font_func
)
1733 error ("Font query function is not supported");
1735 fontp
= (*query_font_func
) (f
, SDATA (name
));
1739 info
= Fmake_vector (make_number (7), Qnil
);
1741 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1742 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1743 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1744 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1745 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1746 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1747 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1753 /* Return a cons (FONT-NAME . GLYPH-CODE).
1754 FONT-NAME is the font name for the character at POSITION in the current
1755 buffer. This is computed from all the text properties and overlays
1756 that apply to POSITION. POSTION may be nil, in which case,
1757 FONT-NAME is the font name for display the character CH with the
1760 GLYPH-CODE is the glyph code in the font to use for the character.
1762 If the 2nd optional arg CH is non-nil, it is a character to check
1763 the font instead of the character at POSITION.
1765 It returns nil in the following cases:
1767 (1) The window system doesn't have a font for the character (thus
1768 it is displayed by an empty box).
1770 (2) The character code is invalid.
1772 (3) If POSITION is not nil, and the current buffer is not displayed
1775 In addition, the returned font name may not take into account of
1776 such redisplay engine hooks as what used in jit-lock-mode if
1777 POSITION is currently not visible. */
1780 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 2, 0,
1781 doc
: /* For internal use only. */)
1783 Lisp_Object position
, ch
;
1785 int pos
, pos_byte
, dummy
;
1790 Lisp_Object charset
, rfont_def
;
1793 if (NILP (position
))
1795 CHECK_CHARACTER (ch
);
1797 f
= XFRAME (selected_frame
);
1798 face_id
= DEFAULT_FACE_ID
;
1806 CHECK_NUMBER_COERCE_MARKER (position
);
1807 pos
= XINT (position
);
1808 if (pos
< BEGV
|| pos
>= ZV
)
1809 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1810 pos_byte
= CHAR_TO_BYTE (pos
);
1812 c
= FETCH_CHAR (pos_byte
);
1818 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1821 w
= XWINDOW (window
);
1822 f
= XFRAME (w
->frame
);
1823 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1825 if (! CHAR_VALID_P (c
, 0))
1827 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
, pos
, Qnil
);
1828 face
= FACE_FROM_ID (f
, face_id
);
1829 charset
= Fget_char_property (position
, Qcharset
, Qnil
);
1830 if (CHARSETP (charset
))
1831 id
= XINT (CHARSET_SYMBOL_ID (charset
));
1834 rfont_def
= fontset_font (FONTSET_FROM_ID (face
->fontset
), c
, face
, id
);
1835 if (VECTORP (rfont_def
) && STRINGP (AREF (rfont_def
, 3)))
1837 Lisp_Object font_def
;
1838 struct font_info
*fontp
;
1839 struct charset
*charset
;
1843 font_def
= AREF (rfont_def
, 2);
1844 charset
= CHARSET_FROM_ID (XINT (AREF (font_def
, 1)));
1845 code
= ENCODE_CHAR (charset
, c
);
1846 if (code
== CHARSET_INVALID_CODE (charset
))
1847 return (Fcons (AREF (rfont_def
, 3), Qnil
));
1848 STORE_XCHAR2B (&char2b
, ((code
>> 8) & 0xFF), (code
& 0xFF));
1849 fontp
= (*get_font_info_func
) (f
, XINT (AREF (rfont_def
, 1)));
1850 rif
->encode_char (c
, &char2b
, fontp
, charset
, NULL
);
1851 code
= (XCHAR2B_BYTE1 (&char2b
) << 8) | XCHAR2B_BYTE2 (&char2b
);
1852 return (Fcons (AREF (rfont_def
, 3), make_number (code
)));
1858 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1859 doc
: /* Return information about a fontset FONTSET on frame FRAME.
1860 The value is a char-table of which elements has this form.
1862 ((FONT-PATTERN OPENED-FONT ...) ...)
1864 FONT-PATTERN is a vector:
1866 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
1868 or a string of font name pattern.
1870 OPENED-FONT is a name of a font actually opened.
1872 The char-table has one extra slot. The value is a char-table
1873 containing the information about the derived fonts from the default
1874 fontset. The format is the same as abobe. */)
1876 Lisp_Object fontset
, frame
;
1879 Lisp_Object
*realized
[2], fontsets
[2], tables
[2];
1880 Lisp_Object val
, elt
;
1883 (*check_window_system_func
) ();
1885 fontset
= check_fontset_name (fontset
);
1888 frame
= selected_frame
;
1889 CHECK_LIVE_FRAME (frame
);
1892 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1893 in the table `realized'. */
1894 realized
[0] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1895 * ASIZE (Vfontset_table
));
1896 for (i
= j
= 0; i
< ASIZE (Vfontset_table
); i
++)
1898 elt
= FONTSET_FROM_ID (i
);
1900 && EQ (FONTSET_BASE (elt
), fontset
)
1901 && EQ (FONTSET_FRAME (elt
), frame
))
1902 realized
[0][j
++] = elt
;
1904 realized
[0][j
] = Qnil
;
1906 realized
[1] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1907 * ASIZE (Vfontset_table
));
1908 for (i
= j
= 0; ! NILP (realized
[0][i
]); i
++)
1910 elt
= FONTSET_DEFAULT (realized
[0][i
]);
1912 realized
[1][j
++] = elt
;
1914 realized
[1][j
] = Qnil
;
1916 tables
[0] = Fmake_char_table (Qfontset_info
, Qnil
);
1917 tables
[1] = Fmake_char_table (Qnil
, Qnil
);
1918 XCHAR_TABLE (tables
[0])->extras
[0] = tables
[1];
1919 fontsets
[0] = fontset
;
1920 fontsets
[1] = Vdefault_fontset
;
1922 /* Accumulate information of the fontset in TABLE. The format of
1923 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1924 for (k
= 0; k
<= 1; k
++)
1926 for (c
= 0; c
<= MAX_CHAR
; )
1930 if (c
<= MAX_5_BYTE_CHAR
)
1932 val
= char_table_ref_and_range (fontsets
[k
], c
, &from
, &to
);
1933 if (to
> MAX_5_BYTE_CHAR
)
1934 to
= MAX_5_BYTE_CHAR
;
1938 val
= FONTSET_FALLBACK (fontsets
[k
]);
1945 /* At first, set ALIST to ((FONT-SPEC) ...). */
1946 for (alist
= Qnil
, i
= 0; i
< ASIZE (val
); i
++)
1947 alist
= Fcons (Fcons (AREF (AREF (val
, i
), 0), Qnil
), alist
);
1948 alist
= Fnreverse (alist
);
1950 /* Then store opend font names to cdr of each elements. */
1951 for (i
= 0; ! NILP (realized
[k
][i
]); i
++)
1953 if (c
<= MAX_5_BYTE_CHAR
)
1954 val
= FONTSET_REF (realized
[k
][i
], c
);
1956 val
= FONTSET_FALLBACK (realized
[k
][i
]);
1957 if (! VECTORP (val
))
1959 /* VAL is [int int ?
1960 [FACE-ID FONT-INDEX FONT-DEF FONT-NAME] ...].
1961 If a font of an element is already opened,
1962 FONT-NAME is the name of a opened font. */
1963 for (j
= 3; j
< ASIZE (val
); j
++)
1964 if (STRINGP (AREF (AREF (val
, j
), 3)))
1966 Lisp_Object font_idx
;
1968 font_idx
= AREF (AREF (val
, j
), 1);
1969 elt
= Fassq (AREF (AREF (AREF (val
, j
), 2), 0), alist
);
1971 && NILP (Fmemq (font_idx
, XCDR(elt
))))
1972 nconc2 (elt
, Fcons (font_idx
, Qnil
));
1975 for (val
= alist
; CONSP (val
); val
= XCDR (val
))
1976 for (elt
= XCDR (XCAR (val
)); CONSP (elt
); elt
= XCDR (elt
))
1978 struct font_info
*font_info
1979 = (*get_font_info_func
) (f
, XINT (XCAR (elt
)));
1980 XSETCAR (elt
, build_string (font_info
->full_name
));
1983 /* Store ALIST in TBL for characters C..TO. */
1984 if (c
<= MAX_5_BYTE_CHAR
)
1985 char_table_set_range (tables
[k
], c
, to
, alist
);
1987 XCHAR_TABLE (tables
[k
])->defalt
= alist
;
1997 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 3, 0,
1998 doc
: /* Return a font name pattern for character CH in fontset NAME.
1999 If NAME is t, find a pattern in the default fontset.
2001 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
2002 family name and REGISTRY is a font registry name. This is actually
2003 the first font name pattern for CH in the fontset or in the default
2006 If the 2nd optional arg ALL is non-nil, return a list of all font name
2009 Lisp_Object name
, ch
, all
;
2012 Lisp_Object fontset
, elt
, list
, repertory
, val
;
2015 fontset
= check_fontset_name (name
);
2017 CHECK_CHARACTER (ch
);
2022 for (i
= 0, elt
= FONTSET_REF (fontset
, c
); i
< 2;
2023 i
++, elt
= FONTSET_FALLBACK (fontset
))
2025 for (j
= 0; j
< ASIZE (elt
); j
++)
2027 val
= AREF (elt
, j
);
2028 repertory
= AREF (val
, 1);
2029 if (INTEGERP (repertory
))
2031 struct charset
*charset
= CHARSET_FROM_ID (XINT (repertory
));
2033 if (! CHAR_CHARSET_P (c
, charset
))
2036 else if (CHAR_TABLE_P (repertory
))
2038 if (NILP (CHAR_TABLE_REF (repertory
, c
)))
2041 val
= AREF (val
, 0);
2042 val
= Fcons (AREF (val
, 0), AREF (val
, 5));
2045 list
= Fcons (val
, list
);
2047 if (EQ (fontset
, Vdefault_fontset
))
2049 fontset
= Vdefault_fontset
;
2051 return (Fnreverse (list
));
2054 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
2055 doc
: /* Return a list of all defined fontset names. */)
2058 Lisp_Object fontset
, list
;
2062 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
2064 fontset
= FONTSET_FROM_ID (i
);
2066 && BASE_FONTSET_P (fontset
))
2067 list
= Fcons (FONTSET_NAME (fontset
), list
);
2074 #ifdef FONTSET_DEBUG
2077 dump_fontset (fontset
)
2078 Lisp_Object fontset
;
2082 vec
= Fmake_vector (make_number (3), Qnil
);
2083 ASET (vec
, 0, FONTSET_ID (fontset
));
2085 if (BASE_FONTSET_P (fontset
))
2087 ASET (vec
, 1, FONTSET_NAME (fontset
));
2093 frame
= FONTSET_FRAME (fontset
);
2096 FRAME_PTR f
= XFRAME (frame
);
2098 if (FRAME_LIVE_P (f
))
2099 ASET (vec
, 1, f
->name
);
2103 if (!NILP (FONTSET_DEFAULT (fontset
)))
2104 ASET (vec
, 2, FONTSET_ID (FONTSET_DEFAULT (fontset
)));
2109 DEFUN ("fontset-list-all", Ffontset_list_all
, Sfontset_list_all
, 0, 0, 0,
2110 doc
: /* Return a brief summary of all fontsets for debug use. */)
2116 for (i
= 0, val
= Qnil
; i
< ASIZE (Vfontset_table
); i
++)
2117 if (! NILP (AREF (Vfontset_table
, i
)))
2118 val
= Fcons (dump_fontset (AREF (Vfontset_table
, i
)), val
);
2119 return (Fnreverse (val
));
2121 #endif /* FONTSET_DEBUG */
2126 if (!load_font_func
)
2127 /* Window system initializer should have set proper functions. */
2130 DEFSYM (Qfontset
, "fontset");
2131 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (9));
2132 DEFSYM (Qfontset_info
, "fontset-info");
2133 Fput (Qfontset_info
, Qchar_table_extra_slots
, make_number (1));
2135 DEFSYM (Qprepend
, "prepend");
2136 DEFSYM (Qappend
, "append");
2138 Vcached_fontset_data
= Qnil
;
2139 staticpro (&Vcached_fontset_data
);
2141 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
2142 staticpro (&Vfontset_table
);
2144 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
2145 staticpro (&Vdefault_fontset
);
2146 FONTSET_ID (Vdefault_fontset
) = make_number (0);
2147 FONTSET_NAME (Vdefault_fontset
)
2148 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
2149 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
2150 next_fontset_id
= 1;
2152 auto_fontset_alist
= Qnil
;
2153 staticpro (&auto_fontset_alist
);
2155 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
2157 Alist of fontname patterns vs the corresponding encoding and repertory info.
2158 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
2159 where ENCODING is a charset or a char-table,
2160 and REPERTORY is a charset, a char-table, or nil.
2162 ENCODING is for converting a character to a glyph code of the font.
2163 If ENCODING is a charset, encoding a character by the charset gives
2164 the corresponding glyph code. If ENCODING is a char-table, looking up
2165 the table by a character gives the corresponding glyph code.
2167 REPERTORY specifies a repertory of characters supported by the font.
2168 If REPERTORY is a charset, all characters beloging to the charset are
2169 supported. If REPERTORY is a char-table, all characters who have a
2170 non-nil value in the table are supported. It REPERTORY is nil, Emacs
2171 gets the repertory information by an opened font and ENCODING. */);
2172 Vfont_encoding_alist
= Qnil
;
2174 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
2176 Char table of characters whose ascent values should be ignored.
2177 If an entry for a character is non-nil, the ascent value of the glyph
2178 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
2180 This affects how a composite character which contains
2181 such a character is displayed on screen. */);
2182 Vuse_default_ascent
= Qnil
;
2184 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
2186 Char table of characters which is not composed relatively.
2187 If an entry for a character is non-nil, a composition sequence
2188 which contains that character is displayed so that
2189 the glyph of that character is put without considering
2190 an ascent and descent value of a previous character. */);
2191 Vignore_relative_composition
= Qnil
;
2193 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
2194 doc
: /* Alist of fontname vs list of the alternate fontnames.
2195 When a specified font name is not found, the corresponding
2196 alternate fontnames (if any) are tried instead. */);
2197 Valternate_fontname_alist
= Qnil
;
2199 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
2200 doc
: /* Alist of fontset names vs the aliases. */);
2201 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
2202 build_string ("fontset-default")),
2205 DEFVAR_LISP ("vertical-centering-font-regexp",
2206 &Vvertical_centering_font_regexp
,
2207 doc
: /* *Regexp matching font names that require vertical centering on display.
2208 When a character is displayed with such fonts, the character is displayed
2209 at the vertical center of lines. */);
2210 Vvertical_centering_font_regexp
= Qnil
;
2212 defsubr (&Squery_fontset
);
2213 defsubr (&Snew_fontset
);
2214 defsubr (&Sset_fontset_font
);
2215 defsubr (&Sfont_info
);
2216 defsubr (&Sinternal_char_font
);
2217 defsubr (&Sfontset_info
);
2218 defsubr (&Sfontset_font
);
2219 defsubr (&Sfontset_list
);
2220 #ifdef FONTSET_DEBUG
2221 defsubr (&Sfontset_list_all
);
2225 /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
2226 (do not change this comment) */