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 . FONT-VECTOR )
104 FONT-VECTOR is a vector whose elements have this form:
106 [ FACE-ID FONT-INDEX FONT-DEF ]
108 FONT-VECTOR is automatically reordered by the current charset
111 The value nil means that we have not yet generated FONT-VECTOR from
112 the base of the fontset.
114 The value t means that no font is available for the corresponding
118 A fontset has 8 extra slots.
120 The 1st slot: the ID number of the fontset
123 base: the name of the fontset
128 realized: the base fontset
132 realized: the frame that the fontset belongs to
135 base: the font name for ASCII characters
140 realized: the ID number of a face to use for characters that
141 has no font in a realized fontset.
145 realized: Alist of font index vs the corresponding repertory
150 realized: If the base is not the default fontset, a fontset
151 realized from the default fontset, else nil.
153 All fontsets are recorded in the vector Vfontset_table.
158 There's a special base fontset named `default fontset' which
159 defines the default font specifications. When a base fontset
160 doesn't specify a font for a specific character, the corresponding
161 value in the default fontset is used.
163 The parent of a realized fontset created for such a face that has
164 no fontset is the default fontset.
167 These structures are hidden from the other codes than this file.
168 The other codes handle fontsets only by their ID numbers. They
169 usually use the variable name `fontset' for IDs. But, in this
170 file, we always use varialbe name `id' for IDs, and name `fontset'
171 for an actual fontset object, i.e., char-table.
175 /********** VARIABLES and FUNCTION PROTOTYPES **********/
177 extern Lisp_Object Qfont
;
178 static Lisp_Object Qfontset
;
179 static Lisp_Object Qfontset_info
;
180 static Lisp_Object Qprepend
, Qappend
;
182 /* Vector containing all fontsets. */
183 static Lisp_Object Vfontset_table
;
185 /* Next possibly free fontset ID. Usually this keeps the minimum
186 fontset ID not yet used. */
187 static int next_fontset_id
;
189 /* The default fontset. This gives default FAMILY and REGISTRY of
190 font for each character. */
191 static Lisp_Object Vdefault_fontset
;
193 Lisp_Object Vfont_encoding_alist
;
194 Lisp_Object Vuse_default_ascent
;
195 Lisp_Object Vignore_relative_composition
;
196 Lisp_Object Valternate_fontname_alist
;
197 Lisp_Object Vfontset_alias_alist
;
198 Lisp_Object Vvertical_centering_font_regexp
;
200 /* The following six are declarations of callback functions depending
201 on window system. See the comments in src/fontset.h for more
204 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
205 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
207 /* Return a list of font names which matches PATTERN. See the documentation
208 of `x-list-fonts' for more details. */
209 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
214 /* Load a font named NAME for frame F and return a pointer to the
215 information of the loaded font. If loading is failed, return 0. */
216 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
218 /* Return a pointer to struct font_info of a font named NAME for frame F. */
219 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
221 /* Additional function for setting fontset or changing fontset
222 contents of frame F. */
223 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
224 Lisp_Object oldval
));
226 /* To find a CCL program, fs_load_font calls this function.
227 The argument is a pointer to the struct font_info.
228 This function set the member `encoder' of the structure. */
229 void (*find_ccl_program_func
) P_ ((struct font_info
*));
231 Lisp_Object (*get_font_repertory_func
) P_ ((struct frame
*,
232 struct font_info
*));
234 /* Check if any window system is used now. */
235 void (*check_window_system_func
) P_ ((void));
238 /* Prototype declarations for static functions. */
239 static Lisp_Object fontset_add
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
241 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
242 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
243 static void accumulate_script_ranges
P_ ((Lisp_Object
, Lisp_Object
,
245 static Lisp_Object find_font_encoding
P_ ((char *));
247 static void set_fontset_font
P_ ((Lisp_Object
, Lisp_Object
));
251 /* Return 1 if ID is a valid fontset id, else return 0. */
254 fontset_id_valid_p (id
)
257 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
264 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
266 /* Return the fontset with ID. No check of ID's validness. */
267 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
269 /* Macros to access special values of FONTSET. */
270 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
272 /* Macros to access special values of (base) FONTSET. */
273 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
274 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
276 /* Macros to access special values of (realized) FONTSET. */
277 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
278 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
279 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
280 #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
281 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[7]
283 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
286 /* Return the element of FONTSET for the character C. If FONTSET is a
287 base fontset other then the default fontset and FONTSET doesn't
288 contain information for C, return the information in the default
291 #define FONTSET_REF(fontset, c) \
292 (EQ (fontset, Vdefault_fontset) \
293 ? CHAR_TABLE_REF (fontset, c) \
294 : fontset_ref ((fontset), (c)))
297 fontset_ref (fontset
, c
)
303 elt
= CHAR_TABLE_REF (fontset
, c
);
304 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
305 /* Don't check Vdefault_fontset for a realized fontset. */
306 && NILP (FONTSET_BASE (fontset
)))
307 elt
= CHAR_TABLE_REF (Vdefault_fontset
, c
);
312 /* Return the element of FONTSET for the character C, set FROM and TO
313 to the range of characters around C that have the same value as C.
314 If FONTSET is a base fontset other then the default fontset and
315 FONTSET doesn't contain information for C, return the information
316 in the default fontset. */
318 #define FONTSET_REF_AND_RANGE(fontset, c, form, to) \
319 (EQ (fontset, Vdefault_fontset) \
320 ? char_table_ref_and_range (fontset, c, &from, &to) \
321 : fontset_ref_and_range (fontset, c, &from, &to))
324 fontset_ref_and_range (fontset
, c
, from
, to
)
331 elt
= char_table_ref_and_range (fontset
, c
, from
, to
);
332 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
333 /* Don't check Vdefault_fontset for a realized fontset. */
334 && NILP (FONTSET_BASE (fontset
)))
338 elt
= char_table_ref_and_range (Vdefault_fontset
, c
, &from1
, &to1
);
348 /* Set elements of FONTSET for characters in RANGE to the value ELT.
349 RANGE is a cons (FROM . TO), where FROM and TO are character codes
350 specifying a range. */
352 #define FONTSET_SET(fontset, range, elt) \
353 Fset_char_table_range ((fontset), (range), (elt))
356 /* Modify the elements of FONTSET for characters in RANGE by replacing
357 with ELT or adding ETL. RANGE is a cons (FROM . TO), where FROM
358 and TO are character codes specifying a range. If ADD is nil,
359 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
362 #define FONTSET_ADD(fontset, range, elt, add) \
364 ? Fset_char_table_range ((fontset), (range), \
365 Fmake_vector (make_number (1), (elt))) \
366 : fontset_add ((fontset), (range), (elt), (add)))
369 fontset_add (fontset
, range
, elt
, add
)
370 Lisp_Object fontset
, range
, elt
, add
;
372 int from
, to
, from1
, to1
;
375 from
= XINT (XCAR (range
));
376 to
= XINT (XCDR (range
));
378 elt1
= char_table_ref_and_range (fontset
, from
, &from1
, &to1
);
382 elt1
= Fmake_vector (make_number (1), elt
);
385 int i
, i0
= 1, i1
= ASIZE (elt1
) + 1;
388 new = Fmake_vector (make_number (i1
), elt
);
389 if (EQ (add
, Qappend
))
391 for (i
= 0; i0
< i1
; i
++, i0
++)
392 ASET (new, i0
, AREF (elt1
, i
));
395 char_table_set_range (fontset
, from
, to1
, elt1
);
402 /* Update FONTSET_ELEMENT which has this form:
403 ( CHARSET-PRIORITY-LIST-TICK . FONT-VECTOR).
404 Reorder FONT-VECTOR according to the current order of charset
405 (Vcharset_ordered_list), and update CHARSET-PRIORITY-LIST-TICK to
409 reorder_font_vector (fontset_element
)
410 Lisp_Object fontset_element
;
412 Lisp_Object vec
, list
, *new_vec
;
414 int *charset_id_table
;
417 XSETCAR (fontset_element
, make_number (charset_ordered_list_tick
));
418 vec
= XCDR (fontset_element
);
421 /* No need of reordering VEC. */
423 charset_id_table
= (int *) alloca (sizeof (int) * size
);
424 new_vec
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
) * size
);
425 /* At first, extract ENCODING (a chaset ID) from VEC. VEC has this
427 [[FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] ...] */
428 for (i
= 0; i
< size
; i
++)
429 charset_id_table
[i
] = XINT (AREF (AREF (AREF (vec
, i
), 2), 1));
431 /* Then, store the elements of VEC in NEW_VEC in the correct
434 for (list
= Vcharset_ordered_list
; CONSP (list
); list
= XCDR (list
))
436 for (i
= 0; i
< size
; i
++)
437 if (charset_id_table
[i
] == XINT (XCAR (list
)))
438 new_vec
[idx
++] = AREF (vec
, i
);
443 /* At last, update VEC. */
444 for (i
= 0; i
< size
; i
++)
445 ASET (vec
, i
, new_vec
[i
]);
449 /* Load a font matching the font related attributes in FACE->lface and
450 font pattern in FONT_DEF of FONTSET, and return an index of the
451 font. FONT_DEF has this form:
452 [ FONT-SPEC ENCODING REPERTORY ]
453 If REPERTORY is nil, generate a char-table representing the font
454 repertory by looking into the font itself. */
457 load_font_get_repertory (f
, face
, font_def
, fontset
)
460 Lisp_Object font_def
;
464 struct font_info
*font_info
;
467 font_name
= choose_face_font (f
, face
->lface
, AREF (font_def
, 0), NULL
);
468 if (NATNUMP (AREF (font_def
, 1)))
469 charset
= XINT (AREF (font_def
, 1));
472 if (! (font_info
= fs_load_font (f
, font_name
, charset
)))
475 if (NILP (AREF (font_def
, 2))
476 && NILP (Fassq (make_number (font_info
->font_idx
),
477 FONTSET_REPERTORY (fontset
))))
479 /* We must look into the font to get the correct repertory as a
481 Lisp_Object repertory
;
483 repertory
= (*get_font_repertory_func
) (f
, font_info
);
484 FONTSET_REPERTORY (fontset
)
485 = Fcons (Fcons (make_number (font_info
->font_idx
), repertory
),
486 FONTSET_REPERTORY (fontset
));
489 return font_info
->font_idx
;
493 /* Return a face ID registerd in the realized fontset FONTSET for the
494 character C. If FACE is NULL, return -1 if a face is not yet
495 set. Otherwise, realize a proper face from FACE and return it. */
498 fontset_face (fontset
, c
, face
)
503 Lisp_Object base_fontset
, elt
, vec
;
506 FRAME_PTR f
= XFRAME (FONTSET_FRAME (fontset
));
508 base_fontset
= FONTSET_BASE (fontset
);
509 elt
= CHAR_TABLE_REF (fontset
, c
);
516 /* We have not yet decided a face for C. */
521 elt
= FONTSET_REF_AND_RANGE (base_fontset
, c
, from
, to
);
522 range
= Fcons (make_number (from
), make_number (to
));
525 /* Record that we have no font for characters of this
527 FONTSET_SET (fontset
, range
, Qt
);
530 elt
= Fcopy_sequence (elt
);
531 /* Now ELT is a vector of FONT-DEFs. We at first change it to
532 FONT-VECTOR, a vector of [ nil nil FONT-DEF ]. */
533 for (i
= 0; i
< ASIZE (elt
); i
++)
537 tmp
= Fmake_vector (make_number (3), Qnil
);
538 ASET (tmp
, 2, AREF (elt
, i
));
541 /* Then store (-1 . FONT-VECTOR) in the fontset. -1 is to force
542 reordering of FONT-VECTOR. */
543 elt
= Fcons (make_number (-1), elt
);
544 FONTSET_SET (fontset
, range
, elt
);
547 if (XINT (XCAR (elt
)) != charset_ordered_list_tick
)
548 /* The priority of charsets is changed after we selected a face
550 reorder_font_vector (elt
);
553 /* Find the first available font in the font vector VEC. */
554 for (i
= 0; i
< ASIZE (vec
); i
++)
556 Lisp_Object font_def
;
559 /* ELT == [ FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ] ] */
560 font_def
= AREF (elt
, 2);
561 if (INTEGERP (AREF (elt
, 1)) && XINT (AREF (elt
, 1)) < 0)
562 /* We couldn't open this font last time. */
565 if (!face
&& (NILP (AREF (elt
, 1)) || NILP (AREF (elt
, 0))))
566 /* We have not yet opened the font, or we have not yet made a
567 realized face for the font. */
570 if (INTEGERP (AREF (font_def
, 2)))
572 /* The repertory is specified by charset ID. */
573 struct charset
*charset
574 = CHARSET_FROM_ID (XINT (AREF (font_def
, 2)));
576 if (! CHAR_CHARSET_P (c
, charset
))
577 /* This font can't display C. */
584 if (! INTEGERP (AREF (elt
, 1)))
586 /* We have not yet opened a font matching this spec.
587 Open the best matching font now and register the
589 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
590 ASET (elt
, 1, make_number (font_idx
));
592 /* This means that we couldn't find a font matching
597 slot
= Fassq (AREF (elt
, 1), FONTSET_REPERTORY (fontset
));
600 if (NILP (CHAR_TABLE_REF (XCDR (slot
), c
)))
601 /* This fond can't display C. */
605 /* Now we have decided to use this font spec to display C. */
606 if (INTEGERP (AREF (elt
, 1)))
607 font_idx
= XINT (AREF (elt
, 1));
610 /* But not yet opened the best matching font. */
611 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
612 ASET (elt
, 1, make_number (font_idx
));
617 /* Now we have the opened font. */
618 if (NILP (AREF (elt
, 0)))
620 /* But not yet made a realized face that uses this font. */
621 int face_id
= lookup_non_ascii_face (f
, font_idx
, face
);
623 ASET (elt
, 0, make_number (face_id
));
626 /* Ok, this face can display C. */
627 return XINT (AREF (elt
, 0));
631 if (! EQ (base_fontset
, Vdefault_fontset
))
633 if (NILP (FONTSET_FALLBACK (fontset
)))
634 FONTSET_FALLBACK (fontset
)
635 = make_fontset (FONTSET_FRAME (fontset
), Qnil
, Vdefault_fontset
);
636 return fontset_face (FONTSET_FALLBACK (fontset
), c
, face
);
639 /* We have tried all the fonts for C, but none of them can be opened
640 nor can display C. */
641 if (NILP (FONTSET_NOFONT_FACE (fontset
)))
647 face_id
= lookup_non_ascii_face (f
, -1, face
);
648 FONTSET_NOFONT_FACE (fontset
) = make_number (face_id
);
650 return XINT (FONTSET_NOFONT_FACE (fontset
));
654 /* Return a newly created fontset with NAME. If BASE is nil, make a
655 base fontset. Otherwise make a realized fontset whose base is
659 make_fontset (frame
, name
, base
)
660 Lisp_Object frame
, name
, base
;
663 int size
= ASIZE (Vfontset_table
);
664 int id
= next_fontset_id
;
666 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
667 the next available fontset ID. So it is expected that this loop
668 terminates quickly. In addition, as the last element of
669 Vfontset_table is always nil, we don't have to check the range of
671 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
675 /* We must grow Vfontset_table. */
679 tem
= Fmake_vector (make_number (size
+ 32), Qnil
);
680 for (i
= 0; i
< size
; i
++)
681 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
682 Vfontset_table
= tem
;
685 fontset
= Fmake_char_table (Qfontset
, Qnil
);
687 FONTSET_ID (fontset
) = make_number (id
);
690 FONTSET_NAME (fontset
) = name
;
694 FONTSET_NAME (fontset
) = Qnil
;
695 FONTSET_FRAME (fontset
) = frame
;
696 FONTSET_BASE (fontset
) = base
;
699 ASET (Vfontset_table
, id
, fontset
);
700 next_fontset_id
= id
+ 1;
706 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
708 /* Return the name of the fontset who has ID. */
716 fontset
= FONTSET_FROM_ID (id
);
717 return FONTSET_NAME (fontset
);
721 /* Return the ASCII font name of the fontset who has ID. */
727 Lisp_Object fontset
, elt
;
729 fontset
= FONTSET_FROM_ID (id
);
730 elt
= FONTSET_ASCII (fontset
);
731 /* It is assured that ELT is always a string (i.e. fontname
737 /* Free fontset of FACE defined on frame F. Called from
738 free_realized_face. */
741 free_face_fontset (f
, face
)
747 fontset
= AREF (Vfontset_table
, face
->fontset
);
748 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
749 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
750 ASET (Vfontset_table
, face
->fontset
, Qnil
);
751 if (face
->fontset
< next_fontset_id
)
752 next_fontset_id
= face
->fontset
;
753 if (! NILP (FONTSET_FALLBACK (fontset
)))
755 int id
= FONTSET_ID (FONTSET_FALLBACK (fontset
));
757 fontset
= AREF (Vfontset_table
, id
);
758 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
759 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
760 ASET (Vfontset_table
, id
, Qnil
);
761 if (id
< next_fontset_id
)
762 next_fontset_id
= face
->fontset
;
767 /* Return 1 iff FACE is suitable for displaying character C.
768 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
769 when C is not an ASCII character. */
772 face_suitable_for_char_p (face
, c
)
778 fontset
= FONTSET_FROM_ID (face
->fontset
);
779 return (face
->id
== fontset_face (fontset
, c
, NULL
));
783 /* Return ID of face suitable for displaying character C on frame F.
784 FACE must be reazlied for ASCII characters in advance. Called from
785 the macro FACE_FOR_CHAR. */
788 face_for_char (f
, face
, c
)
795 if (ASCII_CHAR_P (c
))
796 return face
->ascii_face
->id
;
798 xassert (fontset_id_valid_p (face
->fontset
));
799 fontset
= FONTSET_FROM_ID (face
->fontset
);
800 xassert (!BASE_FONTSET_P (fontset
));
801 return fontset_face (fontset
, c
, face
);
805 /* Make a realized fontset for ASCII face FACE on frame F from the
806 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
807 default fontset as the base. Value is the id of the new fontset.
808 Called from realize_x_face. */
811 make_fontset_for_ascii_face (f
, base_fontset_id
, face
)
816 Lisp_Object base_fontset
, fontset
, frame
;
818 XSETFRAME (frame
, f
);
819 if (base_fontset_id
>= 0)
821 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
822 if (!BASE_FONTSET_P (base_fontset
))
823 base_fontset
= FONTSET_BASE (base_fontset
);
824 xassert (BASE_FONTSET_P (base_fontset
));
825 if (! BASE_FONTSET_P (base_fontset
))
829 base_fontset
= Vdefault_fontset
;
831 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
835 elt
= FONTSET_REF (base_fontset
, 0);
836 elt
= Fmake_vector (make_number (3), AREF (elt
, 0));
837 ASET (elt
, 0, make_number (face
->id
));
838 ASET (elt
, 1, make_number (face
->font_info_id
));
839 elt
= Fcons (make_number (charset_ordered_list_tick
),
840 Fmake_vector (make_number (1), elt
));
841 char_table_set_range (fontset
, 0, 127, elt
);
843 return XINT (FONTSET_ID (fontset
));
847 #if defined(WINDOWSNT) && defined (_MSC_VER)
848 #pragma optimize("", off)
851 /* Load a font named FONTNAME on frame F. Return a pointer to the
852 struct font_info of the loaded font. If loading fails, return
853 NULL. CHARSET is an ID of charset to encode characters for this
854 font. If it is -1, find one from Vfont_encoding_alist. */
857 fs_load_font (f
, fontname
, charset
)
862 struct font_info
*fontp
;
865 /* No way to get fontname. */
868 fontp
= (*load_font_func
) (f
, fontname
, 0);
869 if (! fontp
|| fontp
->charset
>= 0)
872 fontname
= fontp
->full_name
;
876 Lisp_Object charset_symbol
;
878 charset_symbol
= find_font_encoding (fontname
);
879 if (CONSP (charset_symbol
))
880 charset_symbol
= XCAR (charset_symbol
);
881 charset
= XINT (CHARSET_SYMBOL_ID (charset_symbol
));
883 fontp
->charset
= charset
;
884 fontp
->vertical_centering
= 0;
885 fontp
->font_encoder
= NULL
;
887 if (charset
!= charset_ascii
)
889 fontp
->vertical_centering
890 = (STRINGP (Vvertical_centering_font_regexp
)
891 && (fast_c_string_match_ignore_case
892 (Vvertical_centering_font_regexp
, fontname
) >= 0));
894 if (find_ccl_program_func
)
895 (*find_ccl_program_func
) (fontp
);
901 #if defined(WINDOWSNT) && defined (_MSC_VER)
902 #pragma optimize("", on)
906 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
907 FONTNAME. ENCODING is a charset symbol that specifies the encoding
908 of the font. REPERTORY is a charset symbol or nil. */
912 find_font_encoding (fontname
)
915 Lisp_Object tail
, elt
;
917 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
921 && STRINGP (XCAR (elt
))
922 && fast_c_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
923 && (SYMBOLP (XCDR (elt
))
924 ? CHARSETP (XCDR (elt
))
925 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
928 /* We don't know the encoding of this font. Let's assume Unicode
934 /* Cache data used by fontset_pattern_regexp. The car part is a
935 pattern string containing at least one wild card, the cdr part is
936 the corresponding regular expression. */
937 static Lisp_Object Vcached_fontset_data
;
939 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
940 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
942 /* If fontset name PATTERN contains any wild card, return regular
943 expression corresponding to PATTERN. */
946 fontset_pattern_regexp (pattern
)
949 if (!index (SDATA (pattern
), '*')
950 && !index (SDATA (pattern
), '?'))
951 /* PATTERN does not contain any wild cards. */
954 if (!CONSP (Vcached_fontset_data
)
955 || strcmp (SDATA (pattern
), CACHED_FONTSET_NAME
))
957 /* We must at first update the cached data. */
958 char *regex
= (char *) alloca (SCHARS (pattern
) * 2 + 3);
959 char *p0
, *p1
= regex
;
961 /* Convert "*" to ".*", "?" to ".". */
963 for (p0
= (char *) SDATA (pattern
); *p0
; p0
++)
978 Vcached_fontset_data
= Fcons (build_string (SDATA (pattern
)),
979 build_string (regex
));
982 return CACHED_FONTSET_REGEX
;
985 /* Return ID of the base fontset named NAME. If there's no such
986 fontset, return -1. */
989 fs_query_fontset (name
, regexpp
)
996 name
= Fdowncase (name
);
999 tem
= Frassoc (name
, Vfontset_alias_alist
);
1000 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1004 tem
= fontset_pattern_regexp (name
);
1013 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1015 Lisp_Object fontset
;
1016 unsigned char *this_name
;
1018 fontset
= FONTSET_FROM_ID (i
);
1020 || !BASE_FONTSET_P (fontset
))
1023 this_name
= SDATA (FONTSET_NAME (fontset
));
1025 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
1026 : !strcmp (SDATA (name
), this_name
))
1033 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
1034 doc
: /* Return the name of a fontset that matches PATTERN.
1035 The value is nil if there is no matching fontset.
1036 PATTERN can contain `*' or `?' as a wildcard
1037 just as X font name matching algorithm allows.
1038 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1040 Lisp_Object pattern
, regexpp
;
1042 Lisp_Object fontset
;
1045 (*check_window_system_func
) ();
1047 CHECK_STRING (pattern
);
1049 if (SCHARS (pattern
) == 0)
1052 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
1056 fontset
= FONTSET_FROM_ID (id
);
1057 return FONTSET_NAME (fontset
);
1060 /* Return a list of base fontset names matching PATTERN on frame F. */
1063 list_fontsets (f
, pattern
, size
)
1065 Lisp_Object pattern
;
1068 Lisp_Object frame
, regexp
, val
;
1071 XSETFRAME (frame
, f
);
1073 regexp
= fontset_pattern_regexp (pattern
);
1076 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1078 Lisp_Object fontset
;
1079 unsigned char *name
;
1081 fontset
= FONTSET_FROM_ID (id
);
1083 || !BASE_FONTSET_P (fontset
)
1084 || !EQ (frame
, FONTSET_FRAME (fontset
)))
1086 name
= SDATA (FONTSET_NAME (fontset
));
1088 if (STRINGP (regexp
)
1089 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
1090 : strcmp (SDATA (pattern
), name
))
1093 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
1100 /* Free all realized fontsets whose base fontset is BASE. */
1103 free_realized_fontsets (base
)
1109 /* For the moment, this doesn't work because free_realized_face
1110 doesn't remove FACE from a cache. Until we find a solution, we
1111 suppress this code, and simply use Fclear_face_cache even though
1112 that is not efficient. */
1114 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1116 Lisp_Object
this = AREF (Vfontset_table
, id
);
1118 if (EQ (FONTSET_BASE (this), base
))
1122 for (tail
= FONTSET_FACE_ALIST (this); CONSP (tail
);
1125 FRAME_PTR f
= XFRAME (FONTSET_FRAME (this));
1126 int face_id
= XINT (XCDR (XCAR (tail
)));
1127 struct face
*face
= FACE_FROM_ID (f
, face_id
);
1129 /* Face THIS itself is also freed by the following call. */
1130 free_realized_face (f
, face
);
1136 Fclear_face_cache (Qt
);
1141 /* Check validity of NAME as a fontset name and return the
1142 corresponding fontset. If not valid, signal an error.
1143 If NAME is t, return Vdefault_fontset. */
1146 check_fontset_name (name
)
1152 return Vdefault_fontset
;
1154 CHECK_STRING (name
);
1155 id
= fs_query_fontset (name
, 0);
1157 error ("Fontset `%s' does not exist", SDATA (name
));
1158 return FONTSET_FROM_ID (id
);
1162 accumulate_script_ranges (arg
, range
, val
)
1163 Lisp_Object arg
, range
, val
;
1165 if (EQ (XCAR (arg
), val
))
1168 XSETCDR (arg
, Fcons (Fcons (XCAR (range
), XCDR (range
)), XCDR (arg
)));
1170 XSETCDR (arg
, Fcons (Fcons (range
, range
), XCDR (arg
)));
1175 /* Return an ASCII font name generated from fontset name NAME and
1176 ASCII font specification ASCII_SPEC. NAME is a string conforming
1177 to XLFD. ASCII_SPEC is a vector:
1178 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
1180 static INLINE Lisp_Object
1181 generate_ascii_font_name (name
, ascii_spec
)
1182 Lisp_Object name
, ascii_spec
;
1187 vec
= split_font_name_into_vector (name
);
1188 for (i
= FONT_SPEC_FAMILY_INDEX
; i
<= FONT_SPEC_ADSTYLE_INDEX
; i
++)
1189 if (! NILP (AREF (ascii_spec
, i
)))
1190 ASET (vec
, 1 + i
, AREF (ascii_spec
, i
));
1191 if (! NILP (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
)))
1192 ASET (vec
, 12, AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
1193 return build_font_name_from_vector (vec
);
1197 set_fontset_font (range
, arg
)
1198 Lisp_Object range
, arg
;
1200 Lisp_Object fontset
, font_def
, add
;
1202 fontset
= XCAR (arg
);
1203 font_def
= XCAR (XCDR (arg
));
1204 add
= XCAR (XCDR (XCDR (arg
)));
1205 FONTSET_ADD (fontset
, range
, font_def
, add
);
1206 free_realized_fontsets (fontset
);
1210 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 5, 0,
1212 Modify fontset NAME to use FONT-SPEC for CHARACTER.
1214 CHARACTER may be a cons; (FROM . TO), where FROM and TO are
1215 characters. In that case, use FONT-SPEC for all characters in the
1216 range FROM and TO (inclusive).
1218 CHARACTER may be a script name symbol. In that case, use FONT-SPEC
1219 for all characters that belong to the script.
1221 CHARACTER may be a charset. In that case, use FONT-SPEC for all
1222 characters in the charset.
1225 * A vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ].
1226 See the documentation of `set-face-attribute' for the detail of
1227 these vector elements;
1228 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1229 REGISTRY is a font registry name;
1230 * A font name string.
1232 Optional 4th argument FRAME, if non-nil, is a frame. This argument is
1233 kept for backward compatibility and has no meaning.
1235 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1236 to the font specifications for RANGE previously set. If it is
1237 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1238 appended. By default, FONT-SPEC overrides the previous settings. */)
1239 (name
, character
, font_spec
, frame
, add
)
1240 Lisp_Object name
, character
, font_spec
, frame
, add
;
1242 Lisp_Object fontset
;
1243 Lisp_Object font_def
, registry
;
1244 Lisp_Object encoding
, repertory
;
1245 Lisp_Object range_list
;
1247 fontset
= check_fontset_name (name
);
1249 /* The arg FRAME is kept for backward compatibility. We only check
1252 CHECK_LIVE_FRAME (frame
);
1254 if (VECTORP (font_spec
))
1258 if (ASIZE (font_spec
) != FONT_SPEC_MAX_INDEX
)
1259 args_out_of_range (make_number (FONT_SPEC_MAX_INDEX
),
1260 make_number (ASIZE (font_spec
)));
1262 font_spec
= Fcopy_sequence (font_spec
);
1263 for (j
= 0; j
< FONT_SPEC_MAX_INDEX
- 1; j
++)
1264 if (! NILP (AREF (font_spec
, j
)))
1266 CHECK_STRING (AREF (font_spec
, j
));
1267 ASET (font_spec
, j
, Fdowncase (AREF (font_spec
, j
)));
1269 /* REGISTRY should not be omitted. */
1270 CHECK_STRING (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1271 registry
= Fdowncase (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1272 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1275 else if (CONSP (font_spec
))
1279 family
= XCAR (font_spec
);
1280 registry
= XCDR (font_spec
);
1282 if (! NILP (family
))
1284 CHECK_STRING (family
);
1285 family
= Fdowncase (family
);
1287 CHECK_STRING (registry
);
1288 registry
= Fdowncase (registry
);
1289 font_spec
= Fmake_vector (make_number (FONT_SPEC_MAX_INDEX
), Qnil
);
1290 ASET (font_spec
, FONT_SPEC_FAMILY_INDEX
, family
);
1291 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1295 CHECK_STRING (font_spec
);
1296 font_spec
= Fdowncase (font_spec
);
1297 registry
= split_font_name_into_vector (font_spec
);
1298 if (NILP (registry
))
1299 error ("No XLFD: %s", SDATA (font_spec
));
1300 if (NILP (AREF (registry
, 12))
1301 || NILP (AREF (registry
, 13)))
1302 error ("Registry must be specified");
1303 registry
= concat2 (concat2 (AREF (registry
, 12), build_string ("-")),
1304 AREF (registry
, 13));
1307 if (STRINGP (font_spec
))
1308 encoding
= find_font_encoding ((char *) SDATA (font_spec
));
1310 encoding
= find_font_encoding ((char *) SDATA (registry
));
1311 if (SYMBOLP (encoding
))
1312 encoding
= repertory
= CHARSET_SYMBOL_ID (encoding
);
1315 repertory
= XCDR (encoding
);
1316 encoding
= CHARSET_SYMBOL_ID (XCAR (encoding
));
1318 font_def
= Fmake_vector (make_number (3), font_spec
);
1319 ASET (font_def
, 1, encoding
);
1320 ASET (font_def
, 2, repertory
);
1322 if (CHARACTERP (character
))
1323 range_list
= Fcons (Fcons (character
, character
), Qnil
);
1324 else if (CONSP (character
))
1326 Lisp_Object from
, to
;
1328 from
= Fcar (character
);
1329 to
= Fcdr (character
);
1330 CHECK_CHARACTER (from
);
1331 CHECK_CHARACTER (to
);
1332 range_list
= Fcons (character
, Qnil
);
1336 Lisp_Object script_list
;
1339 CHECK_SYMBOL (character
);
1341 script_list
= XCHAR_TABLE (Vchar_script_table
)->extras
[0];
1342 if (! NILP (Fmemq (character
, script_list
)))
1344 val
= Fcons (character
, Qnil
);
1345 map_char_table (accumulate_script_ranges
, Qnil
, Vchar_script_table
,
1347 range_list
= XCDR (val
);
1349 else if (CHARSETP (character
))
1351 struct charset
*charset
;
1353 CHECK_CHARSET_GET_CHARSET (character
, charset
);
1354 if (EQ (character
, Qascii
))
1356 if (VECTORP (font_spec
))
1357 font_spec
= generate_ascii_font_name (FONTSET_NAME (fontset
),
1359 FONTSET_ASCII (fontset
) = font_spec
;
1360 range_list
= Fcons (Fcons (make_number (0), make_number (127)),
1365 map_charset_chars (set_fontset_font
, Qnil
,
1366 list3 (fontset
, font_def
, add
), charset
,
1367 CHARSET_MIN_CODE (charset
),
1368 CHARSET_MAX_CODE (charset
));
1373 if (NILP (range_list
))
1374 error ("Invalid script or charset name: %s",
1375 SDATA (SYMBOL_NAME (character
)));
1378 for (; CONSP (range_list
); range_list
= XCDR (range_list
))
1379 FONTSET_ADD (fontset
, XCAR (range_list
), font_def
, add
);
1381 /* Free all realized fontsets whose base is FONTSET. This way, the
1382 specified character(s) are surely redisplayed by a correct
1384 free_realized_fontsets (fontset
);
1390 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
1391 doc
: /* Create a new fontset NAME from font information in FONTLIST.
1393 FONTLIST is an alist of scripts vs the corresponding font specification list.
1394 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1395 character of SCRIPT is displayed by a font that matches one of
1398 SCRIPT is a symbol that appears in the first extra slot of the
1399 char-table `char-script-table'.
1401 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1402 `set-fontset-font' for the meaning. */)
1404 Lisp_Object name
, fontlist
;
1406 Lisp_Object fontset
;
1410 CHECK_STRING (name
);
1411 CHECK_LIST (fontlist
);
1413 id
= fs_query_fontset (name
, 0);
1416 name
= Fdowncase (name
);
1417 val
= split_font_name_into_vector (name
);
1418 if (NILP (val
) || NILP (AREF (val
, 12)) || NILP (AREF (val
, 13)))
1419 error ("Fontset name must be in XLFD format");
1420 if (strcmp (SDATA (AREF (val
, 12)), "fontset"))
1421 error ("Registry field of fontset name must be \"fontset\"");
1422 Vfontset_alias_alist
1423 = Fcons (Fcons (name
,
1424 concat2 (concat2 (AREF (val
, 12), build_string ("-")),
1426 Vfontset_alias_alist
);
1427 ASET (val
, 12, build_string ("iso8859-1"));
1428 fontset
= make_fontset (Qnil
, name
, Qnil
);
1429 FONTSET_ASCII (fontset
) = build_font_name_from_vector (val
);
1433 fontset
= FONTSET_FROM_ID (id
);;
1434 free_realized_fontsets (fontset
);
1435 Fset_char_table_range (fontset
, Qt
, Qnil
);
1438 for (; ! NILP (fontlist
); fontlist
= Fcdr (fontlist
))
1440 Lisp_Object elt
, script
;
1442 elt
= Fcar (fontlist
);
1443 script
= Fcar (elt
);
1445 if (CONSP (elt
) && (NILP (XCDR (elt
)) || CONSP (XCDR (elt
))))
1446 for (; CONSP (elt
); elt
= XCDR (elt
))
1447 Fset_fontset_font (name
, script
, XCAR (elt
), Qnil
, Qappend
);
1449 Fset_fontset_font (name
, script
, elt
, Qnil
, Qappend
);
1455 /* Alist of automatically created fontsets. Each element is a cons
1456 (FONTNAME . FONTSET-ID). */
1457 static Lisp_Object auto_fontset_alist
;
1460 new_fontset_from_font_name (Lisp_Object fontname
)
1467 fontname
= Fdowncase (fontname
);
1468 val
= Fassoc (fontname
, auto_fontset_alist
);
1470 return XINT (XCDR (val
));
1472 vec
= split_font_name_into_vector (fontname
);
1474 vec
= Fmake_vector (make_number (14), build_string (""));
1475 ASET (vec
, 12, build_string ("fontset"));
1476 if (NILP (auto_fontset_alist
))
1478 ASET (vec
, 13, build_string ("startup"));
1479 name
= build_font_name_from_vector (vec
);
1484 int len
= Flength (auto_fontset_alist
);
1486 sprintf (temp
, "auto%d", len
);
1487 ASET (vec
, 13, build_string (temp
));
1488 name
= build_font_name_from_vector (vec
);
1490 name
= Fnew_fontset (name
, Fcons (Fcons (Qascii
, Fcons (fontname
, Qnil
)),
1492 id
= fs_query_fontset (name
, 0);
1494 = Fcons (Fcons (fontname
, make_number (id
)), auto_fontset_alist
);
1499 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1500 doc
: /* Return information about a font named NAME on frame FRAME.
1501 If FRAME is omitted or nil, use the selected frame.
1502 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1503 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1505 OPENED-NAME is the name used for opening the font,
1506 FULL-NAME is the full name of the font,
1507 SIZE is the maximum bound width of the font,
1508 HEIGHT is the height of the font,
1509 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1510 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1511 how to compose characters.
1512 If the named font is not yet loaded, return nil. */)
1514 Lisp_Object name
, frame
;
1517 struct font_info
*fontp
;
1520 (*check_window_system_func
) ();
1522 CHECK_STRING (name
);
1523 name
= Fdowncase (name
);
1525 frame
= selected_frame
;
1526 CHECK_LIVE_FRAME (frame
);
1529 if (!query_font_func
)
1530 error ("Font query function is not supported");
1532 fontp
= (*query_font_func
) (f
, SDATA (name
));
1536 info
= Fmake_vector (make_number (7), Qnil
);
1538 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1539 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1540 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1541 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1542 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1543 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1544 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1550 /* Return the font name for the character at POSITION in the current
1551 buffer. This is computed from all the text properties and overlays
1552 that apply to POSITION. It returns nil in the following cases:
1554 (1) The window system doesn't have a font for the character (thus
1555 it is displayed by an empty box).
1557 (2) The character code is invalid.
1559 (3) The current buffer is not displayed in any window.
1561 In addition, the returned font name may not take into account of
1562 such redisplay engine hooks as what used in jit-lock-mode if
1563 POSITION is currently not visible. */
1566 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1567 doc
: /* For internal use only. */)
1569 Lisp_Object position
;
1571 int pos
, pos_byte
, dummy
;
1579 CHECK_NUMBER_COERCE_MARKER (position
);
1580 pos
= XINT (position
);
1581 if (pos
< BEGV
|| pos
>= ZV
)
1582 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1583 pos_byte
= CHAR_TO_BYTE (pos
);
1584 c
= FETCH_CHAR (pos_byte
);
1585 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1588 w
= XWINDOW (window
);
1589 f
= XFRAME (w
->frame
);
1590 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1591 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
);
1592 face
= FACE_FROM_ID (f
, face_id
);
1593 return (face
->font
&& face
->font_name
1594 ? build_string (face
->font_name
)
1599 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1600 doc
: /* Return information about a fontset FONTSET on frame FRAME.
1601 The value is a char-table of which elements has this form.
1603 ((FONT-PATTERN OPENED-FONT ...) ...)
1605 FONT-PATTERN is a vector:
1607 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
1609 or a string of font name pattern.
1611 OPENED-FONT is a name of a font actually opened.
1613 The char-table has one extra slot. The value is a char-table
1614 containing the information about the derived fonts from the default
1615 fontset. The format is the same as abobe. */)
1617 Lisp_Object fontset
, frame
;
1620 Lisp_Object table
, val
, elt
;
1621 Lisp_Object
*realized
;
1626 (*check_window_system_func
) ();
1628 fontset
= check_fontset_name (fontset
);
1631 frame
= selected_frame
;
1632 CHECK_LIVE_FRAME (frame
);
1635 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1636 in the table `realized'. */
1637 realized
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1638 * ASIZE (Vfontset_table
));
1639 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1641 elt
= FONTSET_FROM_ID (i
);
1643 && EQ (FONTSET_BASE (elt
), fontset
)
1644 && EQ (FONTSET_FRAME (elt
), frame
))
1645 realized
[n_realized
++] = elt
;
1649 table
= Fmake_char_table (Qfontset_info
, Qnil
);
1650 XCHAR_TABLE (table
)->extras
[0] = Fmake_char_table (Qnil
, Qnil
);
1651 /* Accumulate information of the fontset in TABLE. The format of
1652 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1653 for (fallback
= 0; fallback
<= 1; fallback
++)
1655 Lisp_Object this_fontset
, this_table
;
1659 this_fontset
= fontset
;
1664 this_fontset
= Vdefault_fontset
;
1665 this_table
= XCHAR_TABLE (table
)->extras
[0];
1667 for (i
= 0; i
< n_realized
; i
++)
1668 realized
[i
] = FONTSET_FALLBACK (realized
[i
]);
1671 for (c
= 0; c
<= MAX_5_BYTE_CHAR
; )
1675 val
= char_table_ref_and_range (this_fontset
, c
, &from
, &to
);
1680 /* At first, set ALIST to ((FONT-SPEC) ...). */
1681 for (alist
= Qnil
, i
= 0; i
< ASIZE (val
); i
++)
1682 alist
= Fcons (Fcons (AREF (AREF (val
, i
), 0), Qnil
), alist
);
1683 alist
= Fnreverse (alist
);
1685 /* Then store opend font names to cdr of each elements. */
1686 for (i
= 0; i
< n_realized
; i
++)
1688 if (NILP (realized
[i
]))
1690 val
= FONTSET_REF (realized
[i
], c
);
1694 /* Now VAL is [[FACE-ID FONT-INDEX FONT-DEF] ...].
1695 If a font of an element is already opened,
1696 FONT-INDEX of the element is integer. */
1697 for (j
= 0; j
< ASIZE (val
); j
++)
1698 if (INTEGERP (AREF (AREF (val
, j
), 0)))
1700 Lisp_Object font_idx
;
1702 font_idx
= AREF (AREF (val
, j
), 1);
1703 elt
= Fassq (AREF (AREF (AREF (val
, j
), 2), 0), alist
);
1705 && NILP (Fmemq (font_idx
, XCDR(elt
))))
1706 nconc2 (elt
, Fcons (font_idx
, Qnil
));
1709 for (val
= alist
; CONSP (val
); val
= XCDR (val
))
1710 for (elt
= XCDR (XCAR (val
)); CONSP (elt
); elt
= XCDR (elt
))
1712 struct font_info
*font_info
1713 = (*get_font_info_func
) (f
, XINT (XCAR (elt
)));
1714 XSETCAR (elt
, build_string (font_info
->full_name
));
1717 /* Store ALIST in TBL for characters C..TO. */
1718 char_table_set_range (this_table
, c
, to
, alist
);
1728 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1729 doc
: /* Return a font name pattern for character CH in fontset NAME.
1730 If NAME is t, find a font name pattern in the default fontset. */)
1732 Lisp_Object name
, ch
;
1735 Lisp_Object fontset
, elt
;
1737 fontset
= check_fontset_name (name
);
1739 CHECK_CHARACTER (ch
);
1741 elt
= FONTSET_REF (fontset
, c
);
1742 return Fcopy_sequence (elt
);
1745 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1746 doc
: /* Return a list of all defined fontset names. */)
1749 Lisp_Object fontset
, list
;
1753 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1755 fontset
= FONTSET_FROM_ID (i
);
1757 && BASE_FONTSET_P (fontset
))
1758 list
= Fcons (FONTSET_NAME (fontset
), list
);
1765 #ifdef FONTSET_DEBUG
1768 dump_fontset (fontset
)
1769 Lisp_Object fontset
;
1773 vec
= Fmake_vector (make_number (3), Qnil
);
1774 ASET (vec
, 0, FONTSET_ID (fontset
));
1776 if (BASE_FONTSET_P (fontset
))
1778 ASET (vec
, 1, FONTSET_NAME (fontset
));
1784 frame
= FONTSET_FRAME (fontset
);
1787 FRAME_PTR f
= XFRAME (frame
);
1789 if (FRAME_LIVE_P (f
))
1790 ASET (vec
, 1, f
->name
);
1794 if (!NILP (FONTSET_FALLBACK (fontset
)))
1795 ASET (vec
, 2, FONTSET_ID (FONTSET_FALLBACK (fontset
)));
1800 DEFUN ("fontset-list-all", Ffontset_list_all
, Sfontset_list_all
, 0, 0, 0,
1801 doc
: /* Return a brief summary of all fontsets for debug use. */)
1807 for (i
= 0, val
= Qnil
; i
< ASIZE (Vfontset_table
); i
++)
1808 if (! NILP (AREF (Vfontset_table
, i
)))
1809 val
= Fcons (dump_fontset (AREF (Vfontset_table
, i
)), val
);
1810 return (Fnreverse (val
));
1812 #endif /* FONTSET_DEBUG */
1817 if (!load_font_func
)
1818 /* Window system initializer should have set proper functions. */
1821 DEFSYM (Qfontset
, "fontset");
1822 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (8));
1823 DEFSYM (Qfontset_info
, "fontset-info");
1824 Fput (Qfontset_info
, Qchar_table_extra_slots
, make_number (1));
1826 DEFSYM (Qprepend
, "prepend");
1827 DEFSYM (Qappend
, "append");
1829 Vcached_fontset_data
= Qnil
;
1830 staticpro (&Vcached_fontset_data
);
1832 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1833 staticpro (&Vfontset_table
);
1835 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1836 staticpro (&Vdefault_fontset
);
1837 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1838 FONTSET_NAME (Vdefault_fontset
)
1839 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1841 Lisp_Object default_ascii_font
;
1843 #if defined (macintosh)
1845 = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman");
1846 #elif defined (WINDOWSNT)
1848 = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
1851 = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
1853 FONTSET_ASCII (Vdefault_fontset
) = default_ascii_font
;
1855 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1856 next_fontset_id
= 1;
1858 auto_fontset_alist
= Qnil
;
1859 staticpro (&auto_fontset_alist
);
1861 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
1863 Alist of fontname patterns vs the corresponding encoding and repertory info.
1864 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
1865 where ENCODING is a charset or a char-table,
1866 and REPERTORY is a charset, a char-table, or nil.
1868 ENCODING is for converting a character to a glyph code of the font.
1869 If ENCODING is a charset, encoding a character by the charset gives
1870 the corresponding glyph code. If ENCODING is a char-table, looking up
1871 the table by a character gives the corresponding glyph code.
1873 REPERTORY specifies a repertory of characters supported by the font.
1874 If REPERTORY is a charset, all characters beloging to the charset are
1875 supported. If REPERTORY is a char-table, all characters who have a
1876 non-nil value in the table are supported. It REPERTORY is nil, Emacs
1877 gets the repertory information by an opened font and ENCODING. */);
1878 Vfont_encoding_alist
= Qnil
;
1880 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
1882 Char table of characters whose ascent values should be ignored.
1883 If an entry for a character is non-nil, the ascent value of the glyph
1884 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
1886 This affects how a composite character which contains
1887 such a character is displayed on screen. */);
1888 Vuse_default_ascent
= Qnil
;
1890 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
1892 Char table of characters which is not composed relatively.
1893 If an entry for a character is non-nil, a composition sequence
1894 which contains that character is displayed so that
1895 the glyph of that character is put without considering
1896 an ascent and descent value of a previous character. */);
1897 Vignore_relative_composition
= Qnil
;
1899 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
1900 doc
: /* Alist of fontname vs list of the alternate fontnames.
1901 When a specified font name is not found, the corresponding
1902 alternate fontnames (if any) are tried instead. */);
1903 Valternate_fontname_alist
= Qnil
;
1905 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
1906 doc
: /* Alist of fontset names vs the aliases. */);
1907 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
1908 build_string ("fontset-default")),
1911 DEFVAR_LISP ("vertical-centering-font-regexp",
1912 &Vvertical_centering_font_regexp
,
1913 doc
: /* *Regexp matching font names that require vertical centering on display.
1914 When a character is displayed with such fonts, the character is displayed
1915 at the vertical center of lines. */);
1916 Vvertical_centering_font_regexp
= Qnil
;
1918 defsubr (&Squery_fontset
);
1919 defsubr (&Snew_fontset
);
1920 defsubr (&Sset_fontset_font
);
1921 defsubr (&Sfont_info
);
1922 defsubr (&Sinternal_char_font
);
1923 defsubr (&Sfontset_info
);
1924 defsubr (&Sfontset_font
);
1925 defsubr (&Sfontset_list
);
1926 #ifdef FONTSET_DEBUG
1927 defsubr (&Sfontset_list_all
);