*** empty log message ***
[emacs.git] / src / fontset.c
blob838d9526944f9eb118e84c57d1de970c526bde60
1 /* Fontset handler.
2 Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H14PRO021
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)
13 any later version.
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., 51 Franklin Street, Fifth Floor,
23 Boston, MA 02110-1301, USA. */
25 /* #define FONTSET_DEBUG */
27 #include <config.h>
29 #ifdef FONTSET_DEBUG
30 #include <stdio.h>
31 #endif
33 #include "lisp.h"
34 #include "buffer.h"
35 #include "charset.h"
36 #include "ccl.h"
37 #include "keyboard.h"
38 #include "frame.h"
39 #include "dispextern.h"
40 #include "fontset.h"
41 #include "window.h"
42 #ifdef HAVE_X_WINDOWS
43 #include "xterm.h"
44 #endif
45 #ifdef WINDOWSNT
46 #include "w32term.h"
47 #endif
48 #ifdef MAC_OS
49 #include "macterm.h"
50 #endif
52 #ifdef FONTSET_DEBUG
53 #undef xassert
54 #define xassert(X) do {if (!(X)) abort ();} while (0)
55 #undef INLINE
56 #define INLINE
57 #endif
60 /* FONTSET
62 A fontset is a collection of font related information to give
63 similar appearance (style, size, etc) of characters. There are two
64 kinds of fontsets; base and realized. A base fontset is created by
65 new-fontset from Emacs Lisp explicitly. A realized fontset is
66 created implicitly when a face is realized for ASCII characters. A
67 face is also realized for multibyte characters based on an ASCII
68 face. All of the multibyte faces based on the same ASCII face
69 share the same realized fontset.
71 A fontset object is implemented by a char-table.
73 An element of a base fontset is:
74 (INDEX . FONTNAME) or
75 (INDEX . (FOUNDRY . REGISTRY ))
76 FONTNAME is a font name pattern for the corresponding character.
77 FOUNDRY and REGISTRY are respectively foundry and registry fields of
78 a font name for the corresponding character. INDEX specifies for
79 which character (or generic character) the element is defined. It
80 may be different from an index to access this element. For
81 instance, if a fontset defines some font for all characters of
82 charset `japanese-jisx0208', INDEX is the generic character of this
83 charset. REGISTRY is the
85 An element of a realized fontset is FACE-ID which is a face to use
86 for displaying the corresponding character.
88 All single byte characters (ASCII and 8bit-unibyte) share the same
89 element in a fontset. The element is stored in the first element
90 of the fontset.
92 To access or set each element, use macros FONTSET_REF and
93 FONTSET_SET respectively for efficiency.
95 A fontset has 3 extra slots.
97 The 1st slot is an ID number of the fontset.
99 The 2nd slot is a name of the fontset. This is nil for a realized
100 face.
102 The 3rd slot is a frame that the fontset belongs to. This is nil
103 for a default face.
105 A parent of a base fontset is nil. A parent of a realized fontset
106 is a base fontset.
108 All fontsets are recorded in Vfontset_table.
111 DEFAULT FONTSET
113 There's a special fontset named `default fontset' which defines a
114 default fontname pattern. When a base fontset doesn't specify a
115 font for a specific character, the corresponding value in the
116 default fontset is used. The format is the same as a base fontset.
118 The parent of a realized fontset created for such a face that has
119 no fontset is the default fontset.
122 These structures are hidden from the other codes than this file.
123 The other codes handle fontsets only by their ID numbers. They
124 usually use variable name `fontset' for IDs. But, in this file, we
125 always use variable name `id' for IDs, and name `fontset' for the
126 actual fontset objects.
130 /********** VARIABLES and FUNCTION PROTOTYPES **********/
132 extern Lisp_Object Qfont;
133 Lisp_Object Qfontset;
135 /* Vector containing all fontsets. */
136 static Lisp_Object Vfontset_table;
138 /* Next possibly free fontset ID. Usually this keeps the minimum
139 fontset ID not yet used. */
140 static int next_fontset_id;
142 /* The default fontset. This gives default FAMILY and REGISTRY of
143 font for each characters. */
144 static Lisp_Object Vdefault_fontset;
146 /* Alist of font specifications. It override the font specification
147 in the default fontset. */
148 static Lisp_Object Voverriding_fontspec_alist;
150 Lisp_Object Vfont_encoding_alist;
151 Lisp_Object Vuse_default_ascent;
152 Lisp_Object Vignore_relative_composition;
153 Lisp_Object Valternate_fontname_alist;
154 Lisp_Object Vfontset_alias_alist;
155 Lisp_Object Vvertical_centering_font_regexp;
157 /* The following six are declarations of callback functions depending
158 on window system. See the comments in src/fontset.h for more
159 detail. */
161 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
162 struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx));
164 /* Return a list of font names which matches PATTERN. See the documentation
165 of `x-list-fonts' for more details. */
166 Lisp_Object (*list_fonts_func) P_ ((struct frame *f,
167 Lisp_Object pattern,
168 int size,
169 int maxnames));
171 /* Load a font named NAME for frame F and return a pointer to the
172 information of the loaded font. If loading is failed, return 0. */
173 struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int));
175 /* Return a pointer to struct font_info of a font named NAME for frame F. */
176 struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name));
178 /* Additional function for setting fontset or changing fontset
179 contents of frame F. */
180 void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg,
181 Lisp_Object oldval));
183 /* To find a CCL program, fs_load_font calls this function.
184 The argument is a pointer to the struct font_info.
185 This function set the member `encoder' of the structure. */
186 void (*find_ccl_program_func) P_ ((struct font_info *));
188 /* Check if any window system is used now. */
189 void (*check_window_system_func) P_ ((void));
192 /* Prototype declarations for static functions. */
193 static Lisp_Object fontset_ref P_ ((Lisp_Object, int));
194 static Lisp_Object lookup_overriding_fontspec P_ ((Lisp_Object, int));
195 static void fontset_set P_ ((Lisp_Object, int, Lisp_Object));
196 static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
197 static int fontset_id_valid_p P_ ((int));
198 static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
199 static Lisp_Object font_family_registry P_ ((Lisp_Object, int));
200 static Lisp_Object regularize_fontname P_ ((Lisp_Object));
203 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
205 /* Return the fontset with ID. No check of ID's validness. */
206 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
208 /* Macros to access special values of FONTSET. */
209 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
210 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
211 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
212 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0]
213 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
215 #define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
218 /* Return the element of FONTSET (char-table) at index C (character). */
220 #define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
222 static Lisp_Object
223 fontset_ref (fontset, c)
224 Lisp_Object fontset;
225 int c;
227 int charset, c1, c2;
228 Lisp_Object elt, defalt;
230 if (SINGLE_BYTE_CHAR_P (c))
231 return FONTSET_ASCII (fontset);
233 SPLIT_CHAR (c, charset, c1, c2);
234 elt = XCHAR_TABLE (fontset)->contents[charset + 128];
235 if (!SUB_CHAR_TABLE_P (elt))
236 return elt;
237 defalt = XCHAR_TABLE (elt)->defalt;
238 if (c1 < 32
239 || (elt = XCHAR_TABLE (elt)->contents[c1],
240 NILP (elt)))
241 return defalt;
242 if (!SUB_CHAR_TABLE_P (elt))
243 return elt;
244 defalt = XCHAR_TABLE (elt)->defalt;
245 if (c2 < 32
246 || (elt = XCHAR_TABLE (elt)->contents[c2],
247 NILP (elt)))
248 return defalt;
249 return elt;
253 static Lisp_Object
254 lookup_overriding_fontspec (frame, c)
255 Lisp_Object frame;
256 int c;
258 Lisp_Object tail;
260 for (tail = Voverriding_fontspec_alist; CONSP (tail); tail = XCDR (tail))
262 Lisp_Object val, target, elt;
264 val = XCAR (tail);
265 target = XCAR (val);
266 val = XCDR (val);
267 /* Now VAL is (NO-FRAME-LIST OK-FRAME-LIST CHAR FONTNAME). */
268 if (NILP (Fmemq (frame, XCAR (val)))
269 && (CHAR_TABLE_P (target)
270 ? ! NILP (CHAR_TABLE_REF (target, c))
271 : XINT (target) == CHAR_CHARSET (c)))
273 val = XCDR (val);
274 elt = XCDR (val);
275 if (NILP (Fmemq (frame, XCAR (val))))
277 if (! face_font_available_p (XFRAME (frame), XCDR (elt)))
279 val = XCDR (XCAR (tail));
280 XSETCAR (val, Fcons (frame, XCAR (val)));
281 continue;
283 XSETCAR (val, Fcons (frame, XCAR (val)));
285 if (NILP (XCAR (elt)))
286 XSETCAR (elt, make_number (c));
287 return elt;
290 return Qnil;
293 #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
295 static Lisp_Object
296 fontset_ref_via_base (fontset, c)
297 Lisp_Object fontset;
298 int *c;
300 int charset, c1, c2;
301 Lisp_Object elt;
303 if (SINGLE_BYTE_CHAR_P (*c))
304 return FONTSET_ASCII (fontset);
306 elt = Qnil;
307 if (! EQ (FONTSET_BASE (fontset), Vdefault_fontset))
308 elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
309 if (NILP (elt))
310 elt = lookup_overriding_fontspec (FONTSET_FRAME (fontset), *c);
311 if (NILP (elt))
312 elt = FONTSET_REF (Vdefault_fontset, *c);
313 if (NILP (elt))
314 return Qnil;
316 *c = XINT (XCAR (elt));
317 SPLIT_CHAR (*c, charset, c1, c2);
318 elt = XCHAR_TABLE (fontset)->contents[charset + 128];
319 if (c1 < 32)
320 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
321 if (!SUB_CHAR_TABLE_P (elt))
322 return Qnil;
323 elt = XCHAR_TABLE (elt)->contents[c1];
324 if (c2 < 32)
325 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
326 if (!SUB_CHAR_TABLE_P (elt))
327 return Qnil;
328 elt = XCHAR_TABLE (elt)->contents[c2];
329 return elt;
333 /* Store into the element of FONTSET at index C the value NEWELT. */
334 #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
336 static void
337 fontset_set (fontset, c, newelt)
338 Lisp_Object fontset;
339 int c;
340 Lisp_Object newelt;
342 int charset, code[3];
343 Lisp_Object *elt;
344 int i;
346 if (SINGLE_BYTE_CHAR_P (c))
348 FONTSET_ASCII (fontset) = newelt;
349 return;
352 SPLIT_CHAR (c, charset, code[0], code[1]);
353 code[2] = 0; /* anchor */
354 elt = &XCHAR_TABLE (fontset)->contents[charset + 128];
355 for (i = 0; code[i] > 0; i++)
357 if (!SUB_CHAR_TABLE_P (*elt))
359 Lisp_Object val = *elt;
360 *elt = make_sub_char_table (Qnil);
361 XCHAR_TABLE (*elt)->defalt = val;
363 elt = &XCHAR_TABLE (*elt)->contents[code[i]];
365 if (SUB_CHAR_TABLE_P (*elt))
366 XCHAR_TABLE (*elt)->defalt = newelt;
367 else
368 *elt = newelt;
372 /* Return a newly created fontset with NAME. If BASE is nil, make a
373 base fontset. Otherwise make a realized fontset whose parent is
374 BASE. */
376 static Lisp_Object
377 make_fontset (frame, name, base)
378 Lisp_Object frame, name, base;
380 Lisp_Object fontset;
381 int size = ASIZE (Vfontset_table);
382 int id = next_fontset_id;
384 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
385 the next available fontset ID. So it is expected that this loop
386 terminates quickly. In addition, as the last element of
387 Vfontset_table is always nil, we don't have to check the range of
388 id. */
389 while (!NILP (AREF (Vfontset_table, id))) id++;
391 if (id + 1 == size)
393 Lisp_Object tem;
394 int i;
396 tem = Fmake_vector (make_number (size + 8), Qnil);
397 for (i = 0; i < size; i++)
398 AREF (tem, i) = AREF (Vfontset_table, i);
399 Vfontset_table = tem;
402 fontset = Fmake_char_table (Qfontset, Qnil);
404 FONTSET_ID (fontset) = make_number (id);
405 FONTSET_NAME (fontset) = name;
406 FONTSET_FRAME (fontset) = frame;
407 FONTSET_BASE (fontset) = base;
409 AREF (Vfontset_table, id) = fontset;
410 next_fontset_id = id + 1;
411 return fontset;
415 /* Return 1 if ID is a valid fontset id, else return 0. */
417 static INLINE int
418 fontset_id_valid_p (id)
419 int id;
421 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
425 /* Extract `family' and `registry' string from FONTNAME and a cons of
426 them. Actually, `family' may also contain `foundry', `registry'
427 may also contain `encoding' of FONTNAME. But, if FONTNAME doesn't
428 conform to XLFD nor explicitely specifies the other fields
429 (i.e. not using wildcard `*'), return FONTNAME. If FORCE is
430 nonzero, specifications of the other fields are ignored, and return
431 a cons as far as FONTNAME conform to XLFD. */
433 static Lisp_Object
434 font_family_registry (fontname, force)
435 Lisp_Object fontname;
436 int force;
438 Lisp_Object family, registry;
439 const char *p = SDATA (fontname);
440 const char *sep[15];
441 int i = 0;
443 while (*p && i < 15)
444 if (*p++ == '-')
446 if (!force && i >= 2 && i <= 11 && *p != '*' && p[1] != '-')
447 return fontname;
448 sep[i++] = p;
450 if (i != 14)
451 return fontname;
453 family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);
454 registry = make_unibyte_string (sep[12], p - sep[12]);
455 return Fcons (family, registry);
459 /********** INTERFACES TO xfaces.c and dispextern.h **********/
461 /* Return name of the fontset with ID. */
463 Lisp_Object
464 fontset_name (id)
465 int id;
467 Lisp_Object fontset;
468 fontset = FONTSET_FROM_ID (id);
469 return FONTSET_NAME (fontset);
473 /* Return ASCII font name of the fontset with ID. */
475 Lisp_Object
476 fontset_ascii (id)
477 int id;
479 Lisp_Object fontset, elt;
480 fontset= FONTSET_FROM_ID (id);
481 elt = FONTSET_ASCII (fontset);
482 return XCDR (elt);
486 /* Free fontset of FACE. Called from free_realized_face. */
488 void
489 free_face_fontset (f, face)
490 FRAME_PTR f;
491 struct face *face;
493 if (fontset_id_valid_p (face->fontset))
495 AREF (Vfontset_table, face->fontset) = Qnil;
496 if (face->fontset < next_fontset_id)
497 next_fontset_id = face->fontset;
502 /* Return 1 iff FACE is suitable for displaying character C.
503 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
504 when C is not a single byte character.. */
507 face_suitable_for_char_p (face, c)
508 struct face *face;
509 int c;
511 Lisp_Object fontset, elt;
513 if (SINGLE_BYTE_CHAR_P (c))
514 return (face == face->ascii_face);
516 xassert (fontset_id_valid_p (face->fontset));
517 fontset = FONTSET_FROM_ID (face->fontset);
518 xassert (!BASE_FONTSET_P (fontset));
520 elt = FONTSET_REF_VIA_BASE (fontset, c);
521 return (!NILP (elt) && face->id == XFASTINT (elt));
525 /* Return ID of face suitable for displaying character C on frame F.
526 The selection of face is done based on the fontset of FACE. FACE
527 should already have been realized for ASCII characters. Called
528 from the macro FACE_FOR_CHAR when C is not a single byte character. */
531 face_for_char (f, face, c)
532 FRAME_PTR f;
533 struct face *face;
534 int c;
536 Lisp_Object fontset, elt;
537 int face_id;
539 xassert (fontset_id_valid_p (face->fontset));
540 fontset = FONTSET_FROM_ID (face->fontset);
541 xassert (!BASE_FONTSET_P (fontset));
543 elt = FONTSET_REF_VIA_BASE (fontset, c);
544 if (!NILP (elt))
545 return XINT (elt);
547 /* No face is recorded for C in the fontset of FACE. Make a new
548 realized face for C that has the same fontset. */
549 face_id = lookup_face (f, face->lface, c, face);
551 /* Record the face ID in FONTSET at the same index as the
552 information in the base fontset. */
553 FONTSET_SET (fontset, c, make_number (face_id));
554 return face_id;
558 /* Make a realized fontset for ASCII face FACE on frame F from the
559 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
560 default fontset as the base. Value is the id of the new fontset.
561 Called from realize_x_face. */
564 make_fontset_for_ascii_face (f, base_fontset_id)
565 FRAME_PTR f;
566 int base_fontset_id;
568 Lisp_Object base_fontset, fontset, frame;
570 XSETFRAME (frame, f);
571 if (base_fontset_id >= 0)
573 base_fontset = FONTSET_FROM_ID (base_fontset_id);
574 if (!BASE_FONTSET_P (base_fontset))
575 base_fontset = FONTSET_BASE (base_fontset);
576 xassert (BASE_FONTSET_P (base_fontset));
578 else
579 base_fontset = Vdefault_fontset;
581 fontset = make_fontset (frame, Qnil, base_fontset);
582 return XINT (FONTSET_ID (fontset));
586 /* Return the font name pattern for C that is recorded in the fontset
587 with ID. If a font name pattern is specified (instead of a cons of
588 family and registry), check if a font can be opened by that pattern
589 to get the fullname. If a font is opened, return that name.
590 Otherwise, return nil. If ID is -1, or the fontset doesn't contain
591 information about C, get the registry and encoding of C from the
592 default fontset. Called from choose_face_font. */
594 Lisp_Object
595 fontset_font_pattern (f, id, c)
596 FRAME_PTR f;
597 int id, c;
599 Lisp_Object fontset, elt;
600 struct font_info *fontp;
602 elt = Qnil;
603 if (fontset_id_valid_p (id))
605 fontset = FONTSET_FROM_ID (id);
606 xassert (!BASE_FONTSET_P (fontset));
607 fontset = FONTSET_BASE (fontset);
608 if (! EQ (fontset, Vdefault_fontset))
609 elt = FONTSET_REF (fontset, c);
611 if (NILP (elt))
613 Lisp_Object frame;
615 XSETFRAME (frame, f);
616 elt = lookup_overriding_fontspec (frame, c);
618 if (NILP (elt))
619 elt = FONTSET_REF (Vdefault_fontset, c);
621 if (!CONSP (elt))
622 return Qnil;
623 if (CONSP (XCDR (elt)))
624 return XCDR (elt);
626 /* The fontset specifies only a font name pattern (not cons of
627 family and registry). If a font can be opened by that pattern,
628 return the name of opened font. Otherwise return nil. The
629 exception is a font for single byte characters. In that case, we
630 return a cons of FAMILY and REGISTRY extracted from the opened
631 font name. */
632 elt = XCDR (elt);
633 xassert (STRINGP (elt));
634 fontp = FS_LOAD_FONT (f, c, SDATA (elt), -1);
635 if (!fontp)
636 return Qnil;
638 return font_family_registry (build_string (fontp->full_name),
639 SINGLE_BYTE_CHAR_P (c));
643 #if defined(WINDOWSNT) && defined (_MSC_VER)
644 #pragma optimize("", off)
645 #endif
647 /* Load a font named FONTNAME to display character C on frame F.
648 Return a pointer to the struct font_info of the loaded font. If
649 loading fails, return NULL. If FACE is non-zero and a fontset is
650 assigned to it, record FACE->id in the fontset for C. If FONTNAME
651 is NULL, the name is taken from the fontset of FACE or what
652 specified by ID. */
654 struct font_info *
655 fs_load_font (f, c, fontname, id, face)
656 FRAME_PTR f;
657 int c;
658 char *fontname;
659 int id;
660 struct face *face;
662 Lisp_Object fontset;
663 Lisp_Object list, elt, fullname;
664 int size = 0;
665 struct font_info *fontp;
666 int charset = CHAR_CHARSET (c);
668 if (face)
669 id = face->fontset;
670 if (id < 0)
671 fontset = Qnil;
672 else
673 fontset = FONTSET_FROM_ID (id);
675 if (!NILP (fontset)
676 && !BASE_FONTSET_P (fontset))
678 elt = FONTSET_REF_VIA_BASE (fontset, c);
679 if (!NILP (elt))
681 /* A suitable face for C is already recorded, which means
682 that a proper font is already loaded. */
683 int face_id = XINT (elt);
685 xassert (face_id == face->id);
686 face = FACE_FROM_ID (f, face_id);
687 return (*get_font_info_func) (f, face->font_info_id);
690 if (!fontname && charset == CHARSET_ASCII)
692 elt = FONTSET_ASCII (fontset);
693 fontname = SDATA (XCDR (elt));
697 if (!fontname)
698 /* No way to get fontname. */
699 return 0;
701 fontp = (*load_font_func) (f, fontname, size);
702 if (!fontp)
703 return 0;
705 /* Fill in members (charset, vertical_centering, encoding, etc) of
706 font_info structure that are not set by (*load_font_func). */
707 fontp->charset = charset;
709 fullname = build_string (fontp->full_name);
710 fontp->vertical_centering
711 = (STRINGP (Vvertical_centering_font_regexp)
712 && (fast_string_match_ignore_case
713 (Vvertical_centering_font_regexp, fullname) >= 0));
715 if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
717 /* The font itself tells which code points to be used. Use this
718 encoding for all other charsets. */
719 int i;
721 fontp->encoding[0] = fontp->encoding[1];
722 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
723 fontp->encoding[i] = fontp->encoding[1];
725 else
727 /* The font itself doesn't have information about encoding. */
728 int i;
730 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
731 others is 1 (i.e. 0x80..0xFF). */
732 fontp->encoding[0] = 0;
733 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
734 fontp->encoding[i] = 1;
735 /* Then override them by a specification in Vfont_encoding_alist. */
736 for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list))
738 elt = XCAR (list);
739 if (CONSP (elt)
740 && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
741 && (fast_string_match_ignore_case (XCAR (elt), fullname) >= 0))
743 Lisp_Object tmp;
745 for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp))
746 if (CONSP (XCAR (tmp))
747 && ((i = get_charset_id (XCAR (XCAR (tmp))))
748 >= 0)
749 && INTEGERP (XCDR (XCAR (tmp)))
750 && XFASTINT (XCDR (XCAR (tmp))) < 4)
751 fontp->encoding[i]
752 = XFASTINT (XCDR (XCAR (tmp)));
757 if (! fontp->font_encoder && find_ccl_program_func)
758 (*find_ccl_program_func) (fontp);
760 /* If we loaded a font for a face that has fontset, record the face
761 ID in the fontset for C. */
762 if (face
763 && !NILP (fontset)
764 && !BASE_FONTSET_P (fontset))
765 FONTSET_SET (fontset, c, make_number (face->id));
766 return fontp;
769 #if defined(WINDOWSNT) && defined (_MSC_VER)
770 #pragma optimize("", on)
771 #endif
773 /* Set the ASCII font of the default fontset to FONTNAME if that is
774 not yet set. */
775 void
776 set_default_ascii_font (fontname)
777 Lisp_Object fontname;
779 if (! CONSP (FONTSET_ASCII (Vdefault_fontset)))
781 int id = fs_query_fontset (fontname, 2);
783 if (id >= 0)
784 fontname = XCDR (FONTSET_ASCII (FONTSET_FROM_ID (id)));
785 FONTSET_ASCII (Vdefault_fontset)
786 = Fcons (make_number (0), fontname);
791 /* Cache data used by fontset_pattern_regexp. The car part is a
792 pattern string containing at least one wild card, the cdr part is
793 the corresponding regular expression. */
794 static Lisp_Object Vcached_fontset_data;
796 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
797 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
799 /* If fontset name PATTERN contains any wild card, return regular
800 expression corresponding to PATTERN. */
802 static Lisp_Object
803 fontset_pattern_regexp (pattern)
804 Lisp_Object pattern;
806 if (!index (SDATA (pattern), '*')
807 && !index (SDATA (pattern), '?'))
808 /* PATTERN does not contain any wild cards. */
809 return Qnil;
811 if (!CONSP (Vcached_fontset_data)
812 || strcmp (SDATA (pattern), CACHED_FONTSET_NAME))
814 /* We must at first update the cached data. */
815 unsigned char *regex, *p0, *p1;
816 int ndashes = 0, nstars = 0;
818 for (p0 = SDATA (pattern); *p0; p0++)
820 if (*p0 == '-')
821 ndashes++;
822 else if (*p0 == '*')
823 nstars++;
826 /* If PATTERN is not full XLFD we conert "*" to ".*". Otherwise
827 we convert "*" to "[^-]*" which is much faster in regular
828 expression matching. */
829 if (ndashes < 14)
830 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 1);
831 else
832 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 1);
834 *p1++ = '^';
835 for (p0 = SDATA (pattern); *p0; p0++)
837 if (*p0 == '*')
839 if (ndashes < 14)
840 *p1++ = '.';
841 else
842 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
843 *p1++ = '*';
845 else if (*p0 == '?')
846 *p1++ = '.';
847 else
848 *p1++ = *p0;
850 *p1++ = '$';
851 *p1++ = 0;
853 Vcached_fontset_data = Fcons (build_string (SDATA (pattern)),
854 build_string (regex));
857 return CACHED_FONTSET_REGEX;
860 /* Return ID of the base fontset named NAME. If there's no such
861 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
862 0: pattern containing '*' and '?' as wildcards
863 1: regular expression
864 2: literal fontset name
868 fs_query_fontset (name, name_pattern)
869 Lisp_Object name;
870 int name_pattern;
872 Lisp_Object tem;
873 int i;
875 name = Fdowncase (name);
876 if (name_pattern != 1)
878 tem = Frassoc (name, Vfontset_alias_alist);
879 if (CONSP (tem) && STRINGP (XCAR (tem)))
880 name = XCAR (tem);
881 else if (name_pattern == 0)
883 tem = fontset_pattern_regexp (name);
884 if (STRINGP (tem))
886 name = tem;
887 name_pattern = 1;
892 for (i = 0; i < ASIZE (Vfontset_table); i++)
894 Lisp_Object fontset, this_name;
896 fontset = FONTSET_FROM_ID (i);
897 if (NILP (fontset)
898 || !BASE_FONTSET_P (fontset))
899 continue;
901 this_name = FONTSET_NAME (fontset);
902 if (name_pattern == 1
903 ? fast_string_match (name, this_name) >= 0
904 : !strcmp (SDATA (name), SDATA (this_name)))
905 return i;
907 return -1;
911 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
912 doc: /* Return the name of a fontset that matches PATTERN.
913 The value is nil if there is no matching fontset.
914 PATTERN can contain `*' or `?' as a wildcard
915 just as X font name matching algorithm allows.
916 If REGEXPP is non-nil, PATTERN is a regular expression. */)
917 (pattern, regexpp)
918 Lisp_Object pattern, regexpp;
920 Lisp_Object fontset;
921 int id;
923 (*check_window_system_func) ();
925 CHECK_STRING (pattern);
927 if (SCHARS (pattern) == 0)
928 return Qnil;
930 id = fs_query_fontset (pattern, !NILP (regexpp));
931 if (id < 0)
932 return Qnil;
934 fontset = FONTSET_FROM_ID (id);
935 return FONTSET_NAME (fontset);
938 /* Return a list of base fontset names matching PATTERN on frame F.
939 If SIZE is not 0, it is the size (maximum bound width) of fontsets
940 to be listed. */
942 Lisp_Object
943 list_fontsets (f, pattern, size)
944 FRAME_PTR f;
945 Lisp_Object pattern;
946 int size;
948 Lisp_Object frame, regexp, val;
949 int id;
951 XSETFRAME (frame, f);
953 regexp = fontset_pattern_regexp (pattern);
954 val = Qnil;
956 for (id = 0; id < ASIZE (Vfontset_table); id++)
958 Lisp_Object fontset, name;
960 fontset = FONTSET_FROM_ID (id);
961 if (NILP (fontset)
962 || !BASE_FONTSET_P (fontset)
963 || !EQ (frame, FONTSET_FRAME (fontset)))
964 continue;
965 name = FONTSET_NAME (fontset);
967 if (!NILP (regexp)
968 ? (fast_string_match (regexp, name) < 0)
969 : strcmp (SDATA (pattern), SDATA (name)))
970 continue;
972 if (size)
974 struct font_info *fontp;
975 fontp = FS_LOAD_FONT (f, 0, NULL, id);
976 if (!fontp || size != fontp->size)
977 continue;
979 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
982 return val;
985 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
986 doc: /* Create a new fontset NAME that contains font information in FONTLIST.
987 FONTLIST is an alist of charsets vs corresponding font name patterns. */)
988 (name, fontlist)
989 Lisp_Object name, fontlist;
991 Lisp_Object fontset, elements, ascii_font;
992 Lisp_Object tem, tail, elt;
993 int id;
995 (*check_window_system_func) ();
997 CHECK_STRING (name);
998 CHECK_LIST (fontlist);
1000 name = Fdowncase (name);
1001 id = fs_query_fontset (name, 2);
1002 if (id >= 0)
1004 fontset = FONTSET_FROM_ID (id);
1005 tem = FONTSET_NAME (fontset);
1006 error ("Fontset `%s' matches the existing fontset `%s'",
1007 SDATA (name), SDATA (tem));
1010 /* Check the validity of FONTLIST while creating a template for
1011 fontset elements. */
1012 elements = ascii_font = Qnil;
1013 for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
1015 int c, charset;
1017 tem = XCAR (tail);
1018 if (!CONSP (tem)
1019 || (charset = get_charset_id (XCAR (tem))) < 0
1020 || (!STRINGP (XCDR (tem)) && !CONSP (XCDR (tem))))
1021 error ("Elements of fontlist must be a cons of charset and font name pattern");
1023 tem = XCDR (tem);
1024 if (STRINGP (tem))
1025 tem = Fdowncase (tem);
1026 else
1027 tem = Fcons (Fdowncase (Fcar (tem)), Fdowncase (Fcdr (tem)));
1028 if (charset == CHARSET_ASCII)
1029 ascii_font = tem;
1030 else
1032 c = MAKE_CHAR (charset, 0, 0);
1033 elements = Fcons (Fcons (make_number (c), tem), elements);
1037 if (NILP (ascii_font))
1038 error ("No ASCII font in the fontlist");
1040 fontset = make_fontset (Qnil, name, Qnil);
1041 FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font);
1042 for (; CONSP (elements); elements = XCDR (elements))
1044 elt = XCAR (elements);
1045 tem = XCDR (elt);
1046 if (STRINGP (tem))
1047 tem = font_family_registry (tem, 0);
1048 tem = Fcons (XCAR (elt), tem);
1049 FONTSET_SET (fontset, XINT (XCAR (elt)), tem);
1052 return Qnil;
1056 /* Clear all elements of FONTSET for multibyte characters. */
1058 static void
1059 clear_fontset_elements (fontset)
1060 Lisp_Object fontset;
1062 int i;
1064 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
1065 XCHAR_TABLE (fontset)->contents[i] = Qnil;
1069 /* Check validity of NAME as a fontset name and return the
1070 corresponding fontset. If not valid, signal an error.
1071 If NAME is nil, return Vdefault_fontset. */
1073 static Lisp_Object
1074 check_fontset_name (name)
1075 Lisp_Object name;
1077 int id;
1079 if (EQ (name, Qnil))
1080 return Vdefault_fontset;
1082 CHECK_STRING (name);
1083 /* First try NAME as literal. */
1084 id = fs_query_fontset (name, 2);
1085 if (id < 0)
1086 /* For backward compatibility, try again NAME as pattern. */
1087 id = fs_query_fontset (name, 0);
1088 if (id < 0)
1089 error ("Fontset `%s' does not exist", SDATA (name));
1090 return FONTSET_FROM_ID (id);
1093 /* Downcase FONTNAME or car and cdr of FONTNAME. If FONTNAME is a
1094 string, maybe change FONTNAME to (FAMILY . REGISTRY). */
1096 static Lisp_Object
1097 regularize_fontname (Lisp_Object fontname)
1099 Lisp_Object family, registry;
1101 if (STRINGP (fontname))
1102 return font_family_registry (Fdowncase (fontname), 0);
1104 CHECK_CONS (fontname);
1105 family = XCAR (fontname);
1106 registry = XCDR (fontname);
1107 if (!NILP (family))
1109 CHECK_STRING (family);
1110 family = Fdowncase (family);
1112 if (!NILP (registry))
1114 CHECK_STRING (registry);
1115 registry = Fdowncase (registry);
1117 return Fcons (family, registry);
1120 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
1121 doc: /* Modify fontset NAME to use FONTNAME for CHARACTER.
1123 If NAME is nil, modify the default fontset.
1124 CHARACTER may be a cons; (FROM . TO), where FROM and TO are
1125 non-generic characters. In that case, use FONTNAME
1126 for all characters in the range FROM and TO (inclusive).
1127 CHARACTER may be a charset. In that case, use FONTNAME
1128 for all character in the charsets.
1130 FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family
1131 name of a font, REGISTRY is a registry name of a font. */)
1132 (name, character, fontname, frame)
1133 Lisp_Object name, character, fontname, frame;
1135 Lisp_Object fontset, elt;
1136 Lisp_Object realized;
1137 int from, to;
1138 int id;
1140 fontset = check_fontset_name (name);
1142 if (CONSP (character))
1144 /* CH should be (FROM . TO) where FROM and TO are non-generic
1145 characters. */
1146 CHECK_NUMBER_CAR (character);
1147 CHECK_NUMBER_CDR (character);
1148 from = XINT (XCAR (character));
1149 to = XINT (XCDR (character));
1150 if (!char_valid_p (from, 0) || !char_valid_p (to, 0))
1151 error ("Character range should be by non-generic characters");
1152 if (!NILP (name)
1153 && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to)))
1154 error ("Can't change font for a single byte character");
1156 else if (SYMBOLP (character))
1158 elt = Fget (character, Qcharset);
1159 if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0)))
1160 error ("Invalid charset: %s", SDATA (SYMBOL_NAME (character)));
1161 from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0);
1162 to = from;
1164 else
1166 CHECK_NUMBER (character);
1167 from = XINT (character);
1168 to = from;
1170 if (!char_valid_p (from, 1))
1171 invalid_character (from);
1172 if (SINGLE_BYTE_CHAR_P (from))
1173 error ("Can't change font for a single byte character");
1174 if (from < to)
1176 if (!char_valid_p (to, 1))
1177 invalid_character (to);
1178 if (SINGLE_BYTE_CHAR_P (to))
1179 error ("Can't change font for a single byte character");
1182 /* The arg FRAME is kept for backward compatibility. We only check
1183 the validity. */
1184 if (!NILP (frame))
1185 CHECK_LIVE_FRAME (frame);
1187 elt = Fcons (make_number (from), regularize_fontname (fontname));
1188 for (; from <= to; from++)
1189 FONTSET_SET (fontset, from, elt);
1190 Foptimize_char_table (fontset);
1192 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1193 clear all the elements of REALIZED and free all multibyte faces
1194 whose fontset is REALIZED. This way, the specified character(s)
1195 are surely redisplayed by a correct font. */
1196 for (id = 0; id < ASIZE (Vfontset_table); id++)
1198 realized = AREF (Vfontset_table, id);
1199 if (!NILP (realized)
1200 && !BASE_FONTSET_P (realized)
1201 && EQ (FONTSET_BASE (realized), fontset))
1203 FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));
1204 clear_fontset_elements (realized);
1205 free_realized_multibyte_face (f, id);
1209 return Qnil;
1212 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
1213 doc: /* Return information about a font named NAME on frame FRAME.
1214 If FRAME is omitted or nil, use the selected frame.
1215 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1216 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1217 where
1218 OPENED-NAME is the name used for opening the font,
1219 FULL-NAME is the full name of the font,
1220 SIZE is the maximum bound width of the font,
1221 HEIGHT is the height of the font,
1222 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1223 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1224 how to compose characters.
1225 If the named font is not yet loaded, return nil. */)
1226 (name, frame)
1227 Lisp_Object name, frame;
1229 FRAME_PTR f;
1230 struct font_info *fontp;
1231 Lisp_Object info;
1233 (*check_window_system_func) ();
1235 CHECK_STRING (name);
1236 name = Fdowncase (name);
1237 if (NILP (frame))
1238 frame = selected_frame;
1239 CHECK_LIVE_FRAME (frame);
1240 f = XFRAME (frame);
1242 if (!query_font_func)
1243 error ("Font query function is not supported");
1245 fontp = (*query_font_func) (f, SDATA (name));
1246 if (!fontp)
1247 return Qnil;
1249 info = Fmake_vector (make_number (7), Qnil);
1251 XVECTOR (info)->contents[0] = build_string (fontp->name);
1252 XVECTOR (info)->contents[1] = build_string (fontp->full_name);
1253 XVECTOR (info)->contents[2] = make_number (fontp->size);
1254 XVECTOR (info)->contents[3] = make_number (fontp->height);
1255 XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset);
1256 XVECTOR (info)->contents[5] = make_number (fontp->relative_compose);
1257 XVECTOR (info)->contents[6] = make_number (fontp->default_ascent);
1259 return info;
1263 /* Return a cons (FONT-NAME . GLYPH-CODE).
1264 FONT-NAME is the font name for the character at POSITION in the current
1265 buffer. This is computed from all the text properties and overlays
1266 that apply to POSITION. POSTION may be nil, in which case,
1267 FONT-NAME is the font name for display the character CH with the
1268 default face.
1270 GLYPH-CODE is the glyph code in the font to use for the character.
1272 If the 2nd optional arg CH is non-nil, it is a character to check
1273 the font instead of the character at POSITION.
1275 It returns nil in the following cases:
1277 (1) The window system doesn't have a font for the character (thus
1278 it is displayed by an empty box).
1280 (2) The character code is invalid.
1282 (3) If POSITION is not nil, and the current buffer is not displayed
1283 in any window.
1285 In addition, the returned font name may not take into account of
1286 such redisplay engine hooks as what used in jit-lock-mode if
1287 POSITION is currently not visible. */
1290 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
1291 doc: /* For internal use only. */)
1292 (position, ch)
1293 Lisp_Object position, ch;
1295 int pos, pos_byte, dummy;
1296 int face_id;
1297 int c, code;
1298 struct frame *f;
1299 struct face *face;
1301 if (NILP (position))
1303 CHECK_NATNUM (ch);
1304 c = XINT (ch);
1305 f = XFRAME (selected_frame);
1306 face_id = DEFAULT_FACE_ID;
1308 else
1310 Lisp_Object window;
1311 struct window *w;
1313 CHECK_NUMBER_COERCE_MARKER (position);
1314 pos = XINT (position);
1315 if (pos < BEGV || pos >= ZV)
1316 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1317 pos_byte = CHAR_TO_BYTE (pos);
1318 if (NILP (ch))
1319 c = FETCH_CHAR (pos_byte);
1320 else
1322 CHECK_NATNUM (ch);
1323 c = XINT (ch);
1325 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1326 if (NILP (window))
1327 return Qnil;
1328 w = XWINDOW (window);
1329 f = XFRAME (w->frame);
1330 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
1332 if (! CHAR_VALID_P (c, 0))
1333 return Qnil;
1334 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
1335 face = FACE_FROM_ID (f, face_id);
1336 if (! face->font || ! face->font_name)
1337 return Qnil;
1340 struct font_info *fontp = (*get_font_info_func) (f, face->font_info_id);
1341 XChar2b char2b;
1342 int c1, c2, charset;
1344 SPLIT_CHAR (c, charset, c1, c2);
1345 if (c2 > 0)
1346 STORE_XCHAR2B (&char2b, c1, c2);
1347 else
1348 STORE_XCHAR2B (&char2b, 0, c1);
1349 rif->encode_char (c, &char2b, fontp, NULL);
1350 code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b);
1352 return Fcons (build_string (face->font_name), make_number (code));
1356 /* Called from Ffontset_info via map_char_table on each leaf of
1357 fontset. ARG is a copy of the default fontset. The current leaf
1358 is indexed by CHARACTER and has value ELT. This function override
1359 the copy by ELT if ELT is not nil. */
1361 static void
1362 override_font_info (fontset, character, elt)
1363 Lisp_Object fontset, character, elt;
1365 if (! NILP (elt))
1366 Faset (fontset, character, elt);
1369 /* Called from Ffontset_info via map_char_table on each leaf of
1370 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1371 ARG)' and FONT-INFOs have this form:
1372 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1373 The current leaf is indexed by CHARACTER and has value ELT. This
1374 function add the information of the current leaf to ARG by
1375 appending a new element or modifying the last element. */
1377 static void
1378 accumulate_font_info (arg, character, elt)
1379 Lisp_Object arg, character, elt;
1381 Lisp_Object last, last_char, last_elt;
1383 if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))
1384 elt = FONTSET_REF (Vdefault_fontset, XINT (character));
1385 if (!CONSP (elt))
1386 return;
1387 last = XCAR (arg);
1388 last_char = XCAR (XCAR (last));
1389 last_elt = XCAR (XCDR (XCAR (last)));
1390 elt = XCDR (elt);
1391 if (!NILP (Fequal (elt, last_elt)))
1393 int this_charset = CHAR_CHARSET (XINT (character));
1395 if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */
1397 if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char))))
1399 XSETCDR (last_char, character);
1400 return;
1403 else if (XINT (last_char) == XINT (character))
1404 return;
1405 else if (this_charset == CHAR_CHARSET (XINT (last_char)))
1407 XSETCAR (XCAR (last), Fcons (last_char, character));
1408 return;
1411 XSETCDR (last, Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil));
1412 XSETCAR (arg, XCDR (last));
1416 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1417 doc: /* Return information about a fontset named NAME on frame FRAME.
1418 If NAME is nil, return information about the default fontset.
1419 The value is a vector:
1420 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],
1421 where,
1422 SIZE is the maximum bound width of ASCII font in the fontset,
1423 HEIGHT is the maximum bound height of ASCII font in the fontset,
1424 CHARSET-OR-RANGE is a charset, a character (may be a generic character)
1425 or a cons of two characters specifying the range of characters.
1426 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),
1427 where FAMILY is a `FAMILY' field of a XLFD font name,
1428 REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name.
1429 FAMILY may contain a `FOUNDRY' field at the head.
1430 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.
1431 OPENEDs are names of fonts actually opened.
1432 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.
1433 If FRAME is omitted, it defaults to the currently selected frame. */)
1434 (name, frame)
1435 Lisp_Object name, frame;
1437 Lisp_Object fontset;
1438 FRAME_PTR f;
1439 Lisp_Object indices[3];
1440 Lisp_Object val, tail, elt;
1441 Lisp_Object *realized;
1442 struct font_info *fontp = NULL;
1443 int n_realized = 0;
1444 int i;
1446 (*check_window_system_func) ();
1448 fontset = check_fontset_name (name);
1450 if (NILP (frame))
1451 frame = selected_frame;
1452 CHECK_LIVE_FRAME (frame);
1453 f = XFRAME (frame);
1455 /* Recode realized fontsets whose base is FONTSET in the table
1456 `realized'. */
1457 realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1458 * ASIZE (Vfontset_table));
1459 for (i = 0; i < ASIZE (Vfontset_table); i++)
1461 elt = FONTSET_FROM_ID (i);
1462 if (!NILP (elt)
1463 && EQ (FONTSET_BASE (elt), fontset))
1464 realized[n_realized++] = elt;
1467 if (! EQ (fontset, Vdefault_fontset))
1469 /* Merge FONTSET onto the default fontset. */
1470 val = Fcopy_sequence (Vdefault_fontset);
1471 map_char_table (override_font_info, Qnil, fontset, fontset, val, 0, indices);
1472 fontset = val;
1475 /* Accumulate information of the fontset in VAL. The format is
1476 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1477 FONT-SPEC). See the comment for accumulate_font_info for the
1478 detail. */
1479 val = Fcons (Fcons (make_number (0),
1480 Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)),
1481 Qnil);
1482 val = Fcons (val, val);
1483 map_char_table (accumulate_font_info, Qnil, fontset, fontset, val, 0, indices);
1484 val = XCDR (val);
1486 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1487 character for a charset, replace it with the charset symbol. If
1488 fonts are opened for FONT-SPEC, append the names of the fonts to
1489 FONT-SPEC. */
1490 for (tail = val; CONSP (tail); tail = XCDR (tail))
1492 int c;
1493 elt = XCAR (tail);
1494 if (INTEGERP (XCAR (elt)))
1496 int charset, c1, c2;
1497 c = XINT (XCAR (elt));
1498 SPLIT_CHAR (c, charset, c1, c2);
1499 if (c1 == 0)
1500 XSETCAR (elt, CHARSET_SYMBOL (charset));
1502 else
1503 c = XINT (XCAR (XCAR (elt)));
1504 for (i = 0; i < n_realized; i++)
1506 Lisp_Object face_id, font;
1507 struct face *face;
1509 face_id = FONTSET_REF_VIA_BASE (realized[i], c);
1510 if (INTEGERP (face_id))
1512 face = FACE_FROM_ID (f, XINT (face_id));
1513 if (face && face->font && face->font_name)
1515 font = build_string (face->font_name);
1516 if (NILP (Fmember (font, XCDR (XCDR (elt)))))
1517 XSETCDR (XCDR (elt), Fcons (font, XCDR (XCDR (elt))));
1523 elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val)));
1524 if (CONSP (elt))
1526 elt = XCAR (elt);
1527 fontp = (*query_font_func) (f, SDATA (elt));
1529 val = Fmake_vector (make_number (3), val);
1530 AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0);
1531 AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0);
1532 return val;
1535 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
1536 doc: /* Return a font name pattern for character CH in fontset NAME.
1537 If NAME is nil, find a font name pattern in the default fontset. */)
1538 (name, ch)
1539 Lisp_Object name, ch;
1541 int c;
1542 Lisp_Object fontset, elt;
1544 fontset = check_fontset_name (name);
1546 CHECK_NUMBER (ch);
1547 c = XINT (ch);
1548 if (!char_valid_p (c, 1))
1549 invalid_character (c);
1551 elt = FONTSET_REF (fontset, c);
1552 if (CONSP (elt))
1553 elt = XCDR (elt);
1555 return elt;
1558 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
1559 doc: /* Return a list of all defined fontset names. */)
1562 Lisp_Object fontset, list;
1563 int i;
1565 list = Qnil;
1566 for (i = 0; i < ASIZE (Vfontset_table); i++)
1568 fontset = FONTSET_FROM_ID (i);
1569 if (!NILP (fontset)
1570 && BASE_FONTSET_P (fontset))
1571 list = Fcons (FONTSET_NAME (fontset), list);
1574 return list;
1577 DEFUN ("set-overriding-fontspec-internal", Fset_overriding_fontspec_internal,
1578 Sset_overriding_fontspec_internal, 1, 1, 0,
1579 doc: /* Internal use only.
1581 FONTLIST is an alist of TARGET vs FONTNAME, where TARGET is a charset
1582 or a char-table, FONTNAME have the same meanings as in
1583 `set-fontset-font'.
1585 It overrides the font specifications for each TARGET in the default
1586 fontset by the corresponding FONTNAME.
1588 If TARGET is a charset, targets are all characters in the charset. If
1589 TARGET is a char-table, targets are characters whose value is non-nil
1590 in the table.
1592 It is intended that this function is called only from
1593 `set-language-environment'. */)
1594 (fontlist)
1595 Lisp_Object fontlist;
1597 Lisp_Object tail;
1599 fontlist = Fcopy_sequence (fontlist);
1600 /* Now FONTLIST is ((TARGET . FONTNAME) ...). Reform it to ((TARGET
1601 nil nil nil FONTSPEC) ...), where TARGET is a charset-id or a
1602 char-table. */
1603 for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
1605 Lisp_Object elt, target;
1607 elt = XCAR (tail);
1608 target = Fcar (elt);
1609 elt = Fcons (Qnil, regularize_fontname (Fcdr (elt)));
1610 if (! CHAR_TABLE_P (target))
1612 int charset, c;
1614 CHECK_SYMBOL (target);
1615 charset = get_charset_id (target);
1616 if (charset < 0)
1617 error ("Invalid charset %s", SDATA (SYMBOL_NAME (target)));
1618 target = make_number (charset);
1619 c = MAKE_CHAR (charset, 0, 0);
1620 XSETCAR (elt, make_number (c));
1622 elt = Fcons (target, Fcons (Qnil, Fcons (Qnil, elt)));
1623 XSETCAR (tail, elt);
1625 if (! NILP (Fequal (fontlist, Voverriding_fontspec_alist)))
1626 return Qnil;
1627 Voverriding_fontspec_alist = fontlist;
1628 clear_face_cache (0);
1629 ++windows_or_buffers_changed;
1630 return Qnil;
1633 void
1634 syms_of_fontset ()
1636 if (!load_font_func)
1637 /* Window system initializer should have set proper functions. */
1638 abort ();
1640 Qfontset = intern ("fontset");
1641 staticpro (&Qfontset);
1642 Fput (Qfontset, Qchar_table_extra_slots, make_number (3));
1644 Vcached_fontset_data = Qnil;
1645 staticpro (&Vcached_fontset_data);
1647 Vfontset_table = Fmake_vector (make_number (32), Qnil);
1648 staticpro (&Vfontset_table);
1650 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
1651 staticpro (&Vdefault_fontset);
1652 FONTSET_ID (Vdefault_fontset) = make_number (0);
1653 FONTSET_NAME (Vdefault_fontset)
1654 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1655 AREF (Vfontset_table, 0) = Vdefault_fontset;
1656 next_fontset_id = 1;
1658 Voverriding_fontspec_alist = Qnil;
1659 staticpro (&Voverriding_fontspec_alist);
1661 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
1662 doc: /* Alist of fontname patterns vs corresponding encoding info.
1663 Each element looks like (REGEXP . ENCODING-INFO),
1664 where ENCODING-INFO is an alist of CHARSET vs ENCODING.
1665 ENCODING is one of the following integer values:
1666 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,
1667 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,
1668 2: code points 0x20A0..0x7FFF are used,
1669 3: code points 0xA020..0xFF7F are used. */);
1670 Vfont_encoding_alist = Qnil;
1671 Vfont_encoding_alist
1672 = Fcons (Fcons (build_string ("JISX0201"),
1673 Fcons (Fcons (intern ("latin-jisx0201"), make_number (0)),
1674 Qnil)),
1675 Vfont_encoding_alist);
1676 Vfont_encoding_alist
1677 = Fcons (Fcons (build_string ("ISO8859-1"),
1678 Fcons (Fcons (intern ("ascii"), make_number (0)),
1679 Qnil)),
1680 Vfont_encoding_alist);
1682 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
1683 doc: /* Char table of characters whose ascent values should be ignored.
1684 If an entry for a character is non-nil, the ascent value of the glyph
1685 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
1687 This affects how a composite character which contains
1688 such a character is displayed on screen. */);
1689 Vuse_default_ascent = Qnil;
1691 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
1692 doc: /* Char table of characters which is not composed relatively.
1693 If an entry for a character is non-nil, a composition sequence
1694 which contains that character is displayed so that
1695 the glyph of that character is put without considering
1696 an ascent and descent value of a previous character. */);
1697 Vignore_relative_composition = Qnil;
1699 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
1700 doc: /* Alist of fontname vs list of the alternate fontnames.
1701 When a specified font name is not found, the corresponding
1702 alternate fontnames (if any) are tried instead. */);
1703 Valternate_fontname_alist = Qnil;
1705 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
1706 doc: /* Alist of fontset names vs the aliases. */);
1707 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
1708 build_string ("fontset-default")),
1709 Qnil);
1711 DEFVAR_LISP ("vertical-centering-font-regexp",
1712 &Vvertical_centering_font_regexp,
1713 doc: /* *Regexp matching font names that require vertical centering on display.
1714 When a character is displayed with such fonts, the character is displayed
1715 at the vertical center of lines. */);
1716 Vvertical_centering_font_regexp = Qnil;
1718 defsubr (&Squery_fontset);
1719 defsubr (&Snew_fontset);
1720 defsubr (&Sset_fontset_font);
1721 defsubr (&Sfont_info);
1722 defsubr (&Sinternal_char_font);
1723 defsubr (&Sfontset_info);
1724 defsubr (&Sfontset_font);
1725 defsubr (&Sfontset_list);
1726 defsubr (&Sset_overriding_fontspec_internal);
1729 /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
1730 (do not change this comment) */