(map_char_table): Ignore char-table entries for
[bpt/emacs.git] / src / fontset.c
CommitLineData
4ed46869 1/* Fontset handler.
0d407d77 2 Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
75c8c592 3 Licensed to the Free Software Foundation.
4ed46869 4
369314dc
KH
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
4ed46869 11
369314dc
KH
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
4ed46869 16
369314dc
KH
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
4ed46869 21
0d407d77
KH
22/* #define FONTSET_DEBUG */
23
4ed46869 24#include <config.h>
0d407d77
KH
25
26#ifdef FONTSET_DEBUG
27#include <stdio.h>
28#endif
29
4ed46869 30#include "lisp.h"
1ff005e1 31#include "buffer.h"
4ed46869
KH
32#include "charset.h"
33#include "ccl.h"
4ed46869 34#include "frame.h"
0d407d77 35#include "dispextern.h"
3541bb8f 36#include "fontset.h"
0d407d77
KH
37#include "window.h"
38
39#ifdef FONTSET_DEBUG
40#undef xassert
41#define xassert(X) do {if (!(X)) abort ();} while (0)
42#undef INLINE
43#define INLINE
44#endif
45
46
47/* FONTSET
48
49 A fontset is a collection of font related information to give
50 similar appearance (style, size, etc) of characters. There are two
51 kinds of fontsets; base and realized. A base fontset is created by
52 new-fontset from Emacs Lisp explicitly. A realized fontset is
53 created implicitly when a face is realized for ASCII characters. A
54 face is also realized for multibyte characters based on an ASCII
55 face. All of the multibyte faces based on the same ASCII face
56 share the same realized fontset.
57
58 A fontset object is implemented by a char-table.
59
60 An element of a base fontset is:
61 (INDEX . FONTNAME) or
62 (INDEX . (FOUNDRY . REGISTRY ))
63 FONTNAME is a font name pattern for the corresponding character.
64 FOUNDRY and REGISTRY are respectively foundy and regisry fields of
65 a font name for the corresponding character. INDEX specifies for
66 which character (or generic character) the element is defined. It
67 may be different from an index to access this element. For
68 instance, if a fontset defines some font for all characters of
69 charset `japanese-jisx0208', INDEX is the generic character of this
70 charset. REGISTRY is the
71
72 An element of a realized fontset is FACE-ID which is a face to use
73 for displaying the correspnding character.
74
75 All single byte charaters (ASCII and 8bit-unibyte) share the same
76 element in a fontset. The element is stored in `defalt' slot of
77 the fontset. And this slot is never used as a default value of
78 multibyte characters. That means that the first 256 elements of a
1ff005e1
KH
79 fontset are always nil (as this is not efficient, we may implement
80 a fontset in a different way in the future).
0d407d77
KH
81
82 To access or set each element, use macros FONTSET_REF and
83 FONTSET_SET respectively for efficiency.
84
85 A fontset has 3 extra slots.
86
87 The 1st slot is an ID number of the fontset.
88
89 The 2nd slot is a name of the fontset. This is nil for a realized
90 face.
91
92 The 3rd slot is a frame that the fontset belongs to. This is nil
93 for a default face.
94
95 A parent of a base fontset is nil. A parent of a realized fontset
96 is a base fontset.
97
98 All fontsets (except for the default fontset described below) are
99 recorded in Vfontset_table.
100
101
102 DEFAULT FONTSET
103
104 There's a special fontset named `default fontset' which defines a
105 default fontname that contains only REGISTRY field for each
106 character. When a base fontset doesn't specify a font for a
107 specific character, the corresponding value in the default fontset
108 is used. The format is the same as a base fontset.
109
110 The parent of realized fontsets created for faces that have no
111 fontset is the default fontset.
112
113
114 These structures are hidden from the other codes than this file.
115 The other codes handle fontsets only by their ID numbers. They
116 usually use variable name `fontset' for IDs. But, in this file, we
117 always use varialbe name `id' for IDs, and name `fontset' for the
118 actual fontset objects.
119
120*/
121
122/********** VARIABLES and FUNCTION PROTOTYPES **********/
123
124extern Lisp_Object Qfont;
125Lisp_Object Qfontset;
126
127/* Vector containing all fontsets. */
128static Lisp_Object Vfontset_table;
129
130/* Next possibly free fontset ID. Usually this keeps the mininum
131 fontset ID not yet used. */
132static int next_fontset_id;
133
134/* The default fontset. This gives default FAMILY and REGISTRY of
135 font for each characters. */
136static Lisp_Object Vdefault_fontset;
4ed46869 137
4ed46869 138Lisp_Object Vfont_encoding_alist;
6a7e6d80 139Lisp_Object Vuse_default_ascent;
2aeafb78 140Lisp_Object Vignore_relative_composition;
01d4b817 141Lisp_Object Valternate_fontname_alist;
1c283e35 142Lisp_Object Vfontset_alias_alist;
ec3bb068
KH
143Lisp_Object Vhighlight_wrong_size_font;
144Lisp_Object Vclip_large_size_font;
810abb87 145Lisp_Object Vvertical_centering_font_regexp;
4ed46869 146
0d407d77
KH
147/* The following six are declarations of callback functions depending
148 on window system. See the comments in src/fontset.h for more
149 detail. */
4ed46869
KH
150
151/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
5771dcf4 152struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx));
4ed46869
KH
153
154/* Return a list of font names which matches PATTERN. See the document of
155 `x-list-fonts' for more detail. */
3541bb8f
KH
156Lisp_Object (*list_fonts_func) P_ ((struct frame *f,
157 Lisp_Object pattern,
158 int size,
159 int maxnames));
4ed46869
KH
160
161/* Load a font named NAME for frame F and return a pointer to the
162 information of the loaded font. If loading is failed, return 0. */
5771dcf4 163struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int));
4ed46869
KH
164
165/* Return a pointer to struct font_info of a font named NAME for frame F. */
5771dcf4 166struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name));
4ed46869
KH
167
168/* Additional function for setting fontset or changing fontset
169 contents of frame F. */
5771dcf4
AS
170void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg,
171 Lisp_Object oldval));
4ed46869 172
727fb790
KH
173/* To find a CCL program, fs_load_font calls this function.
174 The argument is a pointer to the struct font_info.
175 This function set the memer `encoder' of the structure. */
176void (*find_ccl_program_func) P_ ((struct font_info *));
177
4ed46869 178/* Check if any window system is used now. */
5771dcf4 179void (*check_window_system_func) P_ ((void));
4ed46869 180
0d407d77
KH
181
182/* Prototype declarations for static functions. */
183static Lisp_Object fontset_ref P_ ((Lisp_Object, int));
184static void fontset_set P_ ((Lisp_Object, int, Lisp_Object));
185static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
186static int fontset_id_valid_p P_ ((int));
187static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
188static Lisp_Object font_family_registry P_ ((Lisp_Object));
189
190\f
191/********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
192
193/* Macros for Lisp vector. */
194#define AREF(V, IDX) XVECTOR (V)->contents[IDX]
195#define ASIZE(V) XVECTOR (V)->size
196
197/* Return the fontset with ID. No check of ID's validness. */
198#define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
199
200/* Macros to access extra, default, and parent slots, of fontset. */
201#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
202#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
203#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
204#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->defalt
205#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
206
207#define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
208
209
210/* Return the element of FONTSET (char-table) at index C (character). */
211
212#define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
213
214static INLINE Lisp_Object
215fontset_ref (fontset, c)
216 Lisp_Object fontset;
217 int c;
218{
219 int charset, c1, c2;
220 Lisp_Object elt, defalt;
221 int i;
222
223 if (SINGLE_BYTE_CHAR_P (c))
224 return FONTSET_ASCII (fontset);
225
f55d03b1 226 SPLIT_CHAR (c, charset, c1, c2);
0d407d77
KH
227 elt = XCHAR_TABLE (fontset)->contents[charset + 128];
228 if (!SUB_CHAR_TABLE_P (elt))
229 return elt;
230 defalt = XCHAR_TABLE (elt)->defalt;
231 if (c1 < 32
232 || (elt = XCHAR_TABLE (elt)->contents[c1],
233 NILP (elt)))
234 return defalt;
235 if (!SUB_CHAR_TABLE_P (elt))
236 return elt;
237 defalt = XCHAR_TABLE (elt)->defalt;
238 if (c2 < 32
239 || (elt = XCHAR_TABLE (elt)->contents[c2],
240 NILP (elt)))
241 return defalt;
242 return elt;
243}
244
245
246#define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
247
248static INLINE Lisp_Object
249fontset_ref_via_base (fontset, c)
250 Lisp_Object fontset;
251 int *c;
252{
253 int charset, c1, c2;
254 Lisp_Object elt;
0d407d77
KH
255
256 if (SINGLE_BYTE_CHAR_P (*c))
257 return FONTSET_ASCII (fontset);
258
259 elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
260 if (NILP (elt))
261 return Qnil;
262
263 *c = XINT (XCAR (elt));
f55d03b1 264 SPLIT_CHAR (*c, charset, c1, c2);
0d407d77
KH
265 elt = XCHAR_TABLE (fontset)->contents[charset + 128];
266 if (c1 < 32)
267 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
268 if (!SUB_CHAR_TABLE_P (elt))
269 return Qnil;
270 elt = XCHAR_TABLE (elt)->contents[c1];
271 if (c2 < 32)
272 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
273 if (!SUB_CHAR_TABLE_P (elt))
274 return Qnil;
275 elt = XCHAR_TABLE (elt)->contents[c2];
276 return elt;
277}
278
279
280/* Store into the element of FONTSET at index C the value NEWETL. */
281#define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
282
283static void
284fontset_set (fontset, c, newelt)
285 Lisp_Object fontset;
286 int c;
287 Lisp_Object newelt;
288{
289 int charset, code[3];
290 Lisp_Object *elt, tmp;
291 int i, j;
292
293 if (SINGLE_BYTE_CHAR_P (c))
294 {
295 FONTSET_ASCII (fontset) = newelt;
296 return;
297 }
298
f55d03b1 299 SPLIT_CHAR (c, charset, code[0], code[1]);
0d407d77
KH
300 code[2] = 0; /* anchor */
301 elt = &XCHAR_TABLE (fontset)->contents[charset + 128];
302 for (i = 0; code[i] > 0; i++)
303 {
304 if (!SUB_CHAR_TABLE_P (*elt))
305 *elt = make_sub_char_table (*elt);
306 elt = &XCHAR_TABLE (*elt)->contents[code[i]];
307 }
308 if (SUB_CHAR_TABLE_P (*elt))
309 XCHAR_TABLE (*elt)->defalt = newelt;
310 else
311 *elt = newelt;
312}
313
314
315/* Return a newly created fontset with NAME. If BASE is nil, make a
316 base fontset. Otherwise make a realized fontset whose parent is
317 BASE. */
318
319static Lisp_Object
320make_fontset (frame, name, base)
321 Lisp_Object frame, name, base;
4ed46869 322{
0d407d77
KH
323 Lisp_Object fontset, elt, base_elt;
324 int size = ASIZE (Vfontset_table);
325 int id = next_fontset_id;
326 int i, j;
327
328 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
329 the next available fontset ID. So it is expected that this loop
330 terminates quickly. In addition, as the last element of
331 Vfotnset_table is always nil, we don't have to check the range of
332 id. */
333 while (!NILP (AREF (Vfontset_table, id))) id++;
334
335 if (id + 1 == size)
336 {
337 Lisp_Object tem;
338 int i;
4ed46869 339
0d407d77
KH
340 tem = Fmake_vector (make_number (size + 8), Qnil);
341 for (i = 0; i < size; i++)
342 AREF (tem, i) = AREF (Vfontset_table, i);
343 Vfontset_table = tem;
344 }
4ed46869 345
0d407d77
KH
346 if (NILP (base))
347 fontset = Fcopy_sequence (Vdefault_fontset);
348 else
349 fontset = Fmake_char_table (Qfontset, Qnil);
350
351 FONTSET_ID (fontset) = make_number (id);
352 FONTSET_NAME (fontset) = name;
353 FONTSET_FRAME (fontset) = frame;
354 FONTSET_BASE (fontset) = base;
355
356 AREF (Vfontset_table, id) = fontset;
357 next_fontset_id = id + 1;
358 return fontset;
4ed46869
KH
359}
360
0d407d77
KH
361
362/* Return 1 if ID is a valid fontset id, else return 0. */
363
364static INLINE int
365fontset_id_valid_p (id)
366 int id;
367{
368 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
369}
370
371
372/* Extract `family' and `registry' string from FONTNAME and set in
373 *FAMILY and *REGISTRY respectively. Actually, `family' may also
374 contain `foundry', `registry' may also contain `encoding' of
375 FONTNAME. */
376
377static Lisp_Object
378font_family_registry (fontname)
379 Lisp_Object fontname;
380{
381 Lisp_Object family, registry;
382 char *p = XSTRING (fontname)->data;
383 char *sep[15];
384 int i = 0;
385
386 while (*p && i < 15) if (*p++ == '-') sep[i++] = p;
387 if (i != 14)
388 return fontname;
389
390 family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);
391 registry = make_unibyte_string (sep[12], p - sep[12]);
392 return Fcons (family, registry);
393}
394
395\f
396/********** INTERFACES TO xfaces.c and dispextern.h **********/
397
398/* Return name of the fontset with ID. */
399
400Lisp_Object
401fontset_name (id)
402 int id;
403{
404 Lisp_Object fontset;
405 fontset = FONTSET_FROM_ID (id);
406 return FONTSET_NAME (fontset);
407}
408
409
410/* Return ASCII font name of the fontset with ID. */
411
412Lisp_Object
413fontset_ascii (id)
414 int id;
415{
416 Lisp_Object fontset, elt;
417 fontset= FONTSET_FROM_ID (id);
418 elt = FONTSET_ASCII (fontset);
419 return XCDR (elt);
420}
421
422
423/* Free fontset of FACE. Called from free_realized_face. */
424
4ed46869 425void
0d407d77
KH
426free_face_fontset (f, face)
427 FRAME_PTR f;
428 struct face *face;
4ed46869 429{
0d407d77 430 if (fontset_id_valid_p (face->fontset))
4ed46869 431 {
0d407d77
KH
432 AREF (Vfontset_table, face->fontset) = Qnil;
433 if (face->fontset < next_fontset_id)
434 next_fontset_id = face->fontset;
435 }
436}
18998710 437
0d407d77
KH
438
439/* Return 1 iff FACE is suitable for displaying character C.
440 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
441 when C is not a single byte character.. */
442
443int
444face_suitable_for_char_p (face, c)
445 struct face *face;
446 int c;
447{
448 Lisp_Object fontset, elt;
449
450 if (SINGLE_BYTE_CHAR_P (c))
451 return (face == face->ascii_face);
452
453 xassert (fontset_id_valid_p (face->fontset));
454 fontset = FONTSET_FROM_ID (face->fontset);
455 xassert (!BASE_FONTSET_P (fontset));
456
457 elt = FONTSET_REF_VIA_BASE (fontset, c);
458 return (!NILP (elt) && face->id == XFASTINT (elt));
459}
460
461
462/* Return ID of face suitable for displaying character C on frame F.
463 The selection of face is done based on the fontset of FACE. FACE
464 should already have been realized for ASCII characters. Called
465 from the macro FACE_FOR_CHAR when C is not a single byte character. */
466
467int
468face_for_char (f, face, c)
469 FRAME_PTR f;
470 struct face *face;
471 int c;
472{
473 Lisp_Object fontset, elt;
474 int face_id;
475
476 xassert (fontset_id_valid_p (face->fontset));
477 fontset = FONTSET_FROM_ID (face->fontset);
478 xassert (!BASE_FONTSET_P (fontset));
479
480 elt = FONTSET_REF_VIA_BASE (fontset, c);
481 if (!NILP (elt))
482 return XINT (elt);
483
484 /* No face is recorded for C in the fontset of FACE. Make a new
485 realized face for C that has the same fontset. */
486 face_id = lookup_face (f, face->lface, c, face);
487
488 /* Record the face ID in FONTSET at the same index as the
489 information in the base fontset. */
490 FONTSET_SET (fontset, c, make_number (face_id));
491 return face_id;
492}
493
494
495/* Make a realized fontset for ASCII face FACE on frame F from the
496 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
497 default fontset as the base. Value is the id of the new fontset.
498 Called from realize_x_face. */
499
500int
501make_fontset_for_ascii_face (f, base_fontset_id)
502 FRAME_PTR f;
503 int base_fontset_id;
504{
505 Lisp_Object base_fontset, fontset, name, frame;
506
507 XSETFRAME (frame, f);
508 if (base_fontset_id >= 0)
509 {
510 base_fontset = FONTSET_FROM_ID (base_fontset_id);
511 if (!BASE_FONTSET_P (base_fontset))
512 base_fontset = FONTSET_BASE (base_fontset);
513 xassert (BASE_FONTSET_P (base_fontset));
4ed46869 514 }
0d407d77
KH
515 else
516 base_fontset = Vdefault_fontset;
517
518 fontset = make_fontset (frame, Qnil, base_fontset);
f3231837 519 return XINT (FONTSET_ID (fontset));
0d407d77
KH
520}
521
522
523/* Return the font name pattern for C that is recorded in the fontset
524 with ID. A font is opened by that pattern to get the fullname. If
525 the fullname conform to XLFD, extract foundry-family field and
526 registry-encoding field, and return the cons of them. Otherwise
527 return the fullname. If ID is -1, or the fontset doesn't contain
528 information about C, get the registry and encoding of C from the
529 default fontset. Called from choose_face_font. */
530
531Lisp_Object
532fontset_font_pattern (f, id, c)
533 FRAME_PTR f;
534 int id, c;
535{
536 Lisp_Object fontset, elt;
537 struct font_info *fontp;
538 Lisp_Object family_registry;
539
540 elt = Qnil;
541 if (fontset_id_valid_p (id))
542 {
543 fontset = FONTSET_FROM_ID (id);
544 xassert (!BASE_FONTSET_P (fontset));
545 fontset = FONTSET_BASE (fontset);
546 elt = FONTSET_REF (fontset, c);
547 }
548 else
549 elt = FONTSET_REF (Vdefault_fontset, c);
550
551 if (!CONSP (elt))
552 return Qnil;
553 if (CONSP (XCDR (elt)))
554 return XCDR (elt);
555
556 /* The fontset specifies only a font name pattern (not cons of
557 family and registry). Try to open a font by that pattern and get
558 a registry from the full name of the opened font. We ignore
559 family name here because it should be wild card in the fontset
560 specification. */
561 elt = XCDR (elt);
562 xassert (STRINGP (elt));
563 fontp = FS_LOAD_FONT (f, c, XSTRING (elt)->data, -1);
564 if (!fontp)
565 return Qnil;
4ed46869 566
0d407d77
KH
567 family_registry = font_family_registry (build_string (fontp->full_name));
568 if (!CONSP (family_registry))
569 return family_registry;
570 XCAR (family_registry) = Qnil;
571 return family_registry;
4ed46869
KH
572}
573
d5e7d534 574
0d407d77
KH
575/* Load a font named FONTNAME to display character C on frame F.
576 Return a pointer to the struct font_info of the loaded font. If
577 loading fails, return NULL. If FACE is non-zero and a fontset is
578 assigned to it, record FACE->id in the fontset for C. If FONTNAME
579 is NULL, the name is taken from the fontset of FACE or what
580 specified by ID. */
4ed46869
KH
581
582struct font_info *
0d407d77 583fs_load_font (f, c, fontname, id, face)
4ed46869 584 FRAME_PTR f;
0d407d77 585 int c;
4ed46869 586 char *fontname;
0d407d77
KH
587 int id;
588 struct face *face;
4ed46869 589{
0d407d77 590 Lisp_Object fontset;
4ed46869
KH
591 Lisp_Object list, elt;
592 int font_idx;
593 int size = 0;
4ed46869 594 struct font_info *fontp;
0d407d77
KH
595 int charset = CHAR_CHARSET (c);
596
597 if (face)
598 id = face->fontset;
599 if (id < 0)
600 fontset = Qnil;
601 else
602 fontset = FONTSET_FROM_ID (id);
4ed46869 603
0d407d77
KH
604 if (!NILP (fontset)
605 && !BASE_FONTSET_P (fontset))
4ed46869 606 {
0d407d77
KH
607 elt = FONTSET_REF_VIA_BASE (fontset, c);
608 if (!NILP (elt))
609 {
610 /* A suitable face for C is already recorded, which means
611 that a proper font is already loaded. */
612 int face_id = XINT (elt);
4ed46869 613
0d407d77
KH
614 xassert (face_id == face->id);
615 face = FACE_FROM_ID (f, face_id);
616 return (*get_font_info_func) (f, face->font_info_id);
617 }
4ed46869 618
0d407d77 619 if (!fontname && charset == CHARSET_ASCII)
afbee0fa 620 {
0d407d77
KH
621 elt = FONTSET_ASCII (fontset);
622 fontname = XSTRING (XCDR (elt))->data;
afbee0fa 623 }
afbee0fa 624 }
4ed46869 625
0d407d77
KH
626 if (!fontname)
627 /* No way to get fontname. */
628 return 0;
4ed46869 629
0d407d77 630 fontp = (*load_font_func) (f, fontname, size);
4ed46869 631 if (!fontp)
0d407d77 632 return 0;
4ed46869 633
0d407d77
KH
634 /* Fill in members (charset, vertical_centering, encoding, etc) of
635 font_info structure that are not set by (*load_font_func). */
4ed46869
KH
636 fontp->charset = charset;
637
810abb87
KH
638 fontp->vertical_centering
639 = (STRINGP (Vvertical_centering_font_regexp)
640 && (fast_c_string_match_ignore_case
641 (Vvertical_centering_font_regexp, fontp->full_name) >= 0));
642
afbee0fa 643 if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
4ed46869
KH
644 {
645 /* The font itself tells which code points to be used. Use this
646 encoding for all other charsets. */
647 int i;
648
649 fontp->encoding[0] = fontp->encoding[1];
467e7675 650 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
4ed46869
KH
651 fontp->encoding[i] = fontp->encoding[1];
652 }
653 else
654 {
0d407d77 655 /* The font itself doesn't have information about encoding. */
4ed46869
KH
656 int i;
657
40292c8a
KH
658 fontname = fontp->full_name;
659 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
660 others is 1 (i.e. 0x80..0xFF). */
661 fontp->encoding[0] = 0;
467e7675 662 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
4ed46869
KH
663 fontp->encoding[i] = 1;
664 /* Then override them by a specification in Vfont_encoding_alist. */
7539e11f 665 for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list))
4ed46869 666 {
7539e11f 667 elt = XCAR (list);
4ed46869 668 if (CONSP (elt)
7539e11f
KR
669 && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
670 && (fast_c_string_match_ignore_case (XCAR (elt), fontname)
4ed46869
KH
671 >= 0))
672 {
673 Lisp_Object tmp;
674
7539e11f
KR
675 for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp))
676 if (CONSP (XCAR (tmp))
677 && ((i = get_charset_id (XCAR (XCAR (tmp))))
4ed46869 678 >= 0)
7539e11f
KR
679 && INTEGERP (XCDR (XCAR (tmp)))
680 && XFASTINT (XCDR (XCAR (tmp))) < 4)
4ed46869 681 fontp->encoding[i]
7539e11f 682 = XFASTINT (XCDR (XCAR (tmp)));
4ed46869
KH
683 }
684 }
685 }
686
687 fontp->font_encoder = (struct ccl_program *) 0;
727fb790
KH
688
689 if (find_ccl_program_func)
690 (*find_ccl_program_func) (fontp);
4ed46869 691
1ff005e1
KH
692 /* If we loaded a font for a face that has fontset, record the face
693 ID in the fontset for C. */
694 if (face
695 && !NILP (fontset)
696 && !BASE_FONTSET_P (fontset))
697 FONTSET_SET (fontset, c, make_number (face->id));
4ed46869
KH
698 return fontp;
699}
700
0d407d77 701\f
4ed46869
KH
702/* Cache data used by fontset_pattern_regexp. The car part is a
703 pattern string containing at least one wild card, the cdr part is
704 the corresponding regular expression. */
705static Lisp_Object Vcached_fontset_data;
706
7539e11f
KR
707#define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
708#define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
4ed46869
KH
709
710/* If fontset name PATTERN contains any wild card, return regular
711 expression corresponding to PATTERN. */
712
0d407d77 713static Lisp_Object
4ed46869
KH
714fontset_pattern_regexp (pattern)
715 Lisp_Object pattern;
716{
4ed46869
KH
717 if (!index (XSTRING (pattern)->data, '*')
718 && !index (XSTRING (pattern)->data, '?'))
719 /* PATTERN does not contain any wild cards. */
1c283e35 720 return Qnil;
4ed46869
KH
721
722 if (!CONSP (Vcached_fontset_data)
723 || strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME))
724 {
725 /* We must at first update the cached data. */
1c283e35 726 char *regex = (char *) alloca (XSTRING (pattern)->size * 2);
4ed46869
KH
727 char *p0, *p1 = regex;
728
1c283e35
KH
729 /* Convert "*" to ".*", "?" to ".". */
730 *p1++ = '^';
ea5239ec 731 for (p0 = (char *) XSTRING (pattern)->data; *p0; p0++)
4ed46869 732 {
1c283e35 733 if (*p0 == '*')
4ed46869 734 {
1c283e35
KH
735 *p1++ = '.';
736 *p1++ = '*';
4ed46869 737 }
1c283e35 738 else if (*p0 == '?')
d96d677d 739 *p1++ = '.';
1c283e35
KH
740 else
741 *p1++ = *p0;
4ed46869
KH
742 }
743 *p1++ = '$';
744 *p1++ = 0;
745
746 Vcached_fontset_data = Fcons (build_string (XSTRING (pattern)->data),
747 build_string (regex));
748 }
749
750 return CACHED_FONTSET_REGEX;
751}
752
0d407d77
KH
753/* Return ID of the base fontset named NAME. If there's no such
754 fontset, return -1. */
755
756int
757fs_query_fontset (name, regexpp)
758 Lisp_Object name;
759 int regexpp;
760{
761 Lisp_Object fontset, tem;
762 int i;
763
764 name = Fdowncase (name);
765 if (!regexpp)
766 {
767 tem = Frassoc (name, Vfontset_alias_alist);
768 if (CONSP (tem) && STRINGP (XCAR (tem)))
769 name = XCAR (tem);
770 else
771 {
772 tem = fontset_pattern_regexp (name);
773 if (STRINGP (tem))
774 {
775 name = tem;
776 regexpp = 1;
777 }
778 }
779 }
780
781 for (i = 0; i < ASIZE (Vfontset_table); i++)
782 {
783 Lisp_Object fontset;
784 unsigned char *this_name;
785
786 fontset = FONTSET_FROM_ID (i);
787 if (NILP (fontset)
788 || !BASE_FONTSET_P (fontset))
789 continue;
790
791 this_name = XSTRING (FONTSET_NAME (fontset))->data;
792 if (regexpp
793 ? fast_c_string_match_ignore_case (name, this_name) >= 0
794 : !strcmp (XSTRING (name)->data, this_name))
795 return i;
796 }
797 return -1;
798}
799
800
727fb790 801DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
0d407d77 802 "Return the name of a fontset that matches PATTERN.\n\
9af3dc47
RS
803The value is nil if there is no matching fontset.\n\
804PATTERN can contain `*' or `?' as a wildcard\n\
805just as X font name matching algorithm allows.\n\
806If REGEXPP is non-nil, PATTERN is a regular expression.")
727fb790
KH
807 (pattern, regexpp)
808 Lisp_Object pattern, regexpp;
4ed46869 809{
0d407d77
KH
810 Lisp_Object fontset;
811 int id;
4ed46869
KH
812
813 (*check_window_system_func) ();
814
815 CHECK_STRING (pattern, 0);
816
817 if (XSTRING (pattern)->size == 0)
818 return Qnil;
819
0d407d77
KH
820 id = fs_query_fontset (pattern, !NILP (regexpp));
821 if (id < 0)
822 return Qnil;
4ed46869 823
0d407d77
KH
824 fontset = FONTSET_FROM_ID (id);
825 return FONTSET_NAME (fontset);
4ed46869
KH
826}
827
0d407d77
KH
828/* Return a list of base fontset names matching PATTERN on frame F.
829 If SIZE is not 0, it is the size (maximum bound width) of fontsets
830 to be listed. */
4ed46869
KH
831
832Lisp_Object
833list_fontsets (f, pattern, size)
834 FRAME_PTR f;
835 Lisp_Object pattern;
836 int size;
837{
0d407d77
KH
838 Lisp_Object frame, regexp, val, tail;
839 int id;
4ed46869 840
0d407d77 841 XSETFRAME (frame, f);
4ed46869 842
0d407d77 843 regexp = fontset_pattern_regexp (pattern);
4ed46869 844 val = Qnil;
4ed46869 845
0d407d77
KH
846 for (id = 0; id < ASIZE (Vfontset_table); id++)
847 {
848 Lisp_Object fontset;
849 unsigned char *name;
850
851 fontset = FONTSET_FROM_ID (id);
852 if (NILP (fontset)
853 || !BASE_FONTSET_P (fontset)
854 || !EQ (frame, FONTSET_FRAME (fontset)))
855 continue;
856 name = XSTRING (FONTSET_NAME (fontset))->data;
857
858 if (!NILP (regexp)
859 ? (fast_c_string_match_ignore_case (regexp, name) < 0)
860 : strcmp (XSTRING (pattern)->data, name))
861 continue;
862
863 if (size)
4ed46869 864 {
0d407d77
KH
865 struct font_info *fontp;
866 fontp = FS_LOAD_FONT (f, 0, NULL, id);
867 if (!fontp || size != fontp->size)
868 continue;
4ed46869 869 }
0d407d77 870 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
4ed46869
KH
871 }
872
873 return val;
874}
875
876DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
0d407d77
KH
877 "Create a new fontset NAME that contains font information in FONTLIST.\n\
878FONTLIST is an alist of charsets vs corresponding font name patterns.")
4ed46869
KH
879 (name, fontlist)
880 Lisp_Object name, fontlist;
881{
0d407d77
KH
882 Lisp_Object fontset, elements, ascii_font;
883 Lisp_Object tem, tail, elt;
4ed46869
KH
884
885 (*check_window_system_func) ();
886
887 CHECK_STRING (name, 0);
888 CHECK_LIST (fontlist, 1);
889
0d407d77
KH
890 name = Fdowncase (name);
891 tem = Fquery_fontset (name, Qnil);
892 if (!NILP (tem))
9af3dc47 893 error ("Fontset `%s' matches the existing fontset `%s'",
0d407d77 894 XSTRING (name)->data, XSTRING (tem)->data);
4ed46869 895
0d407d77
KH
896 /* Check the validity of FONTLIST while creating a template for
897 fontset elements. */
898 elements = ascii_font = Qnil;
7539e11f 899 for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
4ed46869 900 {
0d407d77
KH
901 Lisp_Object family, registry;
902 int c, charset;
4ed46869 903
0d407d77 904 tem = XCAR (tail);
4ed46869 905 if (!CONSP (tem)
7539e11f
KR
906 || (charset = get_charset_id (XCAR (tem))) < 0
907 || !STRINGP (XCDR (tem)))
4ed46869 908 error ("Elements of fontlist must be a cons of charset and font name");
0d407d77
KH
909
910 tem = Fdowncase (XCDR (tem));
911 if (charset == CHARSET_ASCII)
912 ascii_font = tem;
913 else
914 {
915 c = MAKE_CHAR (charset, 0, 0);
916 elements = Fcons (Fcons (make_number (c), tem), elements);
917 }
4ed46869
KH
918 }
919
0d407d77
KH
920 if (NILP (ascii_font))
921 error ("No ASCII font in the fontlist");
4ed46869 922
0d407d77
KH
923 fontset = make_fontset (Qnil, name, Qnil);
924 FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font);
925 for (; CONSP (elements); elements = XCDR (elements))
926 {
927 elt = XCAR (elements);
928 tem = Fcons (XCAR (elt), font_family_registry (XCDR (elt)));
929 FONTSET_SET (fontset, XINT (XCAR (elt)), tem);
930 }
4ed46869
KH
931
932 return Qnil;
933}
934
4ed46869 935
0d407d77
KH
936/* Clear all elements of FONTSET for multibyte characters. */
937
938static void
939clear_fontset_elements (fontset)
940 Lisp_Object fontset;
4ed46869 941{
0d407d77 942 int i;
4ed46869 943
0d407d77
KH
944 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
945 XCHAR_TABLE (fontset)->contents[i] = Qnil;
946}
4ed46869 947
4ed46869 948
0d407d77
KH
949/* Return 1 iff REGISTRY is a valid string as the font registry and
950 encoding. It is valid if it doesn't start with `-' and the number
951 of `-' in the string is at most 1. */
952
953static int
954check_registry_encoding (registry)
955 Lisp_Object registry;
956{
957 unsigned char *str = XSTRING (registry)->data;
958 unsigned char *p = str;
959 int i;
960
961 if (!*p || *p++ == '-')
962 return 0;
963 for (i = 0; *p; p++)
964 if (*p == '-') i++;
965 return (i < 2);
966}
967
968
969/* Check validity of NAME as a fontset name and return the
970 corresponding fontset. If not valid, signal an error.
971 If NAME is t, return Vdefault_fontset. */
972
973static Lisp_Object
974check_fontset_name (name)
975 Lisp_Object name;
976{
977 int id;
978
979 if (EQ (name, Qt))
980 return Vdefault_fontset;
4ed46869 981
0d407d77
KH
982 CHECK_STRING (name, 0);
983 id = fs_query_fontset (name, 0);
984 if (id < 0)
9af3dc47 985 error ("Fontset `%s' does not exist", XSTRING (name)->data);
0d407d77
KH
986 return FONTSET_FROM_ID (id);
987}
4ed46869 988
0d407d77 989DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
4ea5775b 990 "Modify fontset NAME to use FONTNAME for CHARACTER.\n\
755f47fe 991\n\
4ea5775b 992CHARACTER may be a cons; (FROM . TO), where FROM and TO are\n\
755f47fe
DL
993non-generic characters. In that case, use FONTNAME\n\
994for all characters in the range FROM and TO (inclusive).\n\
995\n\
996If NAME is t, an entry in the default fontset is modified.\n\
997In that case, FONTNAME should be a registry and encoding name\n\
4ea5775b
KH
998of a font for CHARACTER.")
999 (name, character, fontname, frame)
1000 Lisp_Object name, character, fontname, frame;
0d407d77
KH
1001{
1002 Lisp_Object fontset, elt;
1003 Lisp_Object realized;
1004 int from, to;
1005 int id;
1006
1007 fontset = check_fontset_name (name);
1008
4ea5775b 1009 if (CONSP (character))
0d407d77
KH
1010 {
1011 /* CH should be (FROM . TO) where FROM and TO are non-generic
1012 characters. */
4ea5775b
KH
1013 CHECK_NUMBER (XCAR (character), 1);
1014 CHECK_NUMBER (XCDR (character), 1);
1015 from = XINT (XCAR (character));
1016 to = XINT (XCDR (character));
0d407d77
KH
1017 if (!char_valid_p (from, 0) || !char_valid_p (to, 0))
1018 error ("Character range should be by non-generic characters.");
1019 if (!NILP (name)
1020 && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to)))
1021 error ("Can't change font for a single byte character");
1022 }
1023 else
4ed46869 1024 {
4ea5775b
KH
1025 CHECK_NUMBER (character, 1);
1026 from = XINT (character);
0d407d77
KH
1027 to = from;
1028 }
1029 if (!char_valid_p (from, 1))
1030 invalid_character (from);
1031 if (SINGLE_BYTE_CHAR_P (from))
1032 error ("Can't change font for a single byte character");
1033 if (from < to)
1034 {
1035 if (!char_valid_p (to, 1))
1036 invalid_character (to);
1037 if (SINGLE_BYTE_CHAR_P (to))
1038 error ("Can't change font for a single byte character");
1039 }
4ed46869 1040
0d407d77
KH
1041 CHECK_STRING (fontname, 2);
1042 fontname = Fdowncase (fontname);
f3231837 1043 if (EQ (fontset, Vdefault_fontset))
0d407d77
KH
1044 {
1045 if (!check_registry_encoding (fontname))
1046 error ("Invalid registry and encoding name: %s",
1047 XSTRING (fontname)->data);
1048 elt = Fcons (make_number (from), Fcons (Qnil, fontname));
4ed46869 1049 }
0d407d77
KH
1050 else
1051 elt = Fcons (make_number (from), font_family_registry (fontname));
1052
1053 /* The arg FRAME is kept for backward compatibility. We only check
1054 the validity. */
1055 if (!NILP (frame))
1056 CHECK_LIVE_FRAME (frame, 3);
4ed46869 1057
0d407d77
KH
1058 for (; from <= to; from++)
1059 FONTSET_SET (fontset, from, elt);
1060 Foptimize_char_table (fontset);
4ed46869 1061
0d407d77
KH
1062 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1063 clear all the elements of REALIZED and free all multibyte faces
1064 whose fontset is REALIZED. This way, the specified character(s)
1065 are surely redisplayed by a correct font. */
1066 for (id = 0; id < ASIZE (Vfontset_table); id++)
1067 {
1068 realized = AREF (Vfontset_table, id);
1069 if (!NILP (realized)
1070 && !BASE_FONTSET_P (realized)
1071 && EQ (FONTSET_BASE (realized), fontset))
4ed46869 1072 {
0d407d77
KH
1073 FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));
1074 clear_fontset_elements (realized);
1075 free_realized_multibyte_face (f, id);
4ed46869 1076 }
0d407d77 1077 }
4ed46869
KH
1078
1079 return Qnil;
1080}
1081
1082DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
1083 "Return information about a font named NAME on frame FRAME.\n\
1084If FRAME is omitted or nil, use the selected frame.\n\
1085The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
6a7e6d80 1086 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
4ed46869
KH
1087where\n\
1088 OPENED-NAME is the name used for opening the font,\n\
1089 FULL-NAME is the full name of the font,\n\
0d407d77 1090 SIZE is the maximum bound width of the font,\n\
4ed46869
KH
1091 HEIGHT is the height of the font,\n\
1092 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
6a7e6d80
KH
1093 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
1094 how to compose characters.\n\
4ed46869
KH
1095If the named font is not yet loaded, return nil.")
1096 (name, frame)
1097 Lisp_Object name, frame;
1098{
1099 FRAME_PTR f;
1100 struct font_info *fontp;
1101 Lisp_Object info;
1102
1103 (*check_window_system_func) ();
1104
1105 CHECK_STRING (name, 0);
0d407d77 1106 name = Fdowncase (name);
4ed46869 1107 if (NILP (frame))
18f39d0e
GM
1108 frame = selected_frame;
1109 CHECK_LIVE_FRAME (frame, 1);
1110 f = XFRAME (frame);
4ed46869
KH
1111
1112 if (!query_font_func)
1113 error ("Font query function is not supported");
1114
1115 fontp = (*query_font_func) (f, XSTRING (name)->data);
1116 if (!fontp)
1117 return Qnil;
1118
0d407d77 1119 info = Fmake_vector (make_number (7), Qnil);
4ed46869
KH
1120
1121 XVECTOR (info)->contents[0] = build_string (fontp->name);
1122 XVECTOR (info)->contents[1] = build_string (fontp->full_name);
0d407d77
KH
1123 XVECTOR (info)->contents[2] = make_number (fontp->size);
1124 XVECTOR (info)->contents[3] = make_number (fontp->height);
1125 XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset);
1126 XVECTOR (info)->contents[5] = make_number (fontp->relative_compose);
1127 XVECTOR (info)->contents[6] = make_number (fontp->default_ascent);
4ed46869
KH
1128
1129 return info;
1130}
1131
1ff005e1
KH
1132
1133/* Return the font name for the character at POSITION in the current
1134 buffer. This is computed from all the text properties and overlays
1135 that apply to POSITION. It returns nil in the following cases:
1136
1137 (1) The window system doesn't have a font for the character (thus
1138 it is displayed by an empty box).
1139
1140 (2) The character code is invalid.
1141
1142 (3) The current buffer is not displayed in any window.
1143
1144 In addition, the returned font name may not take into account of
1145 such redisplay engine hooks as what used in jit-lock-mode if
1146 POSITION is currently not visible. */
1147
1148
1149DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 1, 0,
1150 "For internal use only.")
1151 (position)
1152 Lisp_Object position;
1153{
1154 int pos, pos_byte, dummy;
1155 int face_id;
1156 int c;
1157 Lisp_Object window;
1158 struct window *w;
1159 struct frame *f;
1160 struct face *face;
1161
1162 CHECK_NUMBER_COERCE_MARKER (position, 0);
1163 pos = XINT (position);
1164 if (pos < BEGV || pos >= ZV)
1165 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1166 pos_byte = CHAR_TO_BYTE (pos);
1167 c = FETCH_CHAR (pos_byte);
1168 if (! CHAR_VALID_P (c, 0))
1169 return Qnil;
1170 window = Fget_buffer_window (Fcurrent_buffer (), Qt);
1171 if (NILP (window))
1172 return Qnil;
1173 w = XWINDOW (window);
1174 f = XFRAME (w->frame);
1175 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
1176 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
1177 face = FACE_FROM_ID (f, face_id);
1178 return (face->font && face->font_name
1179 ? build_string (face->font_name)
1180 : Qnil);
1181}
1182
1183
1184/* Called from Ffontset_info via map_char_table on each leaf of
1185 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1186 ARG)' and FONT-INFOs have this form:
1187 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1188 The current leaf is indexed by CHARACTER and has value ELT. This
1189 function add the information of the current leaf to ARG by
1190 appending a new element or modifying the last element.. */
1191
1192static void
1193accumulate_font_info (arg, character, elt)
1194 Lisp_Object arg, character, elt;
1195{
1196 Lisp_Object last, last_char, last_elt, tmp;
1197
1198 if (!CONSP (elt))
1199 return;
1200 last = XCAR (arg);
1201 last_char = XCAR (XCAR (last));
1202 last_elt = XCAR (XCDR (XCAR (last)));
1203 elt = XCDR (elt);
1204 if (!NILP (Fequal (elt, last_elt)))
1205 {
1206 int this_charset = CHAR_CHARSET (XINT (character));
1207
1208 if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */
1209 {
1210 if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char))))
1211 {
1212 XCDR (last_char) = character;
1213 return;
1214 }
1215 }
1216 else
1217 {
1218 if (this_charset == CHAR_CHARSET (XINT (last_char)))
1219 {
1220 XCAR (XCAR (last)) = Fcons (last_char, character);
1221 return;
1222 }
1223 }
1224 }
1225 XCDR (last) = Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil);
1226 XCAR (arg) = XCDR (last);
1227}
1228
1229
4ed46869
KH
1230DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1231 "Return information about a fontset named NAME on frame FRAME.\n\
1ff005e1
KH
1232The value is a list:\n\
1233 \(FONTSET-NAME (CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...),\n\
1234where,\n\
1235 FONTSET-NAME is a full name of the fontset.\n\
63dffd51 1236 CHARSET-OR-RANGE is a charset, a character (may be a generic character)\n\
06e6aef0 1237 or a cons of two characters specifying the range of characters.\n\
1ff005e1
KH
1238 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),\n\
1239 where FAMILY is a `FAMILY' field of a XLFD font name,\n\
1240 REGISTRY is a `CHARSET_REGISTRY' field of a XLDF font name.\n\
1241 FAMILY may contain a `FOUNDARY' field at the head.\n\
1242 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.\n\
1243 OPENEDs are names of fonts actually opened.\n\
1244If FRAME is omitted, it defaults to the currently selected frame.")
4ed46869
KH
1245 (name, frame)
1246 Lisp_Object name, frame;
1247{
1ff005e1 1248 Lisp_Object fontset;
4ed46869 1249 FRAME_PTR f;
1ff005e1
KH
1250 Lisp_Object indices[3];
1251 Lisp_Object val, tail, elt;
1252 Lisp_Object *realized;
1253 int n_realized = 0;
4ed46869
KH
1254 int i;
1255
1256 (*check_window_system_func) ();
1257
0d407d77
KH
1258 fontset = check_fontset_name (name);
1259
4ed46869 1260 if (NILP (frame))
18f39d0e
GM
1261 frame = selected_frame;
1262 CHECK_LIVE_FRAME (frame, 1);
1263 f = XFRAME (frame);
4ed46869 1264
1ff005e1
KH
1265 /* Recodeq realized fontsets whose base is FONTSET in the table
1266 `realized'. */
1267 realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1268 * ASIZE (Vfontset_table));
0d407d77
KH
1269 for (i = 0; i < ASIZE (Vfontset_table); i++)
1270 {
1ff005e1
KH
1271 elt = FONTSET_FROM_ID (i);
1272 if (!NILP (elt)
1273 && EQ (FONTSET_BASE (elt), fontset))
1274 realized[n_realized++] = elt;
0d407d77 1275 }
4ed46869 1276
1ff005e1
KH
1277 /* Accumulate information of the fontset in VAL. The format is
1278 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1279 FONT-SPEC). See the comment for accumulate_font_info for the
1280 detail. */
1281 val = Fcons (Fcons (make_number (0),
1282 Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)),
0d407d77 1283 Qnil);
1ff005e1
KH
1284 val = Fcons (val, val);
1285 map_char_table (accumulate_font_info, Qnil, fontset, val, 0, indices);
1286 val = XCDR (val);
1287
1288 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
1289 character for a charset, replace it wiht the charset symbol. If
1290 fonts are opened for FONT-SPEC, append the names of the fonts to
1291 FONT-SPEC. */
1292 for (tail = val; CONSP (tail); tail = XCDR (tail))
0d407d77 1293 {
1ff005e1
KH
1294 int c;
1295 elt = XCAR (tail);
1296 if (INTEGERP (XCAR (elt)))
0d407d77 1297 {
1ff005e1
KH
1298 int charset, c1, c2;
1299 c = XINT (XCAR (elt));
1300 SPLIT_CHAR (c, charset, c1, c2);
1301 if (c1 == 0)
1302 XCAR (elt) = CHARSET_SYMBOL (charset);
1303 }
1304 else
1305 c = XINT (XCAR (XCAR (elt)));
1306 for (i = 0; i < n_realized; i++)
1307 {
1308 Lisp_Object face_id, font;
0d407d77
KH
1309 struct face *face;
1310
1ff005e1
KH
1311 face_id = FONTSET_REF_VIA_BASE (realized[i], c);
1312 if (INTEGERP (face_id))
0d407d77 1313 {
1ff005e1
KH
1314 face = FACE_FROM_ID (f, XINT (face_id));
1315 if (face->font && face->font_name)
1316 {
1317 font = build_string (face->font_name);
1318 if (NILP (Fmember (font, XCDR (XCDR (elt)))))
1319 XCDR (XCDR (elt)) = Fcons (font, XCDR (XCDR (elt)));
1320 }
0d407d77 1321 }
0d407d77
KH
1322 }
1323 }
1ff005e1 1324 return Fcons (FONTSET_NAME (fontset), val);
4ed46869
KH
1325}
1326
0d407d77 1327DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
755f47fe 1328 "Return a font name pattern for character CH in fontset NAME.\n\
0d407d77
KH
1329If NAME is t, find a font name pattern in the default fontset.")
1330 (name, ch)
1331 Lisp_Object name, ch;
1332{
1333 int c, id;
1334 Lisp_Object fontset, elt;
1335
1336 fontset = check_fontset_name (name);
1337
1338 CHECK_NUMBER (ch, 1);
1339 c = XINT (ch);
1340 if (!char_valid_p (c, 1))
1341 invalid_character (c);
1342
1343 elt = FONTSET_REF (fontset, c);
1344 if (CONSP (elt))
1345 elt = XCDR (elt);
1346
1347 return elt;
1348}
1349
1350
1351DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
1352 "Return a list of all defined fontset names.")
1353 ()
1354{
1355 Lisp_Object fontset, list;
1356 int i;
1357
1358 list = Qnil;
1359 for (i = 0; i < ASIZE (Vfontset_table); i++)
1360 {
1361 fontset = FONTSET_FROM_ID (i);
1362 if (!NILP (fontset)
1363 && BASE_FONTSET_P (fontset))
1364 list = Fcons (FONTSET_NAME (fontset), list);
1365 }
1ff005e1 1366
0d407d77
KH
1367 return list;
1368}
1369
dfcf069d 1370void
4ed46869
KH
1371syms_of_fontset ()
1372{
1373 int i;
1374
4ed46869
KH
1375 if (!load_font_func)
1376 /* Window system initializer should have set proper functions. */
1377 abort ();
1378
6a7e6d80 1379 Qfontset = intern ("fontset");
4ed46869 1380 staticpro (&Qfontset);
0d407d77 1381 Fput (Qfontset, Qchar_table_extra_slots, make_number (3));
4ed46869
KH
1382
1383 Vcached_fontset_data = Qnil;
1384 staticpro (&Vcached_fontset_data);
1385
0d407d77
KH
1386 Vfontset_table = Fmake_vector (make_number (32), Qnil);
1387 staticpro (&Vfontset_table);
0d407d77
KH
1388
1389 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
1390 staticpro (&Vdefault_fontset);
1ff005e1
KH
1391 FONTSET_ID (Vdefault_fontset) = make_number (0);
1392 FONTSET_NAME (Vdefault_fontset)
1393 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
0d407d77 1394 FONTSET_ASCII (Vdefault_fontset)
afc125e1
KH
1395 = Fcons (make_number (0),
1396 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1ff005e1
KH
1397 AREF (Vfontset_table, 0) = Vdefault_fontset;
1398 next_fontset_id = 1;
4ed46869
KH
1399
1400 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
1401 "Alist of fontname patterns vs corresponding encoding info.\n\
1402Each element looks like (REGEXP . ENCODING-INFO),\n\
1403 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
1404ENCODING is one of the following integer values:\n\
1405 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
1406 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
1407 2: code points 0x20A0..0x7FFF are used,\n\
1408 3: code points 0xA020..0xFF7F are used.");
1409 Vfont_encoding_alist = Qnil;
1410
6a7e6d80 1411 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
fc891591 1412 "Char table of characters whose ascent values should be ignored.\n\
6a7e6d80 1413If an entry for a character is non-nil, the ascent value of the glyph\n\
2aeafb78
KH
1414is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
1415\n\
1416This affects how a composite character which contains\n\
1417such a character is displayed on screen.");
1418 Vuse_default_ascent = Qnil;
1419
1420 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
1421 "Char table of characters which is not composed relatively.\n\
810abb87 1422If an entry for a character is non-nil, a composition sequence\n\
2aeafb78
KH
1423which contains that character is displayed so that\n\
1424the glyph of that character is put without considering\n\
1425an ascent and descent value of a previous character.");
810abb87 1426 Vignore_relative_composition = Qnil;
6a7e6d80 1427
01d4b817
KH
1428 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
1429 "Alist of fontname vs list of the alternate fontnames.\n\
fc891591 1430When a specified font name is not found, the corresponding\n\
01d4b817
KH
1431alternate fontnames (if any) are tried instead.");
1432 Valternate_fontname_alist = Qnil;
8c83e4f9 1433
1c283e35
KH
1434 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
1435 "Alist of fontset names vs the aliases.");
1ff005e1
KH
1436 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
1437 build_string ("fontset-default")),
1438 Qnil);
1c283e35 1439
ec3bb068
KH
1440 DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font,
1441 "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
1442The way to highlight them depends on window system on which Emacs runs.\n\
fc891591 1443On X11, a rectangle is shown around each such character.");
e3ee2a8a 1444 Vhighlight_wrong_size_font = Qnil;
ec3bb068
KH
1445
1446 DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font,
fc891591 1447 "*Non-nil means characters shown in overlarge fonts are clipped.\n\
1c283e35 1448The height of clipping area is the same as that of an ASCII character.\n\
fc891591
RS
1449The width of the area is the same as that of an ASCII character,\n\
1450or twice as wide, depending on the character set's column-width.\n\
1c283e35 1451\n\
fc891591
RS
1452If the only font you have for a specific character set is too large,\n\
1453and clipping these characters makes them hard to read,\n\
1454you can set this variable to nil to display the characters without clipping.\n\
1455The drawback is that you will get some garbage left on your screen.");
ec3bb068
KH
1456 Vclip_large_size_font = Qt;
1457
810abb87
KH
1458 DEFVAR_LISP ("vertical-centering-font-regexp",
1459 &Vvertical_centering_font_regexp,
1460 "*Regexp matching font names that require vertical centering on display.\n\
1461When a character is displayed with such fonts, the character is displayed\n\
1462at the vertival center of lines.");
1463 Vvertical_centering_font_regexp = Qnil;
1464
4ed46869
KH
1465 defsubr (&Squery_fontset);
1466 defsubr (&Snew_fontset);
1467 defsubr (&Sset_fontset_font);
1468 defsubr (&Sfont_info);
1ff005e1 1469 defsubr (&Sinternal_char_font);
4ed46869 1470 defsubr (&Sfontset_info);
0d407d77
KH
1471 defsubr (&Sfontset_font);
1472 defsubr (&Sfontset_list);
4ed46869 1473}