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