2 Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2, or (at your option)
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs; see the file COPYING. If not, write to
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 Boston, MA 02111-1307, USA. */
25 /* #define FONTSET_DEBUG */
34 #include "blockinput.h"
36 #include "character.h"
41 #include "dispextern.h"
47 #define xassert(X) do {if (!(X)) abort ();} while (0)
50 #else /* not FONTSET_DEBUG */
51 #define xassert(X) (void) 0
52 #endif /* not FONTSET_DEBUG */
54 EXFUN (Fclear_face_cache
, 1);
58 A fontset is a collection of font related information to give
59 similar appearance (style, etc) of characters. A fontset has two
60 roles. One is to use for the frame parameter `font' as if it is an
61 ASCII font. In that case, Emacs uses the font specified for
62 `ascii' script for the frame's default font.
64 Another role, the more important one, is to provide information
65 about which font to use for each non-ASCII character.
67 There are two kinds of fontsets; base and realized. A base fontset
68 is created by `new-fontset' from Emacs Lisp explicitly. A realized
69 fontset is created implicitly when a face is realized for ASCII
70 characters. A face is also realized for non-ASCII characters based
71 on an ASCII face. All of non-ASCII faces based on the same ASCII
72 face share the same realized fontset.
74 A fontset object is implemented by a char-table whose default value
75 and parent are always nil.
77 An element of a base fontset is a vector of FONT-DEFs which itself
78 is a vector [ FONT-SPEC ENCODING REPERTORY ].
81 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
84 where FAMILY, WEIGHT, SLANT, SWIDTH, ADSTYLE, REGISTRY, and
85 FONT-NAME are strings.
87 ENCODING is a charset ID or a char-table that can convert
88 characters to glyph codes of the corresponding font.
90 REPERTORY is a charset ID or nil. If REPERTORY is a charset ID,
91 the repertory of the charset exactly matches with that of the font.
92 If REPERTORY is nil, we consult with the font itself to get the
95 ENCODING and REPERTORY are extracted from the variable
96 Vfont_encoding_alist by using a font name generated form FONT-SPEC
97 (if it is a vector) or FONT-NAME as a key.
100 An element of a realized fontset is nil or t, or has this form:
102 [CHARSET-PRIORITY-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-FONT-DEF
103 FONT-DEF0 FONT-DEF1 ...].
105 FONT-DEFn has this form:
107 [ FACE-ID FONT-INDEX FONT-DEF ]
109 FONT-DEFn is automatically reordered by the current charset
112 The value nil means that we have not yet generated FONT-VECTOR from
113 the base of the fontset.
115 The value t means that no font is available for the corresponding
119 A fontset has 8 extra slots.
121 The 1st slot: the ID number of the fontset
124 base: the name of the fontset
129 realized: the base fontset
133 realized: the frame that the fontset belongs to
136 base: the font name for ASCII characters
141 realized: the ID number of a face to use for characters that
142 has no font in a realized fontset.
146 realized: Alist of font index vs the corresponding repertory
151 realized: If the base is not the default fontset, a fontset
152 realized from the default fontset, else nil.
154 All fontsets are recorded in the vector Vfontset_table.
159 There's a special base fontset named `default fontset' which
160 defines the default font specifications. When a base fontset
161 doesn't specify a font for a specific character, the corresponding
162 value in the default fontset is used.
164 The parent of a realized fontset created for such a face that has
165 no fontset is the default fontset.
168 These structures are hidden from the other codes than this file.
169 The other codes handle fontsets only by their ID numbers. They
170 usually use the variable name `fontset' for IDs. But, in this
171 file, we always use varialbe name `id' for IDs, and name `fontset'
172 for an actual fontset object, i.e., char-table.
176 /********** VARIABLES and FUNCTION PROTOTYPES **********/
178 extern Lisp_Object Qfont
;
179 static Lisp_Object Qfontset
;
180 static Lisp_Object Qfontset_info
;
181 static Lisp_Object Qprepend
, Qappend
;
183 /* Vector containing all fontsets. */
184 static Lisp_Object Vfontset_table
;
186 /* Next possibly free fontset ID. Usually this keeps the minimum
187 fontset ID not yet used. */
188 static int next_fontset_id
;
190 /* The default fontset. This gives default FAMILY and REGISTRY of
191 font for each character. */
192 static Lisp_Object Vdefault_fontset
;
194 Lisp_Object Vfont_encoding_alist
;
195 Lisp_Object Vuse_default_ascent
;
196 Lisp_Object Vignore_relative_composition
;
197 Lisp_Object Valternate_fontname_alist
;
198 Lisp_Object Vfontset_alias_alist
;
199 Lisp_Object Vvertical_centering_font_regexp
;
201 /* The following six are declarations of callback functions depending
202 on window system. See the comments in src/fontset.h for more
205 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
206 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
208 /* Return a list of font names which matches PATTERN. See the documentation
209 of `x-list-fonts' for more details. */
210 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
215 /* Load a font named NAME for frame F and return a pointer to the
216 information of the loaded font. If loading is failed, return 0. */
217 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
219 /* Return a pointer to struct font_info of a font named NAME for frame F. */
220 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
222 /* Additional function for setting fontset or changing fontset
223 contents of frame F. */
224 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
225 Lisp_Object oldval
));
227 /* To find a CCL program, fs_load_font calls this function.
228 The argument is a pointer to the struct font_info.
229 This function set the member `encoder' of the structure. */
230 void (*find_ccl_program_func
) P_ ((struct font_info
*));
232 Lisp_Object (*get_font_repertory_func
) P_ ((struct frame
*,
233 struct font_info
*));
235 /* Check if any window system is used now. */
236 void (*check_window_system_func
) P_ ((void));
239 /* Prototype declarations for static functions. */
240 static Lisp_Object fontset_add
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
242 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
243 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
244 static void accumulate_script_ranges
P_ ((Lisp_Object
, Lisp_Object
,
246 static Lisp_Object find_font_encoding
P_ ((char *));
248 static void set_fontset_font
P_ ((Lisp_Object
, Lisp_Object
));
252 /* Return 1 if ID is a valid fontset id, else return 0. */
255 fontset_id_valid_p (id
)
258 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
265 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
267 /* Return the fontset with ID. No check of ID's validness. */
268 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
270 /* Macros to access special values of FONTSET. */
271 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
273 /* Macros to access special values of (base) FONTSET. */
274 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
275 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
277 /* Macros to access special values of (realized) FONTSET. */
278 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
279 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
280 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
281 #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
282 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[7]
284 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
287 /* Return the element of FONTSET for the character C. If FONTSET is a
288 base fontset other then the default fontset and FONTSET doesn't
289 contain information for C, return the information in the default
292 #define FONTSET_REF(fontset, c) \
293 (EQ (fontset, Vdefault_fontset) \
294 ? CHAR_TABLE_REF (fontset, c) \
295 : fontset_ref ((fontset), (c)))
298 fontset_ref (fontset
, c
)
304 elt
= CHAR_TABLE_REF (fontset
, c
);
305 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
306 /* Don't check Vdefault_fontset for a realized fontset. */
307 && NILP (FONTSET_BASE (fontset
)))
308 elt
= CHAR_TABLE_REF (Vdefault_fontset
, c
);
313 /* Return the element of FONTSET for the character C, set FROM and TO
314 to the range of characters around C that have the same value as C.
315 If FONTSET is a base fontset other then the default fontset and
316 FONTSET doesn't contain information for C, return the information
317 in the default fontset. */
319 #define FONTSET_REF_AND_RANGE(fontset, c, form, to) \
320 (EQ (fontset, Vdefault_fontset) \
321 ? char_table_ref_and_range (fontset, c, &from, &to) \
322 : fontset_ref_and_range (fontset, c, &from, &to))
325 fontset_ref_and_range (fontset
, c
, from
, to
)
332 elt
= char_table_ref_and_range (fontset
, c
, from
, to
);
333 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
334 /* Don't check Vdefault_fontset for a realized fontset. */
335 && NILP (FONTSET_BASE (fontset
)))
339 elt
= char_table_ref_and_range (Vdefault_fontset
, c
, &from1
, &to1
);
349 /* Set elements of FONTSET for characters in RANGE to the value ELT.
350 RANGE is a cons (FROM . TO), where FROM and TO are character codes
351 specifying a range. */
353 #define FONTSET_SET(fontset, range, elt) \
354 Fset_char_table_range ((fontset), (range), (elt))
357 /* Modify the elements of FONTSET for characters in RANGE by replacing
358 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
359 and TO are character codes specifying a range. If ADD is nil,
360 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
363 #define FONTSET_ADD(fontset, range, elt, add) \
365 ? Fset_char_table_range ((fontset), (range), \
366 Fmake_vector (make_number (1), (elt))) \
367 : fontset_add ((fontset), (range), (elt), (add)))
370 fontset_add (fontset
, range
, elt
, add
)
371 Lisp_Object fontset
, range
, elt
, add
;
373 int from
, to
, from1
, to1
;
376 from
= XINT (XCAR (range
));
377 to
= XINT (XCDR (range
));
379 elt1
= char_table_ref_and_range (fontset
, from
, &from1
, &to1
);
383 elt1
= Fmake_vector (make_number (1), elt
);
386 int i
, i0
= 1, i1
= ASIZE (elt1
) + 1;
389 new = Fmake_vector (make_number (i1
), elt
);
390 if (EQ (add
, Qappend
))
392 for (i
= 0; i0
< i1
; i
++, i0
++)
393 ASET (new, i0
, AREF (elt1
, i
));
396 char_table_set_range (fontset
, from
, to1
, elt1
);
403 /* Update FONTSET_ELEMENT which has this form:
404 [CHARSET-PRIORITY-LIST-TICK PREFERRED-CHARSET-ID INDEX
405 FONT-DEF0 FONT-DEF1 ...].
406 Reorder FONT-DEFs according to the current order of charset
407 (Vcharset_ordered_list), and update CHARSET-PRIORITY-LIST-TICK to
411 reorder_font_vector (fontset_element
)
412 Lisp_Object fontset_element
;
414 Lisp_Object vec
, list
, *new_vec
;
415 Lisp_Object font_def
;
417 int *charset_id_table
;
420 ASET (fontset_element
, 0, make_number (charset_ordered_list_tick
));
421 size
= ASIZE (fontset_element
) - 3;
423 /* No need of reordering VEC. */
425 charset_id_table
= (int *) alloca (sizeof (int) * size
);
426 new_vec
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
) * size
);
428 /* At first, extract ENCODING (a chaset ID) from each FONT-DEF.
429 FONT-DEF has this form:
430 [FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] */
431 for (i
= 0; i
< size
; i
++)
433 font_def
= AREF (fontset_element
, i
+ 3);
434 charset_id_table
[i
] = XINT (AREF (AREF (font_def
, 2), 1));
437 /* Then, store FONT-DEFs in NEW_VEC in the correct order. */
438 for (idx
= 0, list
= Vcharset_ordered_list
;
439 idx
< size
&& CONSP (list
); list
= XCDR (list
))
441 for (i
= 0; i
< size
; i
++)
442 if (charset_id_table
[i
] == XINT (XCAR (list
)))
443 new_vec
[idx
++] = AREF (fontset_element
, i
+ 3);
446 /* At last, update FONT-DEFs. */
447 for (i
= 0; i
< size
; i
++)
448 ASET (fontset_element
, i
+ 3, new_vec
[i
]);
452 /* Load a font matching the font related attributes in FACE->lface and
453 font pattern in FONT_DEF of FONTSET, and return an index of the
454 font. FONT_DEF has this form:
455 [ FONT-SPEC ENCODING REPERTORY ]
456 If REPERTORY is nil, generate a char-table representing the font
457 repertory by looking into the font itself. */
460 load_font_get_repertory (f
, face
, font_def
, fontset
)
463 Lisp_Object font_def
;
467 struct font_info
*font_info
;
470 font_name
= choose_face_font (f
, face
->lface
, AREF (font_def
, 0), NULL
);
471 if (NATNUMP (AREF (font_def
, 1)))
472 charset
= XINT (AREF (font_def
, 1));
475 if (! (font_info
= fs_load_font (f
, font_name
, charset
)))
478 if (NILP (AREF (font_def
, 2))
479 && NILP (Fassq (make_number (font_info
->font_idx
),
480 FONTSET_REPERTORY (fontset
))))
482 /* We must look into the font to get the correct repertory as a
484 Lisp_Object repertory
;
486 repertory
= (*get_font_repertory_func
) (f
, font_info
);
487 FONTSET_REPERTORY (fontset
)
488 = Fcons (Fcons (make_number (font_info
->font_idx
), repertory
),
489 FONTSET_REPERTORY (fontset
));
492 return font_info
->font_idx
;
496 /* Return a face ID registerd in the realized fontset FONTSET for the
497 character C. If a face is not yet set, return -1 (if FACE is NULL)
498 or realize a proper face from FACE and return it. */
501 fontset_face (fontset
, c
, face
, id
)
507 Lisp_Object base_fontset
, elt
, vec
;
510 FRAME_PTR f
= XFRAME (FONTSET_FRAME (fontset
));
512 base_fontset
= FONTSET_BASE (fontset
);
513 elt
= CHAR_TABLE_REF (fontset
, c
);
520 /* We have not yet decided a face for C. */
525 elt
= FONTSET_REF_AND_RANGE (base_fontset
, c
, from
, to
);
526 range
= Fcons (make_number (from
), make_number (to
));
529 /* Record that we have no font for characters of this
531 FONTSET_SET (fontset
, range
, Qt
);
534 /* Build a vector [ -1 -1 nil NEW-ELT0 NEW-ELT1 NEW-ELT2 ... ],
535 where the first -1 is to force reordering of NEW-ELTn,
536 NEW-ETLn is [nil nil AREF (elt, n)]. */
537 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
539 for (i
= 0; i
< ASIZE (elt
); i
++)
543 tmp
= Fmake_vector (make_number (3), Qnil
);
544 ASET (tmp
, 2, AREF (elt
, i
));
545 ASET (vec
, 3 + i
, tmp
);
547 /* Then store it in the fontset. -1 is to force
548 reordering of FONT-VECTOR. */
549 FONTSET_SET (fontset
, range
, vec
);
554 if (XINT (AREF (vec
, 0)) != charset_ordered_list_tick
)
555 /* The priority of charsets is changed after we selected a face
557 reorder_font_vector (vec
);
561 else if (id
== XFASTINT (AREF (vec
, 1)))
565 ASET (vec
, 1, make_number (id
));
566 for (i
= 3; i
< ASIZE (vec
); i
++)
567 if (id
== XFASTINT (AREF (AREF (AREF (vec
, i
), 2), 1)))
571 ASET (vec
, 2, AREF (vec
, i
));
581 /* Find the first available font in the font vector VEC. */
582 for (; i
< ASIZE (vec
); i
++)
584 Lisp_Object font_def
;
589 /* ELT == [ FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ] ] */
590 font_def
= AREF (elt
, 2);
591 if (INTEGERP (AREF (elt
, 1)) && XINT (AREF (elt
, 1)) < 0)
592 /* We couldn't open this font last time. */
595 if (!face
&& (NILP (AREF (elt
, 1)) || NILP (AREF (elt
, 0))))
596 /* We have not yet opened the font, or we have not yet made a
597 realized face for the font. */
600 if (INTEGERP (AREF (font_def
, 2)))
602 /* The repertory is specified by charset ID. */
603 struct charset
*charset
604 = CHARSET_FROM_ID (XINT (AREF (font_def
, 2)));
606 if (! CHAR_CHARSET_P (c
, charset
))
607 /* This font can't display C. */
614 if (! INTEGERP (AREF (elt
, 1)))
616 /* We have not yet opened a font matching this spec.
617 Open the best matching font now and register the
619 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
620 ASET (elt
, 1, make_number (font_idx
));
622 /* This means that we couldn't find a font matching
627 slot
= Fassq (AREF (elt
, 1), FONTSET_REPERTORY (fontset
));
630 if (NILP (CHAR_TABLE_REF (XCDR (slot
), c
)))
631 /* This fond can't display C. */
635 /* Now we have decided to use this font spec to display C. */
636 if (INTEGERP (AREF (elt
, 1)))
637 font_idx
= XINT (AREF (elt
, 1));
640 /* But not yet opened the best matching font. */
641 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
642 ASET (elt
, 1, make_number (font_idx
));
647 /* Now we have the opened font. */
648 if (NILP (AREF (elt
, 0)))
650 /* But not yet made a realized face that uses this font. */
651 int face_id
= lookup_non_ascii_face (f
, font_idx
, face
);
653 ASET (elt
, 0, make_number (face_id
));
656 /* Ok, this face can display C. */
657 return XINT (AREF (elt
, 0));
661 if (! EQ (base_fontset
, Vdefault_fontset
))
663 if (NILP (FONTSET_FALLBACK (fontset
)))
664 FONTSET_FALLBACK (fontset
)
665 = make_fontset (FONTSET_FRAME (fontset
), Qnil
, Vdefault_fontset
);
666 return fontset_face (FONTSET_FALLBACK (fontset
), c
, face
, id
);
669 /* We have tried all the fonts for C, but none of them can be opened
670 nor can display C. */
671 if (NILP (FONTSET_NOFONT_FACE (fontset
)))
677 face_id
= lookup_non_ascii_face (f
, -1, face
);
678 FONTSET_NOFONT_FACE (fontset
) = make_number (face_id
);
680 return XINT (FONTSET_NOFONT_FACE (fontset
));
684 /* Return a newly created fontset with NAME. If BASE is nil, make a
685 base fontset. Otherwise make a realized fontset whose base is
689 make_fontset (frame
, name
, base
)
690 Lisp_Object frame
, name
, base
;
693 int size
= ASIZE (Vfontset_table
);
694 int id
= next_fontset_id
;
696 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
697 the next available fontset ID. So it is expected that this loop
698 terminates quickly. In addition, as the last element of
699 Vfontset_table is always nil, we don't have to check the range of
701 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
705 /* We must grow Vfontset_table. */
709 tem
= Fmake_vector (make_number (size
+ 32), Qnil
);
710 for (i
= 0; i
< size
; i
++)
711 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
712 Vfontset_table
= tem
;
715 fontset
= Fmake_char_table (Qfontset
, Qnil
);
717 FONTSET_ID (fontset
) = make_number (id
);
720 FONTSET_NAME (fontset
) = name
;
724 FONTSET_NAME (fontset
) = Qnil
;
725 FONTSET_FRAME (fontset
) = frame
;
726 FONTSET_BASE (fontset
) = base
;
729 ASET (Vfontset_table
, id
, fontset
);
730 next_fontset_id
= id
+ 1;
736 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
738 /* Return the name of the fontset who has ID. */
746 fontset
= FONTSET_FROM_ID (id
);
747 return FONTSET_NAME (fontset
);
751 /* Return the ASCII font name of the fontset who has ID. */
757 Lisp_Object fontset
, elt
;
759 fontset
= FONTSET_FROM_ID (id
);
760 elt
= FONTSET_ASCII (fontset
);
761 /* It is assured that ELT is always a string (i.e. fontname
767 /* Free fontset of FACE defined on frame F. Called from
768 free_realized_face. */
771 free_face_fontset (f
, face
)
777 fontset
= AREF (Vfontset_table
, face
->fontset
);
778 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
779 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
780 ASET (Vfontset_table
, face
->fontset
, Qnil
);
781 if (face
->fontset
< next_fontset_id
)
782 next_fontset_id
= face
->fontset
;
783 if (! NILP (FONTSET_FALLBACK (fontset
)))
785 int id
= FONTSET_ID (FONTSET_FALLBACK (fontset
));
787 fontset
= AREF (Vfontset_table
, id
);
788 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
789 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
790 ASET (Vfontset_table
, id
, Qnil
);
791 if (id
< next_fontset_id
)
792 next_fontset_id
= face
->fontset
;
797 /* Return 1 iff FACE is suitable for displaying character C.
798 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
799 when C is not an ASCII character. */
802 face_suitable_for_char_p (face
, c
)
808 fontset
= FONTSET_FROM_ID (face
->fontset
);
809 return (face
->id
== fontset_face (fontset
, c
, NULL
, -1));
813 /* Return ID of face suitable for displaying character C on frame F.
814 FACE must be reazlied for ASCII characters in advance. Called from
815 the macro FACE_FOR_CHAR. */
818 face_for_char (f
, face
, c
, pos
, object
)
824 Lisp_Object fontset
, charset
;
827 if (ASCII_CHAR_P (c
))
828 return face
->ascii_face
->id
;
830 xassert (fontset_id_valid_p (face
->fontset
));
831 fontset
= FONTSET_FROM_ID (face
->fontset
);
832 xassert (!BASE_FONTSET_P (fontset
));
837 charset
= Fget_char_property (make_number (pos
), Qcharset
, object
);
840 else if (CHARSETP (charset
))
841 id
= XINT (CHARSET_SYMBOL_ID (charset
));
843 return fontset_face (fontset
, c
, face
, id
);
847 /* Make a realized fontset for ASCII face FACE on frame F from the
848 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
849 default fontset as the base. Value is the id of the new fontset.
850 Called from realize_x_face. */
853 make_fontset_for_ascii_face (f
, base_fontset_id
, face
)
858 Lisp_Object base_fontset
, fontset
, frame
;
860 XSETFRAME (frame
, f
);
861 if (base_fontset_id
>= 0)
863 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
864 if (!BASE_FONTSET_P (base_fontset
))
865 base_fontset
= FONTSET_BASE (base_fontset
);
866 xassert (BASE_FONTSET_P (base_fontset
));
867 if (! BASE_FONTSET_P (base_fontset
))
871 base_fontset
= Vdefault_fontset
;
873 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
877 elt
= FONTSET_REF (base_fontset
, 0);
878 elt
= Fmake_vector (make_number (4), AREF (elt
, 0));
879 ASET (elt
, 0, make_number (charset_ordered_list_tick
));
880 ASET (elt
, 1, make_number (face
->id
));
881 ASET (elt
, 2, make_number (face
->font_info_id
));
882 char_table_set_range (fontset
, 0, 127, elt
);
884 return XINT (FONTSET_ID (fontset
));
888 #if defined(WINDOWSNT) && defined (_MSC_VER)
889 #pragma optimize("", off)
892 /* Load a font named FONTNAME on frame F. Return a pointer to the
893 struct font_info of the loaded font. If loading fails, return
894 NULL. CHARSET is an ID of charset to encode characters for this
895 font. If it is -1, find one from Vfont_encoding_alist. */
898 fs_load_font (f
, fontname
, charset
)
903 struct font_info
*fontp
;
906 /* No way to get fontname. */
909 fontp
= (*load_font_func
) (f
, fontname
, 0);
910 if (! fontp
|| fontp
->charset
>= 0)
913 fontname
= fontp
->full_name
;
917 Lisp_Object charset_symbol
;
919 charset_symbol
= find_font_encoding (fontname
);
920 if (CONSP (charset_symbol
))
921 charset_symbol
= XCAR (charset_symbol
);
922 charset
= XINT (CHARSET_SYMBOL_ID (charset_symbol
));
924 fontp
->charset
= charset
;
925 fontp
->vertical_centering
= 0;
926 fontp
->font_encoder
= NULL
;
928 if (charset
!= charset_ascii
)
930 fontp
->vertical_centering
931 = (STRINGP (Vvertical_centering_font_regexp
)
932 && (fast_c_string_match_ignore_case
933 (Vvertical_centering_font_regexp
, fontname
) >= 0));
935 if (find_ccl_program_func
)
936 (*find_ccl_program_func
) (fontp
);
942 #if defined(WINDOWSNT) && defined (_MSC_VER)
943 #pragma optimize("", on)
947 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
948 FONTNAME. ENCODING is a charset symbol that specifies the encoding
949 of the font. REPERTORY is a charset symbol or nil. */
953 find_font_encoding (fontname
)
956 Lisp_Object tail
, elt
;
958 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
962 && STRINGP (XCAR (elt
))
963 && fast_c_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
964 && (SYMBOLP (XCDR (elt
))
965 ? CHARSETP (XCDR (elt
))
966 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
969 /* We don't know the encoding of this font. Let's assume Unicode
975 /* Cache data used by fontset_pattern_regexp. The car part is a
976 pattern string containing at least one wild card, the cdr part is
977 the corresponding regular expression. */
978 static Lisp_Object Vcached_fontset_data
;
980 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
981 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
983 /* If fontset name PATTERN contains any wild card, return regular
984 expression corresponding to PATTERN. */
987 fontset_pattern_regexp (pattern
)
990 if (!index (SDATA (pattern
), '*')
991 && !index (SDATA (pattern
), '?'))
992 /* PATTERN does not contain any wild cards. */
995 if (!CONSP (Vcached_fontset_data
)
996 || strcmp (SDATA (pattern
), CACHED_FONTSET_NAME
))
998 /* We must at first update the cached data. */
999 char *regex
= (char *) alloca (SCHARS (pattern
) * 2 + 3);
1000 char *p0
, *p1
= regex
;
1002 /* Convert "*" to ".*", "?" to ".". */
1004 for (p0
= (char *) SDATA (pattern
); *p0
; p0
++)
1011 else if (*p0
== '?')
1019 Vcached_fontset_data
= Fcons (build_string (SDATA (pattern
)),
1020 build_string (regex
));
1023 return CACHED_FONTSET_REGEX
;
1026 /* Return ID of the base fontset named NAME. If there's no such
1027 fontset, return -1. */
1030 fs_query_fontset (name
, regexpp
)
1037 name
= Fdowncase (name
);
1040 tem
= Frassoc (name
, Vfontset_alias_alist
);
1042 tem
= Fassoc (name
, Vfontset_alias_alist
);
1043 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1047 tem
= fontset_pattern_regexp (name
);
1056 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1058 Lisp_Object fontset
;
1059 unsigned char *this_name
;
1061 fontset
= FONTSET_FROM_ID (i
);
1063 || !BASE_FONTSET_P (fontset
))
1066 this_name
= SDATA (FONTSET_NAME (fontset
));
1068 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
1069 : !strcmp (SDATA (name
), this_name
))
1076 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
1077 doc
: /* Return the name of a fontset that matches PATTERN.
1078 The value is nil if there is no matching fontset.
1079 PATTERN can contain `*' or `?' as a wildcard
1080 just as X font name matching algorithm allows.
1081 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1083 Lisp_Object pattern
, regexpp
;
1085 Lisp_Object fontset
;
1088 (*check_window_system_func
) ();
1090 CHECK_STRING (pattern
);
1092 if (SCHARS (pattern
) == 0)
1095 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
1099 fontset
= FONTSET_FROM_ID (id
);
1100 return FONTSET_NAME (fontset
);
1103 /* Return a list of base fontset names matching PATTERN on frame F. */
1106 list_fontsets (f
, pattern
, size
)
1108 Lisp_Object pattern
;
1111 Lisp_Object frame
, regexp
, val
;
1114 XSETFRAME (frame
, f
);
1116 regexp
= fontset_pattern_regexp (pattern
);
1119 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1121 Lisp_Object fontset
;
1122 unsigned char *name
;
1124 fontset
= FONTSET_FROM_ID (id
);
1126 || !BASE_FONTSET_P (fontset
)
1127 || !EQ (frame
, FONTSET_FRAME (fontset
)))
1129 name
= SDATA (FONTSET_NAME (fontset
));
1131 if (STRINGP (regexp
)
1132 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
1133 : strcmp (SDATA (pattern
), name
))
1136 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
1143 /* Free all realized fontsets whose base fontset is BASE. */
1146 free_realized_fontsets (base
)
1152 /* For the moment, this doesn't work because free_realized_face
1153 doesn't remove FACE from a cache. Until we find a solution, we
1154 suppress this code, and simply use Fclear_face_cache even though
1155 that is not efficient. */
1157 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1159 Lisp_Object
this = AREF (Vfontset_table
, id
);
1161 if (EQ (FONTSET_BASE (this), base
))
1165 for (tail
= FONTSET_FACE_ALIST (this); CONSP (tail
);
1168 FRAME_PTR f
= XFRAME (FONTSET_FRAME (this));
1169 int face_id
= XINT (XCDR (XCAR (tail
)));
1170 struct face
*face
= FACE_FROM_ID (f
, face_id
);
1172 /* Face THIS itself is also freed by the following call. */
1173 free_realized_face (f
, face
);
1179 Fclear_face_cache (Qt
);
1184 /* Check validity of NAME as a fontset name and return the
1185 corresponding fontset. If not valid, signal an error.
1186 If NAME is t, return Vdefault_fontset. */
1189 check_fontset_name (name
)
1195 return Vdefault_fontset
;
1197 CHECK_STRING (name
);
1198 id
= fs_query_fontset (name
, 0);
1200 error ("Fontset `%s' does not exist", SDATA (name
));
1201 return FONTSET_FROM_ID (id
);
1205 accumulate_script_ranges (arg
, range
, val
)
1206 Lisp_Object arg
, range
, val
;
1208 if (EQ (XCAR (arg
), val
))
1211 XSETCDR (arg
, Fcons (Fcons (XCAR (range
), XCDR (range
)), XCDR (arg
)));
1213 XSETCDR (arg
, Fcons (Fcons (range
, range
), XCDR (arg
)));
1218 /* Return an ASCII font name generated from fontset name NAME and
1219 ASCII font specification ASCII_SPEC. NAME is a string conforming
1220 to XLFD. ASCII_SPEC is a vector:
1221 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
1223 static INLINE Lisp_Object
1224 generate_ascii_font_name (name
, ascii_spec
)
1225 Lisp_Object name
, ascii_spec
;
1230 vec
= split_font_name_into_vector (name
);
1231 for (i
= FONT_SPEC_FAMILY_INDEX
; i
<= FONT_SPEC_ADSTYLE_INDEX
; i
++)
1232 if (! NILP (AREF (ascii_spec
, i
)))
1233 ASET (vec
, 1 + i
, AREF (ascii_spec
, i
));
1234 if (! NILP (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
)))
1235 ASET (vec
, 12, AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
1236 return build_font_name_from_vector (vec
);
1240 set_fontset_font (arg
, range
)
1241 Lisp_Object arg
, range
;
1243 Lisp_Object fontset
, font_def
, add
;
1245 fontset
= XCAR (arg
);
1246 font_def
= XCAR (XCDR (arg
));
1247 add
= XCAR (XCDR (XCDR (arg
)));
1248 FONTSET_ADD (fontset
, range
, font_def
, add
);
1249 free_realized_fontsets (fontset
);
1253 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 5, 0,
1255 Modify fontset NAME to use FONT-SPEC for CHARACTER.
1257 CHARACTER may be a cons; (FROM . TO), where FROM and TO are
1258 characters. In that case, use FONT-SPEC for all characters in the
1259 range FROM and TO (inclusive).
1261 CHARACTER may be a script name symbol. In that case, use FONT-SPEC
1262 for all characters that belong to the script.
1264 CHARACTER may be a charset. In that case, use FONT-SPEC for all
1265 characters in the charset.
1268 * A vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ].
1269 See the documentation of `set-face-attribute' for the detail of
1270 these vector elements;
1271 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1272 REGISTRY is a font registry name;
1273 * A font name string.
1275 Optional 4th argument FRAME, if non-nil, is a frame. This argument is
1276 kept for backward compatibility and has no meaning.
1278 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1279 to the font specifications for RANGE previously set. If it is
1280 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1281 appended. By default, FONT-SPEC overrides the previous settings. */)
1282 (name
, character
, font_spec
, frame
, add
)
1283 Lisp_Object name
, character
, font_spec
, frame
, add
;
1285 Lisp_Object fontset
;
1286 Lisp_Object font_def
, registry
;
1287 Lisp_Object encoding
, repertory
;
1288 Lisp_Object range_list
;
1290 fontset
= check_fontset_name (name
);
1292 /* The arg FRAME is kept for backward compatibility. We only check
1295 CHECK_LIVE_FRAME (frame
);
1297 if (VECTORP (font_spec
))
1301 if (ASIZE (font_spec
) != FONT_SPEC_MAX_INDEX
)
1302 args_out_of_range (make_number (FONT_SPEC_MAX_INDEX
),
1303 make_number (ASIZE (font_spec
)));
1305 font_spec
= Fcopy_sequence (font_spec
);
1306 for (j
= 0; j
< FONT_SPEC_MAX_INDEX
- 1; j
++)
1307 if (! NILP (AREF (font_spec
, j
)))
1309 CHECK_STRING (AREF (font_spec
, j
));
1310 ASET (font_spec
, j
, Fdowncase (AREF (font_spec
, j
)));
1312 /* REGISTRY should not be omitted. */
1313 CHECK_STRING (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1314 registry
= Fdowncase (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1315 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1318 else if (CONSP (font_spec
))
1322 family
= XCAR (font_spec
);
1323 registry
= XCDR (font_spec
);
1325 if (! NILP (family
))
1327 CHECK_STRING (family
);
1328 family
= Fdowncase (family
);
1330 CHECK_STRING (registry
);
1331 registry
= Fdowncase (registry
);
1332 font_spec
= Fmake_vector (make_number (FONT_SPEC_MAX_INDEX
), Qnil
);
1333 ASET (font_spec
, FONT_SPEC_FAMILY_INDEX
, family
);
1334 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1338 CHECK_STRING (font_spec
);
1339 font_spec
= Fdowncase (font_spec
);
1342 if (STRINGP (font_spec
))
1343 encoding
= find_font_encoding ((char *) SDATA (font_spec
));
1345 encoding
= find_font_encoding ((char *) SDATA (registry
));
1346 if (SYMBOLP (encoding
))
1347 encoding
= repertory
= CHARSET_SYMBOL_ID (encoding
);
1350 repertory
= XCDR (encoding
);
1351 encoding
= CHARSET_SYMBOL_ID (XCAR (encoding
));
1353 font_def
= Fmake_vector (make_number (3), font_spec
);
1354 ASET (font_def
, 1, encoding
);
1355 ASET (font_def
, 2, repertory
);
1357 if (CHARACTERP (character
))
1358 range_list
= Fcons (Fcons (character
, character
), Qnil
);
1359 else if (CONSP (character
))
1361 Lisp_Object from
, to
;
1363 from
= Fcar (character
);
1364 to
= Fcdr (character
);
1365 CHECK_CHARACTER (from
);
1366 CHECK_CHARACTER (to
);
1367 range_list
= Fcons (character
, Qnil
);
1371 Lisp_Object script_list
;
1374 CHECK_SYMBOL (character
);
1376 script_list
= XCHAR_TABLE (Vchar_script_table
)->extras
[0];
1377 if (! NILP (Fmemq (character
, script_list
)))
1379 val
= Fcons (character
, Qnil
);
1380 map_char_table (accumulate_script_ranges
, Qnil
, Vchar_script_table
,
1382 range_list
= XCDR (val
);
1384 else if (CHARSETP (character
))
1386 struct charset
*charset
;
1388 CHECK_CHARSET_GET_CHARSET (character
, charset
);
1389 if (EQ (character
, Qascii
))
1391 if (VECTORP (font_spec
))
1392 font_spec
= generate_ascii_font_name (FONTSET_NAME (fontset
),
1394 FONTSET_ASCII (fontset
) = font_spec
;
1395 range_list
= Fcons (Fcons (make_number (0), make_number (127)),
1400 map_charset_chars (set_fontset_font
, Qnil
,
1401 list3 (fontset
, font_def
, add
), charset
,
1402 CHARSET_MIN_CODE (charset
),
1403 CHARSET_MAX_CODE (charset
));
1408 if (NILP (range_list
))
1409 error ("Invalid script or charset name: %s",
1410 SDATA (SYMBOL_NAME (character
)));
1413 for (; CONSP (range_list
); range_list
= XCDR (range_list
))
1414 FONTSET_ADD (fontset
, XCAR (range_list
), font_def
, add
);
1416 /* Free all realized fontsets whose base is FONTSET. This way, the
1417 specified character(s) are surely redisplayed by a correct
1419 free_realized_fontsets (fontset
);
1425 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
1426 doc
: /* Create a new fontset NAME from font information in FONTLIST.
1428 FONTLIST is an alist of scripts vs the corresponding font specification list.
1429 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1430 character of SCRIPT is displayed by a font that matches one of
1433 SCRIPT is a symbol that appears in the first extra slot of the
1434 char-table `char-script-table'.
1436 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1437 `set-fontset-font' for the meaning. */)
1439 Lisp_Object name
, fontlist
;
1441 Lisp_Object fontset
;
1445 CHECK_STRING (name
);
1446 CHECK_LIST (fontlist
);
1448 id
= fs_query_fontset (name
, 0);
1451 name
= Fdowncase (name
);
1452 val
= split_font_name_into_vector (name
);
1453 if (NILP (val
) || NILP (AREF (val
, 12)) || NILP (AREF (val
, 13)))
1454 error ("Fontset name must be in XLFD format");
1455 if (strcmp (SDATA (AREF (val
, 12)), "fontset"))
1456 error ("Registry field of fontset name must be \"fontset\"");
1457 Vfontset_alias_alist
1458 = Fcons (Fcons (name
,
1459 concat2 (concat2 (AREF (val
, 12), build_string ("-")),
1461 Vfontset_alias_alist
);
1462 ASET (val
, 12, build_string ("iso8859-1"));
1463 fontset
= make_fontset (Qnil
, name
, Qnil
);
1464 FONTSET_ASCII (fontset
) = build_font_name_from_vector (val
);
1468 fontset
= FONTSET_FROM_ID (id
);;
1469 free_realized_fontsets (fontset
);
1470 Fset_char_table_range (fontset
, Qt
, Qnil
);
1473 for (; ! NILP (fontlist
); fontlist
= Fcdr (fontlist
))
1475 Lisp_Object elt
, script
;
1477 elt
= Fcar (fontlist
);
1478 script
= Fcar (elt
);
1480 if (CONSP (elt
) && (NILP (XCDR (elt
)) || CONSP (XCDR (elt
))))
1481 for (; CONSP (elt
); elt
= XCDR (elt
))
1482 Fset_fontset_font (name
, script
, XCAR (elt
), Qnil
, Qappend
);
1484 Fset_fontset_font (name
, script
, elt
, Qnil
, Qappend
);
1490 /* Alist of automatically created fontsets. Each element is a cons
1491 (FONTNAME . FONTSET-ID). */
1492 static Lisp_Object auto_fontset_alist
;
1495 new_fontset_from_font_name (Lisp_Object fontname
)
1502 fontname
= Fdowncase (fontname
);
1503 val
= Fassoc (fontname
, auto_fontset_alist
);
1505 return XINT (XCDR (val
));
1507 vec
= split_font_name_into_vector (fontname
);
1509 vec
= Fmake_vector (make_number (14), build_string (""));
1510 ASET (vec
, 12, build_string ("fontset"));
1511 if (NILP (auto_fontset_alist
))
1513 ASET (vec
, 13, build_string ("startup"));
1514 name
= build_font_name_from_vector (vec
);
1519 int len
= Flength (auto_fontset_alist
);
1521 sprintf (temp
, "auto%d", len
);
1522 ASET (vec
, 13, build_string (temp
));
1523 name
= build_font_name_from_vector (vec
);
1525 name
= Fnew_fontset (name
, Fcons (Fcons (Fcons (make_number (0),
1526 make_number (MAX_CHAR
)),
1527 Fcons (fontname
, Qnil
)),
1529 id
= fs_query_fontset (name
, 0);
1531 = Fcons (Fcons (fontname
, make_number (id
)), auto_fontset_alist
);
1536 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1537 doc
: /* Return information about a font named NAME on frame FRAME.
1538 If FRAME is omitted or nil, use the selected frame.
1539 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1540 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1542 OPENED-NAME is the name used for opening the font,
1543 FULL-NAME is the full name of the font,
1544 SIZE is the maximum bound width of the font,
1545 HEIGHT is the height of the font,
1546 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1547 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1548 how to compose characters.
1549 If the named font is not yet loaded, return nil. */)
1551 Lisp_Object name
, frame
;
1554 struct font_info
*fontp
;
1557 (*check_window_system_func
) ();
1559 CHECK_STRING (name
);
1560 name
= Fdowncase (name
);
1562 frame
= selected_frame
;
1563 CHECK_LIVE_FRAME (frame
);
1566 if (!query_font_func
)
1567 error ("Font query function is not supported");
1569 fontp
= (*query_font_func
) (f
, SDATA (name
));
1573 info
= Fmake_vector (make_number (7), Qnil
);
1575 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1576 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1577 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1578 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1579 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1580 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1581 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1587 /* Return the font name for the character at POSITION in the current
1588 buffer. This is computed from all the text properties and overlays
1589 that apply to POSITION. It returns nil in the following cases:
1591 (1) The window system doesn't have a font for the character (thus
1592 it is displayed by an empty box).
1594 (2) The character code is invalid.
1596 (3) The current buffer is not displayed in any window.
1598 In addition, the returned font name may not take into account of
1599 such redisplay engine hooks as what used in jit-lock-mode if
1600 POSITION is currently not visible. */
1603 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1604 doc
: /* For internal use only. */)
1606 Lisp_Object position
;
1608 int pos
, pos_byte
, dummy
;
1616 CHECK_NUMBER_COERCE_MARKER (position
);
1617 pos
= XINT (position
);
1618 if (pos
< BEGV
|| pos
>= ZV
)
1619 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1620 pos_byte
= CHAR_TO_BYTE (pos
);
1621 c
= FETCH_CHAR (pos_byte
);
1622 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1625 w
= XWINDOW (window
);
1626 f
= XFRAME (w
->frame
);
1627 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1628 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
, pos
, Qnil
);
1629 face
= FACE_FROM_ID (f
, face_id
);
1630 return (face
->font
&& face
->font_name
1631 ? build_string (face
->font_name
)
1636 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1637 doc
: /* Return information about a fontset FONTSET on frame FRAME.
1638 The value is a char-table of which elements has this form.
1640 ((FONT-PATTERN OPENED-FONT ...) ...)
1642 FONT-PATTERN is a vector:
1644 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
1646 or a string of font name pattern.
1648 OPENED-FONT is a name of a font actually opened.
1650 The char-table has one extra slot. The value is a char-table
1651 containing the information about the derived fonts from the default
1652 fontset. The format is the same as abobe. */)
1654 Lisp_Object fontset
, frame
;
1657 Lisp_Object table
, val
, elt
;
1658 Lisp_Object
*realized
;
1663 (*check_window_system_func
) ();
1665 fontset
= check_fontset_name (fontset
);
1668 frame
= selected_frame
;
1669 CHECK_LIVE_FRAME (frame
);
1672 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1673 in the table `realized'. */
1674 realized
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1675 * ASIZE (Vfontset_table
));
1676 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1678 elt
= FONTSET_FROM_ID (i
);
1680 && EQ (FONTSET_BASE (elt
), fontset
)
1681 && EQ (FONTSET_FRAME (elt
), frame
))
1682 realized
[n_realized
++] = elt
;
1686 table
= Fmake_char_table (Qfontset_info
, Qnil
);
1687 XCHAR_TABLE (table
)->extras
[0] = Fmake_char_table (Qnil
, Qnil
);
1688 /* Accumulate information of the fontset in TABLE. The format of
1689 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1690 for (fallback
= 0; fallback
<= 1; fallback
++)
1692 Lisp_Object this_fontset
, this_table
;
1696 this_fontset
= fontset
;
1701 this_fontset
= Vdefault_fontset
;
1702 this_table
= XCHAR_TABLE (table
)->extras
[0];
1704 for (i
= 0; i
< n_realized
; i
++)
1705 realized
[i
] = FONTSET_FALLBACK (realized
[i
]);
1708 for (c
= 0; c
<= MAX_5_BYTE_CHAR
; )
1712 val
= char_table_ref_and_range (this_fontset
, c
, &from
, &to
);
1717 /* At first, set ALIST to ((FONT-SPEC) ...). */
1718 for (alist
= Qnil
, i
= 0; i
< ASIZE (val
); i
++)
1719 alist
= Fcons (Fcons (AREF (AREF (val
, i
), 0), Qnil
), alist
);
1720 alist
= Fnreverse (alist
);
1722 /* Then store opend font names to cdr of each elements. */
1723 for (i
= 0; i
< n_realized
; i
++)
1725 if (NILP (realized
[i
]))
1727 val
= FONTSET_REF (realized
[i
], c
);
1730 /* VAL is [int int int [FACE-ID FONT-INDEX FONT-DEF] ...].
1731 If a font of an element is already opened,
1732 FONT-INDEX of the element is integer. */
1733 for (j
= 3; j
< ASIZE (val
); j
++)
1734 if (INTEGERP (AREF (AREF (val
, j
), 0)))
1736 Lisp_Object font_idx
;
1738 font_idx
= AREF (AREF (val
, j
), 1);
1739 elt
= Fassq (AREF (AREF (AREF (val
, j
), 2), 0), alist
);
1741 && NILP (Fmemq (font_idx
, XCDR(elt
))))
1742 nconc2 (elt
, Fcons (font_idx
, Qnil
));
1745 for (val
= alist
; CONSP (val
); val
= XCDR (val
))
1746 for (elt
= XCDR (XCAR (val
)); CONSP (elt
); elt
= XCDR (elt
))
1748 struct font_info
*font_info
1749 = (*get_font_info_func
) (f
, XINT (XCAR (elt
)));
1750 XSETCAR (elt
, build_string (font_info
->full_name
));
1753 /* Store ALIST in TBL for characters C..TO. */
1754 char_table_set_range (this_table
, c
, to
, alist
);
1764 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1765 doc
: /* Return a font name pattern for character CH in fontset NAME.
1766 If NAME is t, find a font name pattern in the default fontset. */)
1768 Lisp_Object name
, ch
;
1771 Lisp_Object fontset
, elt
;
1773 fontset
= check_fontset_name (name
);
1775 CHECK_CHARACTER (ch
);
1777 elt
= FONTSET_REF (fontset
, c
);
1778 return Fcopy_sequence (elt
);
1781 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1782 doc
: /* Return a list of all defined fontset names. */)
1785 Lisp_Object fontset
, list
;
1789 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1791 fontset
= FONTSET_FROM_ID (i
);
1793 && BASE_FONTSET_P (fontset
))
1794 list
= Fcons (FONTSET_NAME (fontset
), list
);
1801 #ifdef FONTSET_DEBUG
1804 dump_fontset (fontset
)
1805 Lisp_Object fontset
;
1809 vec
= Fmake_vector (make_number (3), Qnil
);
1810 ASET (vec
, 0, FONTSET_ID (fontset
));
1812 if (BASE_FONTSET_P (fontset
))
1814 ASET (vec
, 1, FONTSET_NAME (fontset
));
1820 frame
= FONTSET_FRAME (fontset
);
1823 FRAME_PTR f
= XFRAME (frame
);
1825 if (FRAME_LIVE_P (f
))
1826 ASET (vec
, 1, f
->name
);
1830 if (!NILP (FONTSET_FALLBACK (fontset
)))
1831 ASET (vec
, 2, FONTSET_ID (FONTSET_FALLBACK (fontset
)));
1836 DEFUN ("fontset-list-all", Ffontset_list_all
, Sfontset_list_all
, 0, 0, 0,
1837 doc
: /* Return a brief summary of all fontsets for debug use. */)
1843 for (i
= 0, val
= Qnil
; i
< ASIZE (Vfontset_table
); i
++)
1844 if (! NILP (AREF (Vfontset_table
, i
)))
1845 val
= Fcons (dump_fontset (AREF (Vfontset_table
, i
)), val
);
1846 return (Fnreverse (val
));
1848 #endif /* FONTSET_DEBUG */
1853 if (!load_font_func
)
1854 /* Window system initializer should have set proper functions. */
1857 DEFSYM (Qfontset
, "fontset");
1858 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (8));
1859 DEFSYM (Qfontset_info
, "fontset-info");
1860 Fput (Qfontset_info
, Qchar_table_extra_slots
, make_number (1));
1862 DEFSYM (Qprepend
, "prepend");
1863 DEFSYM (Qappend
, "append");
1865 Vcached_fontset_data
= Qnil
;
1866 staticpro (&Vcached_fontset_data
);
1868 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1869 staticpro (&Vfontset_table
);
1871 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1872 staticpro (&Vdefault_fontset
);
1873 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1874 FONTSET_NAME (Vdefault_fontset
)
1875 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1877 Lisp_Object default_ascii_font
;
1879 #if defined (macintosh)
1881 = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman");
1882 #elif defined (WINDOWSNT)
1884 = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
1887 = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
1889 FONTSET_ASCII (Vdefault_fontset
) = default_ascii_font
;
1891 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1892 next_fontset_id
= 1;
1894 auto_fontset_alist
= Qnil
;
1895 staticpro (&auto_fontset_alist
);
1897 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1899 Alist of fontname patterns vs the corresponding encoding and repertory info.
1900 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
1901 where ENCODING is a charset or a char-table,
1902 and REPERTORY is a charset, a char-table, or nil.
1904 ENCODING is for converting a character to a glyph code of the font.
1905 If ENCODING is a charset, encoding a character by the charset gives
1906 the corresponding glyph code. If ENCODING is a char-table, looking up
1907 the table by a character gives the corresponding glyph code.
1909 REPERTORY specifies a repertory of characters supported by the font.
1910 If REPERTORY is a charset, all characters beloging to the charset are
1911 supported. If REPERTORY is a char-table, all characters who have a
1912 non-nil value in the table are supported. It REPERTORY is nil, Emacs
1913 gets the repertory information by an opened font and ENCODING. */);
1914 Vfont_encoding_alist
= Qnil
;
1916 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1918 Char table of characters whose ascent values should be ignored.
1919 If an entry for a character is non-nil, the ascent value of the glyph
1920 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
1922 This affects how a composite character which contains
1923 such a character is displayed on screen. */);
1924 Vuse_default_ascent
= Qnil
;
1926 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1928 Char table of characters which is not composed relatively.
1929 If an entry for a character is non-nil, a composition sequence
1930 which contains that character is displayed so that
1931 the glyph of that character is put without considering
1932 an ascent and descent value of a previous character. */);
1933 Vignore_relative_composition
= Qnil
;
1935 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1936 doc
: /* Alist of fontname vs list of the alternate fontnames.
1937 When a specified font name is not found, the corresponding
1938 alternate fontnames (if any) are tried instead. */);
1939 Valternate_fontname_alist
= Qnil
;
1941 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1942 doc
: /* Alist of fontset names vs the aliases. */);
1943 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1944 build_string ("fontset-default")),
1947 DEFVAR_LISP ("vertical-centering-font-regexp",
1948 &Vvertical_centering_font_regexp
,
1949 doc
: /* *Regexp matching font names that require vertical centering on display.
1950 When a character is displayed with such fonts, the character is displayed
1951 at the vertical center of lines. */);
1952 Vvertical_centering_font_regexp
= Qnil
;
1954 defsubr (&Squery_fontset
);
1955 defsubr (&Snew_fontset
);
1956 defsubr (&Sset_fontset_font
);
1957 defsubr (&Sfont_info
);
1958 defsubr (&Sinternal_char_font
);
1959 defsubr (&Sfontset_info
);
1960 defsubr (&Sfontset_font
);
1961 defsubr (&Sfontset_list
);
1962 #ifdef FONTSET_DEBUG
1963 defsubr (&Sfontset_list_all
);