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_ ((Lisp_Object
));
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
;
976 Lisp_Object fullname
;
979 /* No way to get fontname. */
982 fontp
= (*load_font_func
) (f
, fontname
, 0);
983 if (! fontp
|| fontp
->charset
>= 0)
986 fontname
= fontp
->full_name
;
987 fullname
= build_string (fontp
->full_name
);
991 Lisp_Object charset_symbol
;
993 charset_symbol
= find_font_encoding (fullname
);
994 if (CONSP (charset_symbol
))
995 charset_symbol
= XCAR (charset_symbol
);
996 charset
= XINT (CHARSET_SYMBOL_ID (charset_symbol
));
998 fontp
->charset
= charset
;
999 fontp
->vertical_centering
= 0;
1000 fontp
->font_encoder
= NULL
;
1002 if (charset
!= charset_ascii
)
1004 fontp
->vertical_centering
1005 = (STRINGP (Vvertical_centering_font_regexp
)
1006 && (fast_string_match_ignore_case
1007 (Vvertical_centering_font_regexp
, fullname
) >= 0));
1009 if (find_ccl_program_func
)
1010 (*find_ccl_program_func
) (fontp
);
1016 #if defined(WINDOWSNT) && defined (_MSC_VER)
1017 #pragma optimize("", on)
1021 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
1022 FONTNAME. ENCODING is a charset symbol that specifies the encoding
1023 of the font. REPERTORY is a charset symbol or nil. */
1027 find_font_encoding (fontname
)
1028 Lisp_Object fontname
;
1030 Lisp_Object tail
, elt
;
1032 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
1036 && STRINGP (XCAR (elt
))
1037 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
1038 && (SYMBOLP (XCDR (elt
))
1039 ? CHARSETP (XCDR (elt
))
1040 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
1041 return (XCDR (elt
));
1043 /* We don't know the encoding of this font. Let's assume `ascii'. */
1048 /* Cache data used by fontset_pattern_regexp. The car part is a
1049 pattern string containing at least one wild card, the cdr part is
1050 the corresponding regular expression. */
1051 static Lisp_Object Vcached_fontset_data
;
1053 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
1054 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1056 /* If fontset name PATTERN contains any wild card, return regular
1057 expression corresponding to PATTERN. */
1060 fontset_pattern_regexp (pattern
)
1061 Lisp_Object pattern
;
1063 if (!index (SDATA (pattern
), '*')
1064 && !index (SDATA (pattern
), '?'))
1065 /* PATTERN does not contain any wild cards. */
1068 if (!CONSP (Vcached_fontset_data
)
1069 || strcmp (SDATA (pattern
), CACHED_FONTSET_NAME
))
1071 /* We must at first update the cached data. */
1072 unsigned char *regex
, *p0
, *p1
;
1073 int ndashes
= 0, nstars
= 0;
1075 for (p0
= SDATA (pattern
); *p0
; p0
++)
1079 else if (*p0
== '*')
1083 /* If PATTERN is not full XLFD we conert "*" to ".*". Otherwise
1084 we convert "*" to "[^-]*" which is much faster in regular
1085 expression matching. */
1087 p1
= regex
= (unsigned char *) alloca (SBYTES (pattern
) + 2 * nstars
+ 1);
1089 p1
= regex
= (unsigned char *) alloca (SBYTES (pattern
) + 5 * nstars
+ 1);
1092 for (p0
= SDATA (pattern
); *p0
; p0
++)
1099 *p1
++ = '[', *p1
++ = '^', *p1
++ = '-', *p1
++ = ']';
1102 else if (*p0
== '?')
1110 Vcached_fontset_data
= Fcons (build_string (SDATA (pattern
)),
1111 build_string (regex
));
1114 return CACHED_FONTSET_REGEX
;
1117 /* Return ID of the base fontset named NAME. If there's no such
1118 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
1119 0: pattern containing '*' and '?' as wildcards
1120 1: regular expression
1121 2: literal fontset name
1125 fs_query_fontset (name
, name_pattern
)
1132 name
= Fdowncase (name
);
1133 if (name_pattern
!= 1)
1135 tem
= Frassoc (name
, Vfontset_alias_alist
);
1137 tem
= Fassoc (name
, Vfontset_alias_alist
);
1138 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1140 else if (name_pattern
== 0)
1142 tem
= fontset_pattern_regexp (name
);
1151 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1153 Lisp_Object fontset
, this_name
;
1155 fontset
= FONTSET_FROM_ID (i
);
1157 || !BASE_FONTSET_P (fontset
))
1160 this_name
= FONTSET_NAME (fontset
);
1161 if (name_pattern
== 1
1162 ? fast_string_match (name
, this_name
) >= 0
1163 : !strcmp (SDATA (name
), SDATA (this_name
)))
1170 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
1171 doc
: /* Return the name of a fontset that matches PATTERN.
1172 The value is nil if there is no matching fontset.
1173 PATTERN can contain `*' or `?' as a wildcard
1174 just as X font name matching algorithm allows.
1175 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1177 Lisp_Object pattern
, regexpp
;
1179 Lisp_Object fontset
;
1182 (*check_window_system_func
) ();
1184 CHECK_STRING (pattern
);
1186 if (SCHARS (pattern
) == 0)
1189 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
1193 fontset
= FONTSET_FROM_ID (id
);
1194 return FONTSET_NAME (fontset
);
1197 /* Return a list of base fontset names matching PATTERN on frame F. */
1200 list_fontsets (f
, pattern
, size
)
1202 Lisp_Object pattern
;
1205 Lisp_Object frame
, regexp
, val
;
1208 XSETFRAME (frame
, f
);
1210 regexp
= fontset_pattern_regexp (pattern
);
1213 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1215 Lisp_Object fontset
, name
;
1217 fontset
= FONTSET_FROM_ID (id
);
1219 || !BASE_FONTSET_P (fontset
)
1220 || !EQ (frame
, FONTSET_FRAME (fontset
)))
1222 name
= FONTSET_NAME (fontset
);
1224 if (STRINGP (regexp
)
1225 ? (fast_string_match (regexp
, name
) < 0)
1226 : strcmp (SDATA (pattern
), SDATA (name
)))
1229 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
1236 /* Free all realized fontsets whose base fontset is BASE. */
1239 free_realized_fontsets (base
)
1245 /* For the moment, this doesn't work because free_realized_face
1246 doesn't remove FACE from a cache. Until we find a solution, we
1247 suppress this code, and simply use Fclear_face_cache even though
1248 that is not efficient. */
1250 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1252 Lisp_Object
this = AREF (Vfontset_table
, id
);
1254 if (EQ (FONTSET_BASE (this), base
))
1258 for (tail
= FONTSET_FACE_ALIST (this); CONSP (tail
);
1261 FRAME_PTR f
= XFRAME (FONTSET_FRAME (this));
1262 int face_id
= XINT (XCDR (XCAR (tail
)));
1263 struct face
*face
= FACE_FROM_ID (f
, face_id
);
1265 /* Face THIS itself is also freed by the following call. */
1266 free_realized_face (f
, face
);
1272 Fclear_face_cache (Qt
);
1277 /* Check validity of NAME as a fontset name and return the
1278 corresponding fontset. If not valid, signal an error.
1279 If NAME is t, return Vdefault_fontset. */
1282 check_fontset_name (name
)
1288 return Vdefault_fontset
;
1290 CHECK_STRING (name
);
1291 /* First try NAME as literal. */
1292 id
= fs_query_fontset (name
, 2);
1294 /* For backward compatibility, try again NAME as pattern. */
1295 id
= fs_query_fontset (name
, 0);
1297 error ("Fontset `%s' does not exist", SDATA (name
));
1298 return FONTSET_FROM_ID (id
);
1302 accumulate_script_ranges (arg
, range
, val
)
1303 Lisp_Object arg
, range
, val
;
1305 if (EQ (XCAR (arg
), val
))
1308 XSETCDR (arg
, Fcons (Fcons (XCAR (range
), XCDR (range
)), XCDR (arg
)));
1310 XSETCDR (arg
, Fcons (Fcons (range
, range
), XCDR (arg
)));
1315 /* Return an ASCII font name generated from fontset name NAME and
1316 ASCII font specification ASCII_SPEC. NAME is a string conforming
1317 to XLFD. ASCII_SPEC is a vector:
1318 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
1320 static INLINE Lisp_Object
1321 generate_ascii_font_name (name
, ascii_spec
)
1322 Lisp_Object name
, ascii_spec
;
1327 vec
= split_font_name_into_vector (name
);
1328 for (i
= FONT_SPEC_FAMILY_INDEX
; i
<= FONT_SPEC_ADSTYLE_INDEX
; i
++)
1329 if (! NILP (AREF (ascii_spec
, i
)))
1330 ASET (vec
, 1 + i
, AREF (ascii_spec
, i
));
1331 if (! NILP (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
)))
1332 ASET (vec
, 12, AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
1333 return build_font_name_from_vector (vec
);
1336 /* Variables referred in set_fontset_font. They are set before
1337 map_charset_chars is called in Fset_fontset_font. */
1338 static Lisp_Object font_def_arg
, add_arg
;
1339 static int from_arg
, to_arg
;
1341 /* Callback function for map_charset_chars in Fset_fontset_font. In
1342 FONTSET, set font_def_arg in a fashion specified by add_arg for
1343 characters in RANGE while ignoring the range between from_arg and
1347 set_fontset_font (fontset
, range
)
1348 Lisp_Object fontset
, range
;
1350 if (from_arg
< to_arg
)
1352 int from
= XINT (XCAR (range
)), to
= XINT (XCDR (range
));
1354 if (from
< from_arg
)
1360 range2
= Fcons (make_number (to_arg
), XCDR (range
));
1361 FONTSET_ADD (fontset
, range
, font_def_arg
, add_arg
);
1365 range
= Fcons (XCAR (range
), make_number (from_arg
));
1367 else if (to
<= to_arg
)
1372 range
= Fcons (make_number (to_arg
), XCDR (range
));
1375 FONTSET_ADD (fontset
, range
, font_def_arg
, add_arg
);
1379 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 5, 0,
1381 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1383 TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
1384 In that case, use FONT-SPEC for all characters in the range FROM and
1387 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1388 all characters that belong to the script.
1390 TARGET may be a charset. In that case, use FONT-SPEC for all
1391 characters in the charset.
1393 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1394 that no FONT-SPEC is specified.
1396 FONT-SPEC may one of these:
1397 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1398 REGISTRY is a font registry name. FAMILY may contains foundry
1399 name, and REGISTRY may contains encoding name.
1400 * A font name string.
1402 Optional 4th argument FRAME, if non-nil, is a frame. This argument is
1403 kept for backward compatibility and has no meaning.
1405 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1406 to the font specifications for TARGET previously set. If it is
1407 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1408 appended. By default, FONT-SPEC overrides the previous settings. */)
1409 (name
, target
, font_spec
, frame
, add
)
1410 Lisp_Object name
, target
, font_spec
, frame
, add
;
1412 Lisp_Object fontset
;
1413 Lisp_Object font_def
, registry
, family
;
1414 Lisp_Object encoding
, repertory
;
1415 Lisp_Object range_list
;
1416 struct charset
*charset
= NULL
;
1418 fontset
= check_fontset_name (name
);
1420 /* The arg FRAME is kept for backward compatibility. We only check
1423 CHECK_LIVE_FRAME (frame
);
1425 if (VECTORP (font_spec
))
1427 /* FONT_SPEC should have this form:
1428 [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ]
1429 This is a feature not yet documented because WEIGHT thru
1430 ADSTYLE are ignored for the moment. */
1433 if (ASIZE (font_spec
) != FONT_SPEC_MAX_INDEX
)
1434 args_out_of_range (make_number (FONT_SPEC_MAX_INDEX
),
1435 make_number (ASIZE (font_spec
)));
1437 font_spec
= Fcopy_sequence (font_spec
);
1438 for (j
= 0; j
< FONT_SPEC_MAX_INDEX
- 1; j
++)
1439 if (! NILP (AREF (font_spec
, j
)))
1441 CHECK_STRING (AREF (font_spec
, j
));
1442 ASET (font_spec
, j
, Fdowncase (AREF (font_spec
, j
)));
1444 /* REGISTRY should not be omitted. */
1445 CHECK_STRING (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1446 registry
= Fdowncase (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1447 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1450 else if (CONSP (font_spec
))
1452 family
= XCAR (font_spec
);
1453 registry
= XCDR (font_spec
);
1455 if (! NILP (family
))
1457 CHECK_STRING (family
);
1458 family
= Fdowncase (family
);
1460 CHECK_STRING (registry
);
1461 registry
= Fdowncase (registry
);
1462 font_spec
= Fmake_vector (make_number (FONT_SPEC_MAX_INDEX
), Qnil
);
1463 ASET (font_spec
, FONT_SPEC_FAMILY_INDEX
, family
);
1464 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1468 CHECK_STRING (font_spec
);
1469 font_spec
= Fdowncase (font_spec
);
1472 if (STRINGP (font_spec
))
1473 encoding
= find_font_encoding (font_spec
);
1475 encoding
= find_font_encoding (concat2 (family
, registry
));
1476 if (SYMBOLP (encoding
))
1478 CHECK_CHARSET (encoding
);
1479 encoding
= repertory
= CHARSET_SYMBOL_ID (encoding
);
1483 repertory
= XCDR (encoding
);
1484 encoding
= XCAR (encoding
);
1485 CHECK_CHARSET (encoding
);
1486 encoding
= CHARSET_SYMBOL_ID (encoding
);
1487 if (! NILP (repertory
) && SYMBOLP (repertory
))
1489 CHECK_CHARSET (repertory
);
1490 repertory
= CHARSET_SYMBOL_ID (repertory
);
1493 font_def
= Fmake_vector (make_number (3), font_spec
);
1494 ASET (font_def
, 1, encoding
);
1495 ASET (font_def
, 2, repertory
);
1497 if (CHARACTERP (target
))
1498 range_list
= Fcons (Fcons (target
, target
), Qnil
);
1499 else if (CONSP (target
))
1501 Lisp_Object from
, to
;
1503 from
= Fcar (target
);
1505 CHECK_CHARACTER (from
);
1506 CHECK_CHARACTER (to
);
1507 range_list
= Fcons (target
, Qnil
);
1509 else if (SYMBOLP (target
) && !NILP (target
))
1511 Lisp_Object script_list
;
1515 script_list
= XCHAR_TABLE (Vchar_script_table
)->extras
[0];
1516 if (! NILP (Fmemq (target
, script_list
)))
1518 val
= Fcons (target
, Qnil
);
1519 map_char_table (accumulate_script_ranges
, Qnil
, Vchar_script_table
,
1521 range_list
= XCDR (val
);
1523 if (CHARSETP (target
))
1525 if (EQ (target
, Qascii
))
1527 if (VECTORP (font_spec
))
1528 font_spec
= generate_ascii_font_name (FONTSET_NAME (fontset
),
1530 FONTSET_ASCII (fontset
) = font_spec
;
1531 range_list
= Fcons (Fcons (make_number (0), make_number (127)),
1536 CHECK_CHARSET_GET_CHARSET (target
, charset
);
1539 else if (NILP (range_list
))
1540 error ("Invalid script or charset name: %s",
1541 SDATA (SYMBOL_NAME (target
)));
1543 else if (NILP (target
))
1544 range_list
= Fcons (Qnil
, Qnil
);
1546 error ("Invalid target for setting a font");
1551 font_def_arg
= font_def
;
1553 if (NILP (range_list
))
1554 from_arg
= to_arg
= 0;
1556 from_arg
= XINT (XCAR (XCAR (range_list
))),
1557 to_arg
= XINT (XCDR (XCAR (range_list
)));
1559 map_charset_chars (set_fontset_font
, Qnil
, fontset
, charset
,
1560 CHARSET_MIN_CODE (charset
),
1561 CHARSET_MAX_CODE (charset
));
1563 for (; CONSP (range_list
); range_list
= XCDR (range_list
))
1564 FONTSET_ADD (fontset
, XCAR (range_list
), font_def
, add
);
1566 /* Free all realized fontsets whose base is FONTSET. This way, the
1567 specified character(s) are surely redisplayed by a correct
1569 free_realized_fontsets (fontset
);
1575 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
1576 doc
: /* Create a new fontset NAME from font information in FONTLIST.
1578 FONTLIST is an alist of scripts vs the corresponding font specification list.
1579 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1580 character of SCRIPT is displayed by a font that matches one of
1583 SCRIPT is a symbol that appears in the first extra slot of the
1584 char-table `char-script-table'.
1586 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1587 `set-fontset-font' for the meaning. */)
1589 Lisp_Object name
, fontlist
;
1591 Lisp_Object fontset
;
1595 CHECK_STRING (name
);
1596 CHECK_LIST (fontlist
);
1598 id
= fs_query_fontset (name
, 0);
1601 name
= Fdowncase (name
);
1602 val
= split_font_name_into_vector (name
);
1603 if (NILP (val
) || NILP (AREF (val
, 12)) || NILP (AREF (val
, 13)))
1604 error ("Fontset name must be in XLFD format");
1605 if (strcmp (SDATA (AREF (val
, 12)), "fontset"))
1606 error ("Registry field of fontset name must be \"fontset\"");
1607 Vfontset_alias_alist
1608 = Fcons (Fcons (name
,
1609 concat2 (concat2 (AREF (val
, 12), build_string ("-")),
1611 Vfontset_alias_alist
);
1612 ASET (val
, 12, build_string ("iso8859-1"));
1613 fontset
= make_fontset (Qnil
, name
, Qnil
);
1614 FONTSET_ASCII (fontset
) = build_font_name_from_vector (val
);
1618 fontset
= FONTSET_FROM_ID (id
);;
1619 free_realized_fontsets (fontset
);
1620 Fset_char_table_range (fontset
, Qt
, Qnil
);
1623 for (; ! NILP (fontlist
); fontlist
= Fcdr (fontlist
))
1625 Lisp_Object elt
, script
;
1627 elt
= Fcar (fontlist
);
1628 script
= Fcar (elt
);
1630 if (CONSP (elt
) && (NILP (XCDR (elt
)) || CONSP (XCDR (elt
))))
1631 for (; CONSP (elt
); elt
= XCDR (elt
))
1632 Fset_fontset_font (name
, script
, XCAR (elt
), Qnil
, Qappend
);
1634 Fset_fontset_font (name
, script
, elt
, Qnil
, Qappend
);
1640 /* Alist of automatically created fontsets. Each element is a cons
1641 (FONTNAME . FONTSET-ID). */
1642 static Lisp_Object auto_fontset_alist
;
1645 new_fontset_from_font_name (Lisp_Object fontname
)
1652 fontname
= Fdowncase (fontname
);
1653 val
= Fassoc (fontname
, auto_fontset_alist
);
1655 return XINT (XCDR (val
));
1657 vec
= split_font_name_into_vector (fontname
);
1659 vec
= Fmake_vector (make_number (14), build_string (""));
1660 ASET (vec
, 12, build_string ("fontset"));
1661 if (NILP (auto_fontset_alist
))
1663 ASET (vec
, 13, build_string ("startup"));
1664 name
= build_font_name_from_vector (vec
);
1669 int len
= XINT (Flength (auto_fontset_alist
));
1671 sprintf (temp
, "auto%d", len
);
1672 ASET (vec
, 13, build_string (temp
));
1673 name
= build_font_name_from_vector (vec
);
1675 name
= Fnew_fontset (name
, list2 (list2 (Qascii
, fontname
),
1676 list2 (Fcons (make_number (0),
1677 make_number (MAX_CHAR
)),
1679 id
= fs_query_fontset (name
, 0);
1681 = Fcons (Fcons (fontname
, make_number (id
)), auto_fontset_alist
);
1686 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1687 doc
: /* Return information about a font named NAME on frame FRAME.
1688 If FRAME is omitted or nil, use the selected frame.
1689 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1690 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1692 OPENED-NAME is the name used for opening the font,
1693 FULL-NAME is the full name of the font,
1694 SIZE is the maximum bound width of the font,
1695 HEIGHT is the height of the font,
1696 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1697 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1698 how to compose characters.
1699 If the named font is not yet loaded, return nil. */)
1701 Lisp_Object name
, frame
;
1704 struct font_info
*fontp
;
1707 (*check_window_system_func
) ();
1709 CHECK_STRING (name
);
1710 name
= Fdowncase (name
);
1712 frame
= selected_frame
;
1713 CHECK_LIVE_FRAME (frame
);
1716 if (!query_font_func
)
1717 error ("Font query function is not supported");
1719 fontp
= (*query_font_func
) (f
, SDATA (name
));
1723 info
= Fmake_vector (make_number (7), Qnil
);
1725 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1726 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1727 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1728 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1729 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1730 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1731 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1737 /* Return a cons (FONT-NAME . GLYPH-CODE).
1738 FONT-NAME is the font name for the character at POSITION in the current
1739 buffer. This is computed from all the text properties and overlays
1740 that apply to POSITION. POSTION may be nil, in which case,
1741 FONT-NAME is the font name for display the character CH with the
1744 GLYPH-CODE is the glyph code in the font to use for the character.
1746 If the 2nd optional arg CH is non-nil, it is a character to check
1747 the font instead of the character at POSITION.
1749 It returns nil in the following cases:
1751 (1) The window system doesn't have a font for the character (thus
1752 it is displayed by an empty box).
1754 (2) The character code is invalid.
1756 (3) If POSITION is not nil, and the current buffer is not displayed
1759 In addition, the returned font name may not take into account of
1760 such redisplay engine hooks as what used in jit-lock-mode if
1761 POSITION is currently not visible. */
1764 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 2, 0,
1765 doc
: /* For internal use only. */)
1767 Lisp_Object position
, ch
;
1769 int pos
, pos_byte
, dummy
;
1774 Lisp_Object charset
, rfont_def
;
1777 if (NILP (position
))
1779 CHECK_CHARACTER (ch
);
1781 f
= XFRAME (selected_frame
);
1782 face_id
= DEFAULT_FACE_ID
;
1790 CHECK_NUMBER_COERCE_MARKER (position
);
1791 pos
= XINT (position
);
1792 if (pos
< BEGV
|| pos
>= ZV
)
1793 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1794 pos_byte
= CHAR_TO_BYTE (pos
);
1796 c
= FETCH_CHAR (pos_byte
);
1802 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1805 w
= XWINDOW (window
);
1806 f
= XFRAME (w
->frame
);
1807 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1809 if (! CHAR_VALID_P (c
, 0))
1811 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
, pos
, Qnil
);
1812 face
= FACE_FROM_ID (f
, face_id
);
1813 charset
= Fget_char_property (position
, Qcharset
, Qnil
);
1814 if (CHARSETP (charset
))
1815 id
= XINT (CHARSET_SYMBOL_ID (charset
));
1818 rfont_def
= fontset_font (FONTSET_FROM_ID (face
->fontset
), c
, face
, id
);
1819 if (VECTORP (rfont_def
) && STRINGP (AREF (rfont_def
, 3)))
1821 Lisp_Object font_def
;
1822 struct font_info
*fontp
;
1823 struct charset
*charset
;
1827 font_def
= AREF (rfont_def
, 2);
1828 charset
= CHARSET_FROM_ID (XINT (AREF (font_def
, 1)));
1829 code
= ENCODE_CHAR (charset
, c
);
1830 if (code
== CHARSET_INVALID_CODE (charset
))
1831 return (Fcons (AREF (rfont_def
, 3), Qnil
));
1832 STORE_XCHAR2B (&char2b
, ((code
>> 8) & 0xFF), (code
& 0xFF));
1833 fontp
= (*get_font_info_func
) (f
, XINT (AREF (rfont_def
, 1)));
1834 rif
->encode_char (c
, &char2b
, fontp
, charset
, NULL
);
1835 code
= (XCHAR2B_BYTE1 (&char2b
) << 8) | XCHAR2B_BYTE2 (&char2b
);
1836 return (Fcons (AREF (rfont_def
, 3), make_number (code
)));
1842 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1843 doc
: /* Return information about a fontset FONTSET on frame FRAME.
1844 The value is a char-table of which elements has this form.
1846 ((FONT-PATTERN OPENED-FONT ...) ...)
1848 FONT-PATTERN is a vector:
1850 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
1852 or a string of font name pattern.
1854 OPENED-FONT is a name of a font actually opened.
1856 The char-table has one extra slot. The value is a char-table
1857 containing the information about the derived fonts from the default
1858 fontset. The format is the same as abobe. */)
1860 Lisp_Object fontset
, frame
;
1863 Lisp_Object
*realized
[2], fontsets
[2], tables
[2];
1864 Lisp_Object val
, elt
;
1867 (*check_window_system_func
) ();
1869 fontset
= check_fontset_name (fontset
);
1872 frame
= selected_frame
;
1873 CHECK_LIVE_FRAME (frame
);
1876 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1877 in the table `realized'. */
1878 realized
[0] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1879 * ASIZE (Vfontset_table
));
1880 for (i
= j
= 0; i
< ASIZE (Vfontset_table
); i
++)
1882 elt
= FONTSET_FROM_ID (i
);
1884 && EQ (FONTSET_BASE (elt
), fontset
)
1885 && EQ (FONTSET_FRAME (elt
), frame
))
1886 realized
[0][j
++] = elt
;
1888 realized
[0][j
] = Qnil
;
1890 realized
[1] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1891 * ASIZE (Vfontset_table
));
1892 for (i
= j
= 0; ! NILP (realized
[0][i
]); i
++)
1894 elt
= FONTSET_DEFAULT (realized
[0][i
]);
1896 realized
[1][j
++] = elt
;
1898 realized
[1][j
] = Qnil
;
1900 tables
[0] = Fmake_char_table (Qfontset_info
, Qnil
);
1901 tables
[1] = Fmake_char_table (Qnil
, Qnil
);
1902 XCHAR_TABLE (tables
[0])->extras
[0] = tables
[1];
1903 fontsets
[0] = fontset
;
1904 fontsets
[1] = Vdefault_fontset
;
1906 /* Accumulate information of the fontset in TABLE. The format of
1907 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1908 for (k
= 0; k
<= 1; k
++)
1910 for (c
= 0; c
<= MAX_CHAR
; )
1914 if (c
<= MAX_5_BYTE_CHAR
)
1916 val
= char_table_ref_and_range (fontsets
[k
], c
, &from
, &to
);
1917 if (to
> MAX_5_BYTE_CHAR
)
1918 to
= MAX_5_BYTE_CHAR
;
1922 val
= FONTSET_FALLBACK (fontsets
[k
]);
1929 /* At first, set ALIST to ((FONT-SPEC) ...). */
1930 for (alist
= Qnil
, i
= 0; i
< ASIZE (val
); i
++)
1931 alist
= Fcons (Fcons (AREF (AREF (val
, i
), 0), Qnil
), alist
);
1932 alist
= Fnreverse (alist
);
1934 /* Then store opend font names to cdr of each elements. */
1935 for (i
= 0; ! NILP (realized
[k
][i
]); i
++)
1937 if (c
<= MAX_5_BYTE_CHAR
)
1938 val
= FONTSET_REF (realized
[k
][i
], c
);
1940 val
= FONTSET_FALLBACK (realized
[k
][i
]);
1941 if (! VECTORP (val
))
1943 /* VAL is [int int ?
1944 [FACE-ID FONT-INDEX FONT-DEF FONT-NAME] ...].
1945 If a font of an element is already opened,
1946 FONT-NAME is the name of a opened font. */
1947 for (j
= 3; j
< ASIZE (val
); j
++)
1948 if (STRINGP (AREF (AREF (val
, j
), 3)))
1950 Lisp_Object font_idx
;
1952 font_idx
= AREF (AREF (val
, j
), 1);
1953 elt
= Fassq (AREF (AREF (AREF (val
, j
), 2), 0), alist
);
1955 && NILP (Fmemq (font_idx
, XCDR(elt
))))
1956 nconc2 (elt
, Fcons (font_idx
, Qnil
));
1959 for (val
= alist
; CONSP (val
); val
= XCDR (val
))
1960 for (elt
= XCDR (XCAR (val
)); CONSP (elt
); elt
= XCDR (elt
))
1962 struct font_info
*font_info
1963 = (*get_font_info_func
) (f
, XINT (XCAR (elt
)));
1964 XSETCAR (elt
, build_string (font_info
->full_name
));
1967 /* Store ALIST in TBL for characters C..TO. */
1968 if (c
<= MAX_5_BYTE_CHAR
)
1969 char_table_set_range (tables
[k
], c
, to
, alist
);
1971 XCHAR_TABLE (tables
[k
])->defalt
= alist
;
1981 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 3, 0,
1982 doc
: /* Return a font name pattern for character CH in fontset NAME.
1983 If NAME is t, find a pattern in the default fontset.
1985 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
1986 family name and REGISTRY is a font registry name. This is actually
1987 the first font name pattern for CH in the fontset or in the default
1990 If the 2nd optional arg ALL is non-nil, return a list of all font name
1993 Lisp_Object name
, ch
, all
;
1996 Lisp_Object fontset
, elt
, list
, repertory
, val
;
1999 fontset
= check_fontset_name (name
);
2001 CHECK_CHARACTER (ch
);
2006 for (i
= 0, elt
= FONTSET_REF (fontset
, c
); i
< 2;
2007 i
++, elt
= FONTSET_FALLBACK (fontset
))
2009 for (j
= 0; j
< ASIZE (elt
); j
++)
2011 val
= AREF (elt
, j
);
2012 repertory
= AREF (val
, 1);
2013 if (INTEGERP (repertory
))
2015 struct charset
*charset
= CHARSET_FROM_ID (XINT (repertory
));
2017 if (! CHAR_CHARSET_P (c
, charset
))
2020 else if (CHAR_TABLE_P (repertory
))
2022 if (NILP (CHAR_TABLE_REF (repertory
, c
)))
2025 val
= AREF (val
, 0);
2026 val
= Fcons (AREF (val
, 0), AREF (val
, 5));
2029 list
= Fcons (val
, list
);
2031 if (EQ (fontset
, Vdefault_fontset
))
2033 fontset
= Vdefault_fontset
;
2035 return (Fnreverse (list
));
2038 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
2039 doc
: /* Return a list of all defined fontset names. */)
2042 Lisp_Object fontset
, list
;
2046 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
2048 fontset
= FONTSET_FROM_ID (i
);
2050 && BASE_FONTSET_P (fontset
))
2051 list
= Fcons (FONTSET_NAME (fontset
), list
);
2058 #ifdef FONTSET_DEBUG
2061 dump_fontset (fontset
)
2062 Lisp_Object fontset
;
2066 vec
= Fmake_vector (make_number (3), Qnil
);
2067 ASET (vec
, 0, FONTSET_ID (fontset
));
2069 if (BASE_FONTSET_P (fontset
))
2071 ASET (vec
, 1, FONTSET_NAME (fontset
));
2077 frame
= FONTSET_FRAME (fontset
);
2080 FRAME_PTR f
= XFRAME (frame
);
2082 if (FRAME_LIVE_P (f
))
2083 ASET (vec
, 1, f
->name
);
2087 if (!NILP (FONTSET_DEFAULT (fontset
)))
2088 ASET (vec
, 2, FONTSET_ID (FONTSET_DEFAULT (fontset
)));
2093 DEFUN ("fontset-list-all", Ffontset_list_all
, Sfontset_list_all
, 0, 0, 0,
2094 doc
: /* Return a brief summary of all fontsets for debug use. */)
2100 for (i
= 0, val
= Qnil
; i
< ASIZE (Vfontset_table
); i
++)
2101 if (! NILP (AREF (Vfontset_table
, i
)))
2102 val
= Fcons (dump_fontset (AREF (Vfontset_table
, i
)), val
);
2103 return (Fnreverse (val
));
2105 #endif /* FONTSET_DEBUG */
2110 if (!load_font_func
)
2111 /* Window system initializer should have set proper functions. */
2114 DEFSYM (Qfontset
, "fontset");
2115 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (9));
2116 DEFSYM (Qfontset_info
, "fontset-info");
2117 Fput (Qfontset_info
, Qchar_table_extra_slots
, make_number (1));
2119 DEFSYM (Qprepend
, "prepend");
2120 DEFSYM (Qappend
, "append");
2122 Vcached_fontset_data
= Qnil
;
2123 staticpro (&Vcached_fontset_data
);
2125 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
2126 staticpro (&Vfontset_table
);
2128 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
2129 staticpro (&Vdefault_fontset
);
2130 FONTSET_ID (Vdefault_fontset
) = make_number (0);
2131 FONTSET_NAME (Vdefault_fontset
)
2132 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
2134 Lisp_Object default_ascii_font
;
2136 #if defined (macintosh)
2138 = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman");
2139 #elif defined (WINDOWSNT)
2141 = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
2144 = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
2146 FONTSET_ASCII (Vdefault_fontset
) = default_ascii_font
;
2148 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
2149 next_fontset_id
= 1;
2151 auto_fontset_alist
= Qnil
;
2152 staticpro (&auto_fontset_alist
);
2154 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
2156 Alist of fontname patterns vs the corresponding encoding and repertory info.
2157 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
2158 where ENCODING is a charset or a char-table,
2159 and REPERTORY is a charset, a char-table, or nil.
2161 ENCODING is for converting a character to a glyph code of the font.
2162 If ENCODING is a charset, encoding a character by the charset gives
2163 the corresponding glyph code. If ENCODING is a char-table, looking up
2164 the table by a character gives the corresponding glyph code.
2166 REPERTORY specifies a repertory of characters supported by the font.
2167 If REPERTORY is a charset, all characters beloging to the charset are
2168 supported. If REPERTORY is a char-table, all characters who have a
2169 non-nil value in the table are supported. It REPERTORY is nil, Emacs
2170 gets the repertory information by an opened font and ENCODING. */);
2171 Vfont_encoding_alist
= Qnil
;
2173 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
2175 Char table of characters whose ascent values should be ignored.
2176 If an entry for a character is non-nil, the ascent value of the glyph
2177 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
2179 This affects how a composite character which contains
2180 such a character is displayed on screen. */);
2181 Vuse_default_ascent
= Qnil
;
2183 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
2185 Char table of characters which is not composed relatively.
2186 If an entry for a character is non-nil, a composition sequence
2187 which contains that character is displayed so that
2188 the glyph of that character is put without considering
2189 an ascent and descent value of a previous character. */);
2190 Vignore_relative_composition
= Qnil
;
2192 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
2193 doc
: /* Alist of fontname vs list of the alternate fontnames.
2194 When a specified font name is not found, the corresponding
2195 alternate fontnames (if any) are tried instead. */);
2196 Valternate_fontname_alist
= Qnil
;
2198 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
2199 doc
: /* Alist of fontset names vs the aliases. */);
2200 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
2201 build_string ("fontset-default")),
2204 DEFVAR_LISP ("vertical-centering-font-regexp",
2205 &Vvertical_centering_font_regexp
,
2206 doc
: /* *Regexp matching font names that require vertical centering on display.
2207 When a character is displayed with such fonts, the character is displayed
2208 at the vertical center of lines. */);
2209 Vvertical_centering_font_regexp
= Qnil
;
2211 defsubr (&Squery_fontset
);
2212 defsubr (&Snew_fontset
);
2213 defsubr (&Sset_fontset_font
);
2214 defsubr (&Sfont_info
);
2215 defsubr (&Sinternal_char_font
);
2216 defsubr (&Sfontset_info
);
2217 defsubr (&Sfontset_font
);
2218 defsubr (&Sfontset_list
);
2219 #ifdef FONTSET_DEBUG
2220 defsubr (&Sfontset_list_all
);
2224 /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
2225 (do not change this comment) */