HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Fix typos.
[bpt/emacs.git] / src / font.c
CommitLineData
c2f5bfd6 1/* font.c -- "Font" primitives.
7ecf3dcb
GM		 2 Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008
c2f5bfd6
KH		 4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
6
7This file is part of GNU Emacs.
8
9ec0b715 9GNU Emacs is free software: you can redistribute it and/or modify
c2f5bfd6 10it under the terms of the GNU General Public License as published by
9ec0b715
GM		 11the Free Software Foundation, either version 3 of the License, or
12(at your option) any later version.
c2f5bfd6
KH		 13
14GNU Emacs is distributed in the hope that it will be useful,
15but WITHOUT ANY WARRANTY; without even the implied warranty of
16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17GNU General Public License for more details.
18
19You should have received a copy of the GNU General Public License
9ec0b715 20along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
c2f5bfd6
KH		 21
22#include <config.h>
23#include <stdio.h>
24#include <stdlib.h>
25#include <ctype.h>
1701724c
KH		 26#ifdef HAVE_M17N_FLT
27#include <m17n-flt.h>
28#endif
c2f5bfd6
KH		 29
30#include "lisp.h"
31#include "buffer.h"
32#include "frame.h"
10d16101 33#include "window.h"
c2f5bfd6
KH		 34#include "dispextern.h"
35#include "charset.h"
36#include "character.h"
37#include "composite.h"
38#include "fontset.h"
39#include "font.h"
40
43c0454d
KH		 41#ifdef HAVE_X_WINDOWS
42#include "xterm.h"
43#endif /* HAVE_X_WINDOWS */
44
45#ifdef HAVE_NTGUI
46#include "w32term.h"
47#endif /* HAVE_NTGUI */
48
edfda783
AR		 49#ifdef HAVE_NS
50#include "nsterm.h"
51#endif /* HAVE_NS */
52
35027d0c 53Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
ed96cde8
AR		 54
55#ifdef HAVE_NS
56extern Lisp_Object Qfontsize;
57#endif
c2f5bfd6 58
e0708580
KH		 59Lisp_Object Qopentype;
60
35027d0c 61/* Important character set strings. */
9e1bb909 62Lisp_Object Qascii_0, Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip;
1bb1d99b 63
edfda783
AR		 64#ifdef HAVE_NS
65#define DEFAULT_ENCODING Qiso10646_1
66#else
67#define DEFAULT_ENCODING Qiso8859_1
68#endif
69
071132a9
KH		 70/* Unicode category `Cf'. */
71static Lisp_Object QCf;
72
c2f5bfd6
KH		 73/* Special vector of zero length. This is repeatedly used by (struct
74 font_driver *)->list when a specified font is not found. */
35027d0c 75static Lisp_Object null_vector;
c2f5bfd6 76
d0ab1ebe
KH		 77static Lisp_Object Vfont_weight_table, Vfont_slant_table, Vfont_width_table;
78
79/* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
c2f5bfd6
KH		 80static Lisp_Object font_style_table;
81
d0ab1ebe
KH		 82/* Structure used for tables mapping weight, slant, and width numeric
83 values and their names. */
84
85struct table_entry
86{
87 int numeric;
88 /* The first one is a valid name as a face attribute.
89 The second one (if any) is a typical name in XLFD field. */
90 char *names[5];
91 Lisp_Object *symbols;
92};
93
94/* Table of weight numeric values and their names. This table must be
95 sorted by numeric values in ascending order. */
96
97static struct table_entry weight_table[] =
98{
99 { 0, { "thin" }},
100 { 20, { "ultra-light", "ultralight" }},
101 { 40, { "extra-light", "extralight" }},
102 { 50, { "light" }},
103 { 75, { "semi-light", "semilight", "demilight", "book" }},
104 { 100, { "normal", "medium", "regular" }},
105 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
106 { 200, { "bold" }},
107 { 205, { "extra-bold", "extrabold" }},
108 { 210, { "ultra-bold", "ultrabold", "black" }}
109};
110
111/* Table of slant numeric values and their names. This table must be
112 sorted by numeric values in ascending order. */
113
114static struct table_entry slant_table[] =
115{
116 { 0, { "reverse-oblique", "ro" }},
117 { 10, { "reverse-italic", "ri" }},
118 { 100, { "normal", "r" }},
119 { 200, { "italic" ,"i", "ot" }},
120 { 210, { "oblique", "o" }}
121};
122
123/* Table of width numeric values and their names. This table must be
124 sorted by numeric values in ascending order. */
125
126static struct table_entry width_table[] =
127{
128 { 50, { "ultra-condensed", "ultracondensed" }},
129 { 63, { "extra-condensed", "extracondensed" }},
130 { 75, { "condensed", "compressed", "narrow" }},
131 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
132 { 100, { "normal", "medium", "regular" }},
133 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
134 { 125, { "expanded" }},
135 { 150, { "extra-expanded", "extraexpanded" }},
136 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
137};
138
35027d0c 139extern Lisp_Object Qnormal;
c2f5bfd6
KH		 140
141/* Symbols representing keys of normal font properties. */
b1868a1a
CY		 142extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth;
143extern Lisp_Object QCheight, QCsize, QCname;
144
35027d0c 145Lisp_Object QCfoundry, QCadstyle, QCregistry;
c2f5bfd6 146/* Symbols representing keys of font extra info. */
35027d0c
KH		 147Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClang, QCscript, QCavgwidth;
148Lisp_Object QCantialias, QCfont_entity, QCfc_unknown_spec;
ec6fe57c
KH		 149/* Symbols representing values of font spacing property. */
150Lisp_Object Qc, Qm, Qp, Qd;
c2f5bfd6 151
819e81df
KH		 152Lisp_Object Vfont_encoding_alist;
153
1701724c
KH		 154/* Alist of font registry symbol and the corresponding charsets
155 information. The information is retrieved from
156 Vfont_encoding_alist on demand.
157
158 Eash element has the form:
159 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
160 or
161 (REGISTRY . nil)
162
163 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
164 encodes a character code to a glyph code of a font, and
165 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
166 character is supported by a font.
167
168 The latter form means that the information for REGISTRY couldn't be
169 retrieved. */
170static Lisp_Object font_charset_alist;
171
f697fff0
KH		 172/* List of all font drivers. Each font-backend (XXXfont.c) calls
173 register_font_driver in syms_of_XXXfont to register its font-driver
c2f5bfd6
KH		 174 here. */
175static struct font_driver_list *font_driver_list;
176
35027d0c
KH		 177\f
178
179/* Creaters of font-related Lisp object. */
180
181Lisp_Object
182font_make_spec ()
183{
184 Lisp_Object font_spec;
185 struct font_spec *spec
186 = ((struct font_spec *)
187 allocate_pseudovector (VECSIZE (struct font_spec),
188 FONT_SPEC_MAX, PVEC_FONT));
189 XSETFONT (font_spec, spec);
190 return font_spec;
191}
192
193Lisp_Object
194font_make_entity ()
195{
196 Lisp_Object font_entity;
197 struct font_entity *entity
198 = ((struct font_entity *)
199 allocate_pseudovector (VECSIZE (struct font_entity),
200 FONT_ENTITY_MAX, PVEC_FONT));
201 XSETFONT (font_entity, entity);
202 return font_entity;
203}
204
51c13510
KH		 205/* Create a font-object whose structure size is SIZE. If ENTITY is
206 not nil, copy properties from ENTITY to the font-object. If
207 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
35027d0c 208Lisp_Object
51c13510 209font_make_object (size, entity, pixelsize)
35027d0c 210 int size;
51c13510
KH		 211 Lisp_Object entity;
212 int pixelsize;
35027d0c
KH		 213{
214 Lisp_Object font_object;
215 struct font *font
216 = (struct font *) allocate_pseudovector (size, FONT_OBJECT_MAX, PVEC_FONT);
51c13510
KH		 217 int i;
218
35027d0c
KH		 219 XSETFONT (font_object, font);
220
51c13510
KH		 221 if (! NILP (entity))
222 {
223 for (i = 1; i < FONT_SPEC_MAX; i++)
224 font->props[i] = AREF (entity, i);
225 if (! NILP (AREF (entity, FONT_EXTRA_INDEX)))
226 font->props[FONT_EXTRA_INDEX]
227 = Fcopy_sequence (AREF (entity, FONT_EXTRA_INDEX));
228 }
229 if (size > 0)
230 font->props[FONT_SIZE_INDEX] = make_number (pixelsize);
35027d0c
KH		 231 return font_object;
232}
233
234\f
235
ec6fe57c 236static int font_pixel_size P_ ((FRAME_PTR f, Lisp_Object));
c2f5bfd6 237static Lisp_Object font_open_entity P_ ((FRAME_PTR, Lisp_Object, int));
35027d0c
KH		 238static Lisp_Object font_matching_entity P_ ((FRAME_PTR, Lisp_Object *,
239 Lisp_Object));
c2f5bfd6
KH		 240
241/* Number of registered font drivers. */
242static int num_font_drivers;
243
35027d0c
KH		 244
245/* Return a Lispy value of a font property value at STR and LEN bytes.
246 If STR is "*", it returns nil.
2f286d4f
KH		 247 If FORCE_SYMBOL is zero and all characters in STR are digits, it
248 returns an integer. Otherwise, it returns a symbol interned from
249 STR. */
35027d0c
KH		 250
251Lisp_Object
2f286d4f 252font_intern_prop (str, len, force_symbol)
35027d0c
KH		 253 char *str;
254 int len;
2f286d4f 255 int force_symbol;
35027d0c
KH		 256{
257 int i;
d0ab1ebe 258 Lisp_Object tem;
35027d0c
KH		 259 Lisp_Object obarray;
260
261 if (len == 1 && *str == '*')
262 return Qnil;
2f286d4f 263 if (!force_symbol && len >=1 && isdigit (*str))
35027d0c
KH		 264 {
265 for (i = 1; i < len; i++)
266 if (! isdigit (str[i]))
267 break;
268 if (i == len)
269 return make_number (atoi (str));
270 }
271
272 /* The following code is copied from the function intern (in lread.c). */
273 obarray = Vobarray;
274 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
275 obarray = check_obarray (obarray);
276 tem = oblookup (obarray, str, len, len);
277 if (SYMBOLP (tem))
278 return tem;
279 return Fintern (make_unibyte_string (str, len), obarray);
280}
281
9331887d 282/* Return a pixel size of font-spec SPEC on frame F. */
ec6fe57c 283
9331887d
KH		 284static int
285font_pixel_size (f, spec)
286 FRAME_PTR f;
287 Lisp_Object spec;
288{
819e81df 289#ifdef HAVE_WINDOW_SYSTEM
9331887d
KH		 290 Lisp_Object size = AREF (spec, FONT_SIZE_INDEX);
291 double point_size;
35027d0c 292 int dpi, pixel_size;
d0ab1ebe 293 Lisp_Object val;
51c01100 294
9331887d
KH		 295 if (INTEGERP (size))
296 return XINT (size);
297 if (NILP (size))
819e81df 298 return 0;
d0ab1ebe 299 font_assert (FLOATP (size));
9331887d 300 point_size = XFLOAT_DATA (size);
35027d0c
KH		 301 val = AREF (spec, FONT_DPI_INDEX);
302 if (INTEGERP (val))
17e28f6d 303 dpi = XINT (val);
9331887d
KH		 304 else
305 dpi = f->resy;
306 pixel_size = POINT_TO_PIXEL (point_size, dpi);
307 return pixel_size;
819e81df
KH		 308#else
309 return 1;
310#endif
9331887d
KH		 311}
312
c2f5bfd6 313
35027d0c
KH		 314/* Return a value of PROP's VAL (symbol or integer) to be stored in a
315 font vector. If VAL is not valid (i.e. not registered in
316 font_style_table), return -1 if NOERROR is zero, and return a
317 proper index if NOERROR is nonzero. In that case, register VAL in
318 font_style_table if VAL is a symbol, and return a closest index if
319 VAL is an integer. */
c2f5bfd6 320
35027d0c
KH		 321int
322font_style_to_value (prop, val, noerror)
c2f5bfd6 323 enum font_property_index prop;
35027d0c
KH		 324 Lisp_Object val;
325 int noerror;
c2f5bfd6 326{
35027d0c
KH		 327 Lisp_Object table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
328 int len = ASIZE (table);
d0ab1ebe 329 int i, j;
c2f5bfd6 330
35027d0c 331 if (SYMBOLP (val))
c2f5bfd6 332 {
72606e45 333 unsigned char *s;
35027d0c
KH		 334 Lisp_Object args[2], elt;
335
336 /* At first try exact match. */
337 for (i = 0; i < len; i++)
d0ab1ebe
KH		 338 for (j = 1; j < ASIZE (AREF (table, i)); j++)
339 if (EQ (val, AREF (AREF (table, i), j)))
340 return ((XINT (AREF (AREF (table, i), 0)) << 8)
341 | (i << 4) | (j - 1));
35027d0c 342 /* Try also with case-folding match. */
72606e45 343 s = SDATA (SYMBOL_NAME (val));
35027d0c 344 for (i = 0; i < len; i++)
d0ab1ebe
KH		 345 for (j = 1; j < ASIZE (AREF (table, i)); j++)
346 {
347 elt = AREF (AREF (table, i), j);
72606e45 348 if (xstrcasecmp (s, SDATA (SYMBOL_NAME (elt))) == 0)
d0ab1ebe
KH		 349 return ((XINT (AREF (AREF (table, i), 0)) << 8)
350 | (i << 4) | (j - 1));
351 }
35027d0c
KH		 352 if (! noerror)
353 return -1;
354 if (len == 255)
355 abort ();
d0ab1ebe
KH		 356 elt = Fmake_vector (make_number (2), make_number (255));
357 ASET (elt, 1, val);
35027d0c 358 args[0] = table;
d0ab1ebe 359 args[1] = Fmake_vector (make_number (1), elt);
35027d0c 360 ASET (font_style_table, prop - FONT_WEIGHT_INDEX, Fvconcat (2, args));
d0ab1ebe 361 return (255 << 8) | (i << 4);
c2f5bfd6 362 }
35027d0c
KH		 363 else
364 {
d0ab1ebe 365 int i, last_n;
35027d0c 366 int numeric = XINT (val);
c2f5bfd6 367
d0ab1ebe 368 for (i = 0, last_n = -1; i < len; i++)
35027d0c 369 {
d0ab1ebe 370 int n = XINT (AREF (AREF (table, i), 0));
c2f5bfd6 371
35027d0c 372 if (numeric == n)
d0ab1ebe 373 return (n << 8) | (i << 4);
35027d0c
KH		 374 if (numeric < n)
375 {
376 if (! noerror)
377 return -1;
d0ab1ebe
KH		 378 return ((i == 0 || n - numeric < numeric - last_n)
379 ? (n << 8) | (i << 4): (last_n << 8 | ((i - 1) << 4)));
35027d0c 380 }
35027d0c 381 last_n = n;
35027d0c
KH		 382 }
383 if (! noerror)
384 return -1;
d0ab1ebe 385 return ((last_n << 8) | ((i - 1) << 4));
35027d0c
KH		 386 }
387}
c2f5bfd6
KH		 388
389Lisp_Object
3ef8c1b4
JR		 390font_style_symbolic (font, prop, for_face)
391 Lisp_Object font;
35027d0c
KH		 392 enum font_property_index prop;
393 int for_face;
c2f5bfd6 394{
3ef8c1b4 395 Lisp_Object val = AREF (font, prop);
d0ab1ebe
KH		 396 Lisp_Object table, elt;
397 int i;
c2f5bfd6 398
35027d0c
KH		 399 if (NILP (val))
400 return Qnil;
401 table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
d0ab1ebe
KH		 402 i = XINT (val) & 0xFF;
403 font_assert (((i >> 4) & 0xF) < ASIZE (table));
404 elt = AREF (table, ((i >> 4) & 0xF));
405 font_assert ((i & 0xF) + 1 < ASIZE (elt));
6fe9826d
JR		 406 return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
407}
408
c2f5bfd6
KH		 409extern Lisp_Object Vface_alternative_font_family_alist;
410
1701724c
KH		 411extern Lisp_Object find_font_encoding P_ ((Lisp_Object));
412
35027d0c 413
819e81df
KH		 414/* Return ENCODING or a cons of ENCODING and REPERTORY of the font
415 FONTNAME. ENCODING is a charset symbol that specifies the encoding
416 of the font. REPERTORY is a charset symbol or nil. */
417
418Lisp_Object
419find_font_encoding (fontname)
420 Lisp_Object fontname;
421{
422 Lisp_Object tail, elt;
423
424 for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail))
425 {
426 elt = XCAR (tail);
427 if (CONSP (elt)
428 && STRINGP (XCAR (elt))
429 && fast_string_match_ignore_case (XCAR (elt), fontname) >= 0
430 && (SYMBOLP (XCDR (elt))
431 ? CHARSETP (XCDR (elt))
432 : CONSP (XCDR (elt)) && CHARSETP (XCAR (XCDR (elt)))))
433 return (XCDR (elt));
434 }
435 /* We don't know the encoding of this font. Let's assume `ascii'. */
436 return Qascii;
437}
438
1701724c
KH		 439/* Return encoding charset and repertory charset for REGISTRY in
440 ENCODING and REPERTORY correspondingly. If correct information for
441 REGISTRY is available, return 0. Otherwise return -1. */
442
443int
444font_registry_charsets (registry, encoding, repertory)
445 Lisp_Object registry;
446 struct charset **encoding, **repertory;
447{
448 Lisp_Object val;
449 int encoding_id, repertory_id;
450
35027d0c 451 val = Fassoc_string (registry, font_charset_alist, Qt);
1701724c
KH		 452 if (! NILP (val))
453 {
454 val = XCDR (val);
455 if (NILP (val))
456 return -1;
457 encoding_id = XINT (XCAR (val));
458 repertory_id = XINT (XCDR (val));
459 }
460 else
461 {
462 val = find_font_encoding (SYMBOL_NAME (registry));
463 if (SYMBOLP (val) && CHARSETP (val))
464 {
465 encoding_id = repertory_id = XINT (CHARSET_SYMBOL_ID (val));
466 }
467 else if (CONSP (val))
468 {
469 if (! CHARSETP (XCAR (val)))
470 goto invalid_entry;
471 encoding_id = XINT (CHARSET_SYMBOL_ID (XCAR (val)));
472 if (NILP (XCDR (val)))
473 repertory_id = -1;
474 else
475 {
476 if (! CHARSETP (XCDR (val)))
477 goto invalid_entry;
478 repertory_id = XINT (CHARSET_SYMBOL_ID (XCDR (val)));
479 }
51c01100 480 }
1701724c
KH		 481 else
482 goto invalid_entry;
483 val = Fcons (make_number (encoding_id), make_number (repertory_id));
484 font_charset_alist
485 = nconc2 (font_charset_alist, Fcons (Fcons (registry, val), Qnil));
486 }
487
488 if (encoding)
489 *encoding = CHARSET_FROM_ID (encoding_id);
490 if (repertory)
491 *repertory = repertory_id >= 0 ? CHARSET_FROM_ID (repertory_id) : NULL;
492 return 0;
493
494 invalid_entry:
495 font_charset_alist
496 = nconc2 (font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil));
497 return -1;
498}
499
c2f5bfd6 500\f
45eb10fb
KH		 501/* Font property value validaters. See the comment of
502 font_property_table for the meaning of the arguments. */
503
35027d0c 504static Lisp_Object font_prop_validate P_ ((int, Lisp_Object, Lisp_Object));
45eb10fb
KH		 505static Lisp_Object font_prop_validate_symbol P_ ((Lisp_Object, Lisp_Object));
506static Lisp_Object font_prop_validate_style P_ ((Lisp_Object, Lisp_Object));
507static Lisp_Object font_prop_validate_non_neg P_ ((Lisp_Object, Lisp_Object));
508static Lisp_Object font_prop_validate_spacing P_ ((Lisp_Object, Lisp_Object));
35027d0c 509static int get_font_prop_index P_ ((Lisp_Object));
c2f5bfd6
KH		 510
511static Lisp_Object
45eb10fb 512font_prop_validate_symbol (prop, val)
ec6fe57c 513 Lisp_Object prop, val;
c2f5bfd6
KH		 514{
515 if (STRINGP (val))
35027d0c
KH		 516 val = Fintern (val, Qnil);
517 if (! SYMBOLP (val))
c2f5bfd6 518 val = Qerror;
35027d0c
KH		 519 else if (EQ (prop, QCregistry))
520 val = Fintern (Fdowncase (SYMBOL_NAME (val)), Qnil);
c2f5bfd6
KH		 521 return val;
522}
523
35027d0c 524
c2f5bfd6 525static Lisp_Object
35027d0c
KH		 526font_prop_validate_style (style, val)
527 Lisp_Object style, val;
c2f5bfd6 528{
35027d0c
KH		 529 enum font_property_index prop = (EQ (style, QCweight) ? FONT_WEIGHT_INDEX
530 : EQ (style, QCslant) ? FONT_SLANT_INDEX
531 : FONT_WIDTH_INDEX);
532 int n;
533 if (INTEGERP (val))
c2f5bfd6 534 {
35027d0c 535 n = XINT (val);
64b900e3 536 if (((n >> 4) & 0xF)
35027d0c 537 >= ASIZE (AREF (font_style_table, prop - FONT_WEIGHT_INDEX)))
c2f5bfd6
KH		 538 val = Qerror;
539 else
540 {
64b900e3
KH		 541 Lisp_Object elt = AREF (AREF (font_style_table, prop - FONT_WEIGHT_INDEX), (n >> 4) & 0xF);
542
543 if ((n & 0xF) + 1 >= ASIZE (elt))
544 val = Qerror;
545 else if (XINT (AREF (elt, 0)) != (n >> 8))
c2f5bfd6
KH		 546 val = Qerror;
547 }
548 }
35027d0c
KH		 549 else if (SYMBOLP (val))
550 {
551 int n = font_style_to_value (prop, val, 0);
552
553 val = n >= 0 ? make_number (n) : Qerror;
554 }
555 else
556 val = Qerror;
c2f5bfd6
KH		 557 return val;
558}
559
560static Lisp_Object
45eb10fb 561font_prop_validate_non_neg (prop, val)
ec6fe57c 562 Lisp_Object prop, val;
c2f5bfd6
KH		 563{
564 return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0)
565 ? val : Qerror);
566}
567
568static Lisp_Object
45eb10fb 569font_prop_validate_spacing (prop, val)
ec6fe57c
KH		 570 Lisp_Object prop, val;
571{
572 if (NILP (val) || (NATNUMP (val) && XINT (val) <= FONT_SPACING_CHARCELL))
573 return val;
3692570f
KH		 574 if (SYMBOLP (val) && SBYTES (SYMBOL_NAME (val)) == 1)
575 {
576 char spacing = SDATA (SYMBOL_NAME (val))[0];
577
578 if (spacing == 'c' || spacing == 'C')
579 return make_number (FONT_SPACING_CHARCELL);
580 if (spacing == 'm' || spacing == 'M')
581 return make_number (FONT_SPACING_MONO);
0615d903 582 if (spacing == 'p' || spacing == 'P')
3692570f
KH		 583 return make_number (FONT_SPACING_PROPORTIONAL);
584 if (spacing == 'd' || spacing == 'D')
585 return make_number (FONT_SPACING_DUAL);
586 }
ec6fe57c
KH		 587 return Qerror;
588}
589
1701724c
KH		 590static Lisp_Object
591font_prop_validate_otf (prop, val)
592 Lisp_Object prop, val;
593{
594 Lisp_Object tail, tmp;
595 int i;
596
597 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
598 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
599 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
600 if (! CONSP (val))
601 return Qerror;
602 if (! SYMBOLP (XCAR (val)))
603 return Qerror;
604 tail = XCDR (val);
605 if (NILP (tail))
606 return val;
607 if (! CONSP (tail) || ! SYMBOLP (XCAR (val)))
608 return Qerror;
609 for (i = 0; i < 2; i++)
610 {
611 tail = XCDR (tail);
612 if (NILP (tail))
613 return val;
614 if (! CONSP (tail))
615 return Qerror;
616 for (tmp = XCAR (tail); CONSP (tmp); tmp = XCDR (tmp))
617 if (! SYMBOLP (XCAR (tmp)))
618 return Qerror;
619 if (! NILP (tmp))
620 return Qerror;
621 }
622 return val;
623}
624
ec6fe57c
KH		 625/* Structure of known font property keys and validater of the
626 values. */
c2f5bfd6
KH		 627struct
628{
ec6fe57c 629 /* Pointer to the key symbol. */
c2f5bfd6 630 Lisp_Object *key;
45eb10fb
KH		 631 /* Function to validate PROP's value VAL, or NULL if any value is
632 ok. The value is VAL or its regularized value if VAL is valid,
633 and Qerror if not. */
634 Lisp_Object (*validater) P_ ((Lisp_Object prop, Lisp_Object val));
ec6fe57c
KH		 635} font_property_table[] =
636 { { &QCtype, font_prop_validate_symbol },
c2f5bfd6
KH		 637 { &QCfoundry, font_prop_validate_symbol },
638 { &QCfamily, font_prop_validate_symbol },
639 { &QCadstyle, font_prop_validate_symbol },
640 { &QCregistry, font_prop_validate_symbol },
641 { &QCweight, font_prop_validate_style },
642 { &QCslant, font_prop_validate_style },
643 { &QCwidth, font_prop_validate_style },
ec6fe57c 644 { &QCsize, font_prop_validate_non_neg },
ec6fe57c
KH		 645 { &QCdpi, font_prop_validate_non_neg },
646 { &QCspacing, font_prop_validate_spacing },
35027d0c
KH		 647 { &QCavgwidth, font_prop_validate_non_neg },
648 /* The order of the above entries must match with enum
649 font_property_index. */
650 { &QClang, font_prop_validate_symbol },
651 { &QCscript, font_prop_validate_symbol },
652 { &QCotf, font_prop_validate_otf }
c2f5bfd6
KH		 653 };
654
45eb10fb 655/* Size (number of elements) of the above table. */
ec6fe57c
KH		 656#define FONT_PROPERTY_TABLE_SIZE \
657 ((sizeof font_property_table) / (sizeof *font_property_table))
658
45eb10fb 659/* Return an index number of font property KEY or -1 if KEY is not an
35027d0c 660 already known property. */
45eb10fb 661
ec6fe57c 662static int
35027d0c 663get_font_prop_index (key)
c2f5bfd6
KH		 664 Lisp_Object key;
665{
35027d0c
KH		 666 int i;
667
668 for (i = 0; i < FONT_PROPERTY_TABLE_SIZE; i++)
669 if (EQ (key, *font_property_table[i].key))
670 return i;
ec6fe57c 671 return -1;
c2f5bfd6
KH		 672}
673
35027d0c
KH		 674/* Validate the font property. The property key is specified by the
675 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
676 signal an error. The value is VAL or the regularized one. */
45eb10fb 677
c2f5bfd6 678static Lisp_Object
35027d0c
KH		 679font_prop_validate (idx, prop, val)
680 int idx;
681 Lisp_Object prop, val;
c2f5bfd6 682{
35027d0c 683 Lisp_Object validated;
c2f5bfd6 684
1f09f444
KH		 685 if (NILP (val))
686 return val;
35027d0c
KH		 687 if (NILP (prop))
688 prop = *font_property_table[idx].key;
689 else
ec6fe57c 690 {
35027d0c
KH		 691 idx = get_font_prop_index (prop);
692 if (idx < 0)
693 return val;
ec6fe57c 694 }
35027d0c
KH		 695 validated = (font_property_table[idx].validater) (prop, val);
696 if (EQ (validated, Qerror))
697 signal_error ("invalid font property", Fcons (prop, val));
698 return validated;
c2f5bfd6 699}
51c01100 700
35027d0c
KH		 701
702/* Store VAL as a value of extra font property PROP in FONT while
703 keeping the sorting order. Don't check the validity of VAL. */
45eb10fb 704
01dbeb0b 705Lisp_Object
ec6fe57c 706font_put_extra (font, prop, val)
9331887d 707 Lisp_Object font, prop, val;
9331887d
KH		 708{
709 Lisp_Object extra = AREF (font, FONT_EXTRA_INDEX);
ec6fe57c 710 Lisp_Object slot = (NILP (extra) ? Qnil : assq_no_quit (prop, extra));
9331887d
KH		 711
712 if (NILP (slot))
713 {
35027d0c
KH		 714 Lisp_Object prev = Qnil;
715
716 while (CONSP (extra)
717 && NILP (Fstring_lessp (prop, XCAR (XCAR (extra)))))
718 prev = extra, extra = XCDR (extra);
719 if (NILP (prev))
720 ASET (font, FONT_EXTRA_INDEX, Fcons (Fcons (prop, val), extra));
721 else
722 XSETCDR (prev, Fcons (Fcons (prop, val), extra));
ec6fe57c 723 return val;
9331887d 724 }
9331887d 725 XSETCDR (slot, val);
ec6fe57c 726 return val;
9331887d
KH		 727}
728
c2f5bfd6
KH		 729\f
730/* Font name parser and unparser */
731
ec6fe57c
KH		 732static int parse_matrix P_ ((char *));
733static int font_expand_wildcards P_ ((Lisp_Object *, int));
734static int font_parse_name P_ ((char *, Lisp_Object));
c2f5bfd6 735
ec6fe57c 736/* An enumerator for each field of an XLFD font name. */
c2f5bfd6
KH		 737enum xlfd_field_index
738{
739 XLFD_FOUNDRY_INDEX,
740 XLFD_FAMILY_INDEX,
741 XLFD_WEIGHT_INDEX,
742 XLFD_SLANT_INDEX,
743 XLFD_SWIDTH_INDEX,
744 XLFD_ADSTYLE_INDEX,
4485a28e
KH		 745 XLFD_PIXEL_INDEX,
746 XLFD_POINT_INDEX,
c2f5bfd6
KH		 747 XLFD_RESX_INDEX,
748 XLFD_RESY_INDEX,
749 XLFD_SPACING_INDEX,
750 XLFD_AVGWIDTH_INDEX,
751 XLFD_REGISTRY_INDEX,
752 XLFD_ENCODING_INDEX,
753 XLFD_LAST_INDEX
754};
755
ec6fe57c 756/* An enumerator for mask bit corresponding to each XLFD field. */
4485a28e
KH		 757enum xlfd_field_mask
758{
759 XLFD_FOUNDRY_MASK = 0x0001,
760 XLFD_FAMILY_MASK = 0x0002,
761 XLFD_WEIGHT_MASK = 0x0004,
762 XLFD_SLANT_MASK = 0x0008,
763 XLFD_SWIDTH_MASK = 0x0010,
764 XLFD_ADSTYLE_MASK = 0x0020,
765 XLFD_PIXEL_MASK = 0x0040,
766 XLFD_POINT_MASK = 0x0080,
767 XLFD_RESX_MASK = 0x0100,
768 XLFD_RESY_MASK = 0x0200,
769 XLFD_SPACING_MASK = 0x0400,
770 XLFD_AVGWIDTH_MASK = 0x0800,
771 XLFD_REGISTRY_MASK = 0x1000,
772 XLFD_ENCODING_MASK = 0x2000
773};
774
775
c2f5bfd6
KH		 776/* Parse P pointing the pixel/point size field of the form
777 `[A B C D]' which specifies a transformation matrix:
778
779 A B 0
780 C D 0
781 0 0 1
782
783 by which all glyphs of the font are transformed. The spec says
784 that scalar value N for the pixel/point size is equivalent to:
785 A = N * resx/resy, B = C = 0, D = N.
786
787 Return the scalar value N if the form is valid. Otherwise return
788 -1. */
789
790static int
791parse_matrix (p)
792 char *p;
793{
794 double matrix[4];
795 char *end;
796 int i;
797
798 for (i = 0, p++; i < 4 && *p && *p != ']'; i++)
799 {
800 if (*p == '~')
801 matrix[i] = - strtod (p + 1, &end);
802 else
803 matrix[i] = strtod (p, &end);
804 p = end;
805 }
806 return (i == 4 ? (int) matrix[3] : -1);
807}
808
4485a28e
KH		 809/* Expand a wildcard field in FIELD (the first N fields are filled) to
810 multiple fields to fill in all 14 XLFD fields while restring a
811 field position by its contents. */
812
ec6fe57c 813static int
4485a28e
KH		 814font_expand_wildcards (field, n)
815 Lisp_Object field[XLFD_LAST_INDEX];
816 int n;
817{
818 /* Copy of FIELD. */
819 Lisp_Object tmp[XLFD_LAST_INDEX];
820 /* Array of information about where this element can go. Nth
821 element is for Nth element of FIELD. */
822 struct {
823 /* Minimum possible field. */
824 int from;
825 /* Maxinum possible field. */
826 int to;
827 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
828 int mask;
829 } range[XLFD_LAST_INDEX];
830 int i, j;
ec6fe57c 831 int range_from, range_to;
4485a28e
KH		 832 unsigned range_mask;
833
834#define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
835 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
836#define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
4485a28e 837#define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
ef18374f 838 | XLFD_AVGWIDTH_MASK)
4485a28e
KH		 839#define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
840
841 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
842 field. The value is shifted to left one bit by one in the
843 following loop. */
844 for (i = 0, range_mask = 0; i <= 14 - n; i++)
845 range_mask = (range_mask << 1) | 1;
846
ec6fe57c
KH		 847 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
848 position-based retriction for FIELD[I]. */
849 for (i = 0, range_from = 0, range_to = 14 - n; i < n;
850 i++, range_from++, range_to++, range_mask <<= 1)
4485a28e 851 {
4485a28e
KH		 852 Lisp_Object val = field[i];
853
854 tmp[i] = val;
855 if (NILP (val))
856 {
857 /* Wildcard. */
858 range[i].from = range_from;
859 range[i].to = range_to;
860 range[i].mask = range_mask;
861 }
862 else
863 {
864 /* The triplet FROM, TO, and MASK is a value-based
865 retriction for FIELD[I]. */
866 int from, to;
867 unsigned mask;
868
869 if (INTEGERP (val))
870 {
871 int numeric = XINT (val);
872
ef18374f
KH		 873 if (i + 1 == n)
874 from = to = XLFD_ENCODING_INDEX,
875 mask = XLFD_ENCODING_MASK;
ec6fe57c
KH		 876 else if (numeric == 0)
877 from = XLFD_PIXEL_INDEX, to = XLFD_AVGWIDTH_INDEX,
878 mask = XLFD_PIXEL_MASK | XLFD_LARGENUM_MASK;
ef18374f
KH		 879 else if (numeric <= 48)
880 from = to = XLFD_PIXEL_INDEX,
881 mask = XLFD_PIXEL_MASK;
51c01100 882 else
ec6fe57c 883 from = XLFD_POINT_INDEX, to = XLFD_AVGWIDTH_INDEX,
4485a28e
KH		 884 mask = XLFD_LARGENUM_MASK;
885 }
35027d0c 886 else if (SBYTES (SYMBOL_NAME (val)) == 0)
4485a28e
KH		 887 from = XLFD_FOUNDRY_INDEX, to = XLFD_ADSTYLE_INDEX,
888 mask = XLFD_NULL_MASK;
889 else if (i == 0)
890 from = to = XLFD_FOUNDRY_INDEX, mask = XLFD_FOUNDRY_MASK;
891 else if (i + 1 == n)
892 {
893 Lisp_Object name = SYMBOL_NAME (val);
894
895 if (SDATA (name)[SBYTES (name) - 1] == '*')
896 from = XLFD_REGISTRY_INDEX, to = XLFD_ENCODING_INDEX,
897 mask = XLFD_REGENC_MASK;
898 else
899 from = to = XLFD_ENCODING_INDEX,
900 mask = XLFD_ENCODING_MASK;
901 }
ef18374f
KH		 902 else if (range_from <= XLFD_WEIGHT_INDEX
903 && range_to >= XLFD_WEIGHT_INDEX
35027d0c 904 && FONT_WEIGHT_NAME_NUMERIC (val) >= 0)
4485a28e 905 from = to = XLFD_WEIGHT_INDEX, mask = XLFD_WEIGHT_MASK;
ef18374f
KH		 906 else if (range_from <= XLFD_SLANT_INDEX
907 && range_to >= XLFD_SLANT_INDEX
35027d0c 908 && FONT_SLANT_NAME_NUMERIC (val) >= 0)
4485a28e 909 from = to = XLFD_SLANT_INDEX, mask = XLFD_SLANT_MASK;
ef18374f
KH		 910 else if (range_from <= XLFD_SWIDTH_INDEX
911 && range_to >= XLFD_SWIDTH_INDEX
35027d0c 912 && FONT_WIDTH_NAME_NUMERIC (val) >= 0)
4485a28e
KH		 913 from = to = XLFD_SWIDTH_INDEX, mask = XLFD_SWIDTH_MASK;
914 else
915 {
ec6fe57c 916 if (EQ (val, Qc) || EQ (val, Qm) || EQ (val, Qp) || EQ (val, Qd))
4485a28e
KH		 917 from = to = XLFD_SPACING_INDEX, mask = XLFD_SPACING_MASK;
918 else
919 from = XLFD_FOUNDRY_INDEX, to = XLFD_ENCODING_INDEX,
920 mask = XLFD_SYMBOL_MASK;
921 }
922
923 /* Merge position-based and value-based restrictions. */
924 mask &= range_mask;
925 while (from < range_from)
926 mask &= ~(1 << from++);
927 while (from < 14 && ! (mask & (1 << from)))
928 from++;
929 while (to > range_to)
930 mask &= ~(1 << to--);
931 while (to >= 0 && ! (mask & (1 << to)))
932 to--;
933 if (from > to)
934 return -1;
935 range[i].from = from;
936 range[i].to = to;
937 range[i].mask = mask;
938
939 if (from > range_from || to < range_to)
ec6fe57c
KH		 940 {
941 /* The range is narrowed by value-based restrictions.
942 Reflect it to the other fields. */
943
944 /* Following fields should be after FROM. */
945 range_from = from;
946 /* Preceding fields should be before TO. */
947 for (j = i - 1, from--, to--; j >= 0; j--, from--, to--)
948 {
949 /* Check FROM for non-wildcard field. */
950 if (! NILP (tmp[j]) && range[j].from < from)
951 {
952 while (range[j].from < from)
953 range[j].mask &= ~(1 << range[j].from++);
954 while (from < 14 && ! (range[j].mask & (1 << from)))
955 from++;
956 range[j].from = from;
957 }
958 else
959 from = range[j].from;
960 if (range[j].to > to)
961 {
962 while (range[j].to > to)
963 range[j].mask &= ~(1 << range[j].to--);
964 while (to >= 0 && ! (range[j].mask & (1 << to)))
965 to--;
966 range[j].to = to;
967 }
968 else
969 to = range[j].to;
970 if (from > to)
971 return -1;
972 }
973 }
4485a28e
KH		 974 }
975 }
976
977 /* Decide all fileds from restrictions in RANGE. */
978 for (i = j = 0; i < n ; i++)
979 {
980 if (j < range[i].from)
981 {
982 if (i == 0 || ! NILP (tmp[i - 1]))
983 /* None of TMP[X] corresponds to Jth field. */
984 return -1;
985 for (; j < range[i].from; j++)
986 field[j] = Qnil;
987 }
988 field[j++] = tmp[i];
989 }
990 if (! NILP (tmp[n - 1]) && j < XLFD_REGISTRY_INDEX)
991 return -1;
992 for (; j < XLFD_LAST_INDEX; j++)
993 field[j] = Qnil;
994 if (INTEGERP (field[XLFD_ENCODING_INDEX]))
995 field[XLFD_ENCODING_INDEX]
996 = Fintern (Fnumber_to_string (field[XLFD_ENCODING_INDEX]), Qnil);
997 return 0;
998}
999
43a1d19b
SM		 1000
1001#ifdef ENABLE_CHECKING
1002/* Match a 14-field XLFD pattern against a full XLFD font name. */
1003static int
1004font_match_xlfd (char *pattern, char *name)
1005{
1006 while (*pattern && *name)
1007 {
1008 if (*pattern == *name)
1009 pattern++;
1010 else if (*pattern == '*')
1011 if (*name == pattern[1])
1012 pattern += 2;
1013 else
1014 ;
1015 else
1016 return 0;
1017 name++;
1018 }
1019 return 1;
1020}
1021
1022/* Make sure the font object matches the XLFD font name. */
1023static int
1024font_check_xlfd_parse (Lisp_Object font, char *name)
1025{
1026 char name_check[256];
1027 font_unparse_xlfd (font, 0, name_check, 255);
1028 return font_match_xlfd (name_check, name);
1029}
1030
1031#endif
1032
35027d0c 1033
ef18374f 1034/* Parse NAME (null terminated) as XLFD and store information in FONT
9331887d
KH		 1035 (font-spec or font-entity). Size property of FONT is set as
1036 follows:
1037 specified XLFD fields FONT property
1038 --------------------- -------------
1039 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1040 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1041 POINT_SIZE POINT_SIZE/10 (Lisp float)
1042
ec6fe57c 1043 If NAME is successfully parsed, return 0. Otherwise return -1.
9331887d 1044
ec6fe57c
KH		 1045 FONT is usually a font-spec, but when this function is called from
1046 X font backend driver, it is a font-entity. In that case, NAME is
35027d0c 1047 a fully specified XLFD. */
c2f5bfd6
KH		 1048
1049int
ec6fe57c 1050font_parse_xlfd (name, font)
c2f5bfd6
KH		 1051 char *name;
1052 Lisp_Object font;
c2f5bfd6
KH		 1053{
1054 int len = strlen (name);
35027d0c 1055 int i, j, n;
cf23b845 1056 char *f[XLFD_LAST_INDEX + 1];
c2f5bfd6 1057 Lisp_Object val;
4485a28e 1058 char *p;
c2f5bfd6
KH		 1059
1060 if (len > 255)
1061 /* Maximum XLFD name length is 255. */
1062 return -1;
ec6fe57c
KH		 1063 /* Accept "*-.." as a fully specified XLFD. */
1064 if (name[0] == '*' && name[1] == '-')
1065 i = 1, f[XLFD_FOUNDRY_INDEX] = name;
1066 else
1067 i = 0;
1068 for (p = name + i; *p; p++)
35027d0c
KH		 1069 if (*p == '-')
1070 {
1071 f[i++] = p + 1;
1072 if (i == XLFD_LAST_INDEX)
1073 break;
1074 }
1075 f[i] = name + len;
c2f5bfd6 1076
2f286d4f
KH		 1077#define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1078#define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
4485a28e 1079
ec6fe57c 1080 if (i == XLFD_LAST_INDEX)
4485a28e 1081 {
35027d0c 1082 /* Fully specified XLFD. */
ec6fe57c
KH		 1083 int pixel_size;
1084
2f286d4f
KH		 1085 ASET (font, FONT_FOUNDRY_INDEX, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX));
1086 ASET (font, FONT_FAMILY_INDEX, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX));
35027d0c
KH		 1087 for (i = XLFD_WEIGHT_INDEX, j = FONT_WEIGHT_INDEX;
1088 i <= XLFD_SWIDTH_INDEX; i++, j++)
4485a28e 1089 {
2f286d4f 1090 val = INTERN_FIELD_SYM (i);
ec6fe57c 1091 if (! NILP (val))
4485a28e 1092 {
2f286d4f 1093 if ((n = font_style_to_value (j, INTERN_FIELD_SYM (i), 0)) < 0)
35027d0c
KH		 1094 return -1;
1095 ASET (font, j, make_number (n));
ec6fe57c
KH		 1096 }
1097 }
2f286d4f 1098 ASET (font, FONT_ADSTYLE_INDEX, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX));
35027d0c
KH		 1099 if (strcmp (f[XLFD_REGISTRY_INDEX], "*-*") == 0)
1100 ASET (font, FONT_REGISTRY_INDEX, Qnil);
1101 else
1102 ASET (font, FONT_REGISTRY_INDEX,
1103 font_intern_prop (f[XLFD_REGISTRY_INDEX],
2f286d4f
KH		 1104 f[XLFD_LAST_INDEX] - f[XLFD_REGISTRY_INDEX],
1105 1));
ec6fe57c
KH		 1106 p = f[XLFD_PIXEL_INDEX];
1107 if (*p == '[' && (pixel_size = parse_matrix (p)) >= 0)
51c01100 1108 ASET (font, FONT_SIZE_INDEX, make_number (pixel_size));
ec6fe57c
KH		 1109 else
1110 {
35027d0c
KH		 1111 val = INTERN_FIELD (XLFD_PIXEL_INDEX);
1112 if (INTEGERP (val))
ec6fe57c
KH		 1113 ASET (font, FONT_SIZE_INDEX, val);
1114 else
1115 {
1116 double point_size = -1;
1117
d0ab1ebe 1118 font_assert (FONT_SPEC_P (font));
ec6fe57c
KH		 1119 p = f[XLFD_POINT_INDEX];
1120 if (*p == '[')
1121 point_size = parse_matrix (p);
1122 else if (isdigit (*p))
1123 point_size = atoi (p), point_size /= 10;
1124 if (point_size >= 0)
1125 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
4485a28e
KH		 1126 }
1127 }
ec6fe57c 1128
35027d0c
KH		 1129 ASET (font, FONT_DPI_INDEX, INTERN_FIELD (XLFD_RESY_INDEX));
1130 val = INTERN_FIELD (XLFD_SPACING_INDEX);
1131 if (! NILP (val))
ec6fe57c 1132 {
35027d0c
KH		 1133 val = font_prop_validate_spacing (QCspacing, val);
1134 if (! INTEGERP (val))
1135 return -1;
1136 ASET (font, FONT_SPACING_INDEX, val);
ec6fe57c 1137 }
ec6fe57c
KH		 1138 p = f[XLFD_AVGWIDTH_INDEX];
1139 if (*p == '~')
1140 p++;
35027d0c 1141 ASET (font, FONT_AVGWIDTH_INDEX,
d26424c5 1142 font_intern_prop (p, f[XLFD_REGISTRY_INDEX] - 1 - p, 0));
4485a28e
KH		 1143 }
1144 else
c2f5bfd6 1145 {
4485a28e 1146 int wild_card_found = 0;
ec6fe57c 1147 Lisp_Object prop[XLFD_LAST_INDEX];
4485a28e 1148
35027d0c
KH		 1149 if (FONT_ENTITY_P (font))
1150 return -1;
ec6fe57c 1151 for (j = 0; j < i; j++)
4485a28e 1152 {
ec6fe57c 1153 if (*f[j] == '*')
4485a28e 1154 {
ec6fe57c
KH		 1155 if (f[j][1] && f[j][1] != '-')
1156 return -1;
1157 prop[j] = Qnil;
1158 wild_card_found = 1;
1159 }
ec6fe57c 1160 else if (j + 1 < i)
35027d0c 1161 prop[j] = INTERN_FIELD (j);
ec6fe57c 1162 else
2f286d4f 1163 prop[j] = font_intern_prop (f[j], f[i] - f[j], 0);
4485a28e
KH		 1164 }
1165 if (! wild_card_found)
c2f5bfd6 1166 return -1;
ec6fe57c 1167 if (font_expand_wildcards (prop, i) < 0)
4485a28e 1168 return -1;
ec6fe57c 1169
35027d0c
KH		 1170 ASET (font, FONT_FOUNDRY_INDEX, prop[XLFD_FOUNDRY_INDEX]);
1171 ASET (font, FONT_FAMILY_INDEX, prop[XLFD_FAMILY_INDEX]);
1172 for (i = XLFD_WEIGHT_INDEX, j = FONT_WEIGHT_INDEX;
1173 i <= XLFD_SWIDTH_INDEX; i++, j++)
ec6fe57c 1174 if (! NILP (prop[i]))
35027d0c
KH		 1175 {
1176 if ((n = font_style_to_value (j, prop[i], 1)) < 0)
1177 return -1;
1178 ASET (font, j, make_number (n));
1179 }
1180 ASET (font, FONT_ADSTYLE_INDEX, prop[XLFD_ADSTYLE_INDEX]);
ec6fe57c
KH		 1181 val = prop[XLFD_REGISTRY_INDEX];
1182 if (NILP (val))
c2f5bfd6 1183 {
ec6fe57c
KH		 1184 val = prop[XLFD_ENCODING_INDEX];
1185 if (! NILP (val))
35027d0c 1186 val = concat2 (build_string ("*-"), SYMBOL_NAME (val));
4485a28e 1187 }
ec6fe57c 1188 else if (NILP (prop[XLFD_ENCODING_INDEX]))
35027d0c 1189 val = concat2 (SYMBOL_NAME (val), build_string ("-*"));
4485a28e 1190 else
35027d0c
KH		 1191 val = concat3 (SYMBOL_NAME (val), build_string ("-"),
1192 SYMBOL_NAME (prop[XLFD_ENCODING_INDEX]));
ec6fe57c 1193 if (! NILP (val))
35027d0c 1194 ASET (font, FONT_REGISTRY_INDEX, Fintern (val, Qnil));
ec6fe57c
KH		 1195
1196 if (INTEGERP (prop[XLFD_PIXEL_INDEX]))
1197 ASET (font, FONT_SIZE_INDEX, prop[XLFD_PIXEL_INDEX]);
1198 else if (INTEGERP (prop[XLFD_POINT_INDEX]))
4485a28e 1199 {
ec6fe57c 1200 double point_size = XINT (prop[XLFD_POINT_INDEX]);
c2f5bfd6 1201
ec6fe57c
KH		 1202 ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10));
1203 }
c2f5bfd6 1204
35027d0c
KH		 1205 if (INTEGERP (prop[XLFD_RESX_INDEX]))
1206 ASET (font, FONT_DPI_INDEX, prop[XLFD_RESY_INDEX]);
1207 if (! NILP (prop[XLFD_SPACING_INDEX]))
1208 {
1209 val = font_prop_validate_spacing (QCspacing,
1210 prop[XLFD_SPACING_INDEX]);
1211 if (! INTEGERP (val))
1212 return -1;
1213 ASET (font, FONT_SPACING_INDEX, val);
1214 }
ec6fe57c 1215 if (INTEGERP (prop[XLFD_AVGWIDTH_INDEX]))
35027d0c 1216 ASET (font, FONT_AVGWIDTH_INDEX, prop[XLFD_AVGWIDTH_INDEX]);
c2f5bfd6
KH		 1217 }
1218
ec6fe57c 1219 return 0;
c2f5bfd6
KH		 1220}
1221
1222/* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1223 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1224 0, use PIXEL_SIZE instead. */
1225
1226int
1227font_unparse_xlfd (font, pixel_size, name, nbytes)
1228 Lisp_Object font;
1bb1d99b 1229 int pixel_size;
c2f5bfd6
KH		 1230 char *name;
1231 int nbytes;
1232{
ec6fe57c 1233 char *f[XLFD_REGISTRY_INDEX + 1];
c2f5bfd6
KH		 1234 Lisp_Object val;
1235 int i, j, len = 0;
1236
d0ab1ebe 1237 font_assert (FONTP (font));
c2f5bfd6
KH		 1238
1239 for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX;
1240 i++, j++)
1241 {
1242 if (i == FONT_ADSTYLE_INDEX)
1243 j = XLFD_ADSTYLE_INDEX;
1244 else if (i == FONT_REGISTRY_INDEX)
1245 j = XLFD_REGISTRY_INDEX;
1246 val = AREF (font, i);
1247 if (NILP (val))
1bb1d99b
KH		 1248 {
1249 if (j == XLFD_REGISTRY_INDEX)
1250 f[j] = "*-*", len += 4;
1251 else
1252 f[j] = "*", len += 2;
1253 }
c2f5bfd6
KH		 1254 else
1255 {
1256 if (SYMBOLP (val))
1257 val = SYMBOL_NAME (val);
1bb1d99b
KH		 1258 if (j == XLFD_REGISTRY_INDEX
1259 && ! strchr ((char *) SDATA (val), '-'))
1260 {
1261 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1262 if (SDATA (val)[SBYTES (val) - 1] == '*')
1263 {
1264 f[j] = alloca (SBYTES (val) + 3);
1265 sprintf (f[j], "%s-*", SDATA (val));
1266 len += SBYTES (val) + 3;
1267 }
1268 else
1269 {
1270 f[j] = alloca (SBYTES (val) + 4);
1271 sprintf (f[j], "%s*-*", SDATA (val));
1272 len += SBYTES (val) + 4;
1273 }
1274 }
1275 else
1276 f[j] = (char *) SDATA (val), len += SBYTES (val) + 1;
c2f5bfd6
KH		 1277 }
1278 }
1279
1280 for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX;
1281 i++, j++)
1282 {
35027d0c 1283 val = font_style_symbolic (font, i, 0);
c2f5bfd6
KH		 1284 if (NILP (val))
1285 f[j] = "*", len += 2;
1286 else
1287 {
35027d0c 1288 val = SYMBOL_NAME (val);
c2f5bfd6
KH		 1289 f[j] = (char *) SDATA (val), len += SBYTES (val) + 1;
1290 }
1291 }
1292
1293 val = AREF (font, FONT_SIZE_INDEX);
d0ab1ebe 1294 font_assert (NUMBERP (val) || NILP (val));
c2f5bfd6
KH		 1295 if (INTEGERP (val))
1296 {
35027d0c 1297 i = XINT (val);
81aefea4
SM		 1298 if (i <= 0)
1299 i = pixel_size;
c2f5bfd6 1300 if (i > 0)
81aefea4
SM		 1301 {
1302 f[XLFD_PIXEL_INDEX] = alloca (22);
1303 len += sprintf (f[XLFD_PIXEL_INDEX], "%d-*", i) + 1;
1304 }
1305 else
1306 f[XLFD_PIXEL_INDEX] = "*-*", len += 4;
c2f5bfd6
KH		 1307 }
1308 else if (FLOATP (val))
1309 {
35027d0c 1310 i = XFLOAT_DATA (val) * 10;
ec6fe57c 1311 f[XLFD_PIXEL_INDEX] = alloca (12);
ec6fe57c 1312 len += sprintf (f[XLFD_PIXEL_INDEX], "*-%d", i) + 1;
c2f5bfd6
KH		 1313 }
1314 else
ec6fe57c
KH		 1315 f[XLFD_PIXEL_INDEX] = "*-*", len += 4;
1316
35027d0c 1317 if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
c2f5bfd6 1318 {
35027d0c
KH		 1319 i = XINT (AREF (font, FONT_DPI_INDEX));
1320 f[XLFD_RESX_INDEX] = alloca (22);
1321 len += sprintf (f[XLFD_RESX_INDEX],
1322 "%d-%d", i, i) + 1;
c2f5bfd6
KH		 1323 }
1324 else
35027d0c
KH		 1325 f[XLFD_RESX_INDEX] = "*-*", len += 4;
1326 if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
ec6fe57c 1327 {
35027d0c 1328 int spacing = XINT (AREF (font, FONT_SPACING_INDEX));
ec6fe57c 1329
35027d0c
KH		 1330 f[XLFD_SPACING_INDEX] = (spacing <= FONT_SPACING_PROPORTIONAL ? "p"
1331 : spacing <= FONT_SPACING_DUAL ? "d"
1332 : spacing <= FONT_SPACING_MONO ? "m"
1333 : "c");
1334 len += 2;
ec6fe57c 1335 }
35027d0c
KH		 1336 else
1337 f[XLFD_SPACING_INDEX] = "*", len += 2;
1338 if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
1339 {
1340 f[XLFD_AVGWIDTH_INDEX] = alloca (11);
1341 len += sprintf (f[XLFD_AVGWIDTH_INDEX],
1342 "%d", XINT (AREF (font, FONT_AVGWIDTH_INDEX))) + 1;
1343 }
1344 else
1345 f[XLFD_AVGWIDTH_INDEX] = "*", len += 2;
ec6fe57c 1346 len++; /* for terminating '\0'. */
c2f5bfd6
KH		 1347 if (len >= nbytes)
1348 return -1;
35027d0c 1349 return sprintf (name, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
c2f5bfd6
KH		 1350 f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
1351 f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
35027d0c
KH		 1352 f[XLFD_SWIDTH_INDEX], f[XLFD_ADSTYLE_INDEX],
1353 f[XLFD_PIXEL_INDEX], f[XLFD_RESX_INDEX],
1354 f[XLFD_SPACING_INDEX], f[XLFD_AVGWIDTH_INDEX],
1355 f[XLFD_REGISTRY_INDEX]);
c2f5bfd6
KH		 1356}
1357
8c102d5b
CY		 1358/* Parse NAME (null terminated) and store information in FONT
1359 (font-spec or font-entity). NAME is supplied in either the
1360 Fontconfig or GTK font name format. If NAME is successfully
1361 parsed, return 0. Otherwise return -1.
1362
1363 The fontconfig format is
1364
1365 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1366
1367 The GTK format is
1368
1369 FAMILY [PROPS...] [SIZE]
1370
1371 This function tries to guess which format it is. */
ef18374f
KH		 1372
1373int
ec6fe57c 1374font_parse_fcname (name, font)
ef18374f
KH		 1375 char *name;
1376 Lisp_Object font;
ef18374f 1377{
8c102d5b
CY		 1378 char *p, *q;
1379 char *size_beg = NULL, *size_end = NULL;
1380 char *props_beg = NULL, *family_end = NULL;
9331887d 1381 int len = strlen (name);
ef18374f 1382
ec6fe57c
KH		 1383 if (len == 0)
1384 return -1;
8c102d5b
CY		 1385
1386 for (p = name; *p; p++)
ef18374f 1387 {
8c102d5b
CY		 1388 if (*p == '\\' && p[1])
1389 p++;
1390 else if (*p == ':')
ef18374f 1391 {
59facb78 1392 props_beg = family_end = p;
8c102d5b
CY		 1393 break;
1394 }
1395 else if (*p == '-')
1396 {
b1868a1a 1397 int decimal = 0, size_found = 1;
8c102d5b 1398 for (q = p + 1; *q && *q != ':'; q++)
b1868a1a 1399 if (! isdigit(*q))
8c102d5b 1400 {
b1868a1a
CY		 1401 if (*q != '.' || decimal)
1402 {
1403 size_found = 0;
1404 break;
1405 }
1406 decimal = 1;
8c102d5b
CY		 1407 }
1408 if (size_found)
1409 {
1410 family_end = p;
1411 size_beg = p + 1;
1412 size_end = q;
1413 break;
1414 }
ef18374f 1415 }
ef18374f 1416 }
9331887d 1417
8c102d5b
CY		 1418 if (family_end)
1419 {
1420 /* A fontconfig name with size and/or property data. */
1421 if (family_end > name)
1422 {
1423 Lisp_Object family;
1424 family = font_intern_prop (name, family_end - name, 1);
1425 ASET (font, FONT_FAMILY_INDEX, family);
1426 }
1427 if (size_beg)
1428 {
1429 double point_size = strtod (size_beg, &size_end);
1430 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
1431 if (*size_end == ':' && size_end[1])
59facb78 1432 props_beg = size_end;
8c102d5b
CY		 1433 }
1434 if (props_beg)
1435 {
d26424c5 1436 /* Now parse ":KEY=VAL" patterns. */
59facb78 1437 Lisp_Object val;
8c102d5b 1438
59facb78 1439 for (p = props_beg; *p; p = q)
8c102d5b 1440 {
8c102d5b 1441 for (q = p + 1; *q && *q != '=' && *q != ':'; q++);
8c102d5b
CY		 1442 if (*q != '=')
1443 {
1444 /* Must be an enumerated value. */
59facb78
CY		 1445 int word_len;
1446 p = p + 1;
1447 word_len = q - p;
8c102d5b 1448 val = font_intern_prop (p, q - p, 1);
9277a69d
CY		 1449
1450#define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1451
8c102d5b
CY		 1452 if (PROP_MATCH ("light", 5)
1453 || PROP_MATCH ("medium", 6)
1454 || PROP_MATCH ("demibold", 8)
1455 || PROP_MATCH ("bold", 4)
1456 || PROP_MATCH ("black", 5))
1457 FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, val);
1458 else if (PROP_MATCH ("roman", 5)
1459 || PROP_MATCH ("italic", 6)
1460 || PROP_MATCH ("oblique", 7))
1461 FONT_SET_STYLE (font, FONT_SLANT_INDEX, val);
1462 else if (PROP_MATCH ("charcell", 8))
1463 ASET (font, FONT_SPACING_INDEX,
1464 make_number (FONT_SPACING_CHARCELL));
1465 else if (PROP_MATCH ("mono", 4))
1466 ASET (font, FONT_SPACING_INDEX,
1467 make_number (FONT_SPACING_MONO));
1468 else if (PROP_MATCH ("proportional", 12))
1469 ASET (font, FONT_SPACING_INDEX,
1470 make_number (FONT_SPACING_PROPORTIONAL));
9277a69d 1471#undef PROP_MATCH
8c102d5b 1472 }
59facb78 1473 else
8c102d5b 1474 {
59facb78 1475 /* KEY=VAL pairs */
8c102d5b 1476 Lisp_Object key;
59facb78 1477 int prop;
51c01100 1478
59facb78 1479 if (q - p == 10 && memcmp (p + 1, "pixelsize", 9) == 0)
8c102d5b
CY		 1480 prop = FONT_SIZE_INDEX;
1481 else
1482 {
1483 key = font_intern_prop (p, q - p, 1);
1484 prop = get_font_prop_index (key);
1485 }
77989187 1486
8c102d5b
CY		 1487 p = q + 1;
1488 for (q = p; *q && *q != ':'; q++);
90c00b01 1489 val = font_intern_prop (p, q - p, 0);
77989187 1490
d26424c5
KH		 1491 if (prop >= FONT_FOUNDRY_INDEX
1492 && prop < FONT_EXTRA_INDEX)
1493 ASET (font, prop, font_prop_validate (prop, Qnil, val));
1494 else
1495 Ffont_put (font, key, val);
8c102d5b 1496 }
d26424c5 1497 p = q;
8c102d5b 1498 }
8c102d5b
CY		 1499 }
1500 }
1501 else
ef18374f 1502 {
8c102d5b
CY		 1503 /* Either a fontconfig-style name with no size and property
1504 data, or a GTK-style name. */
1505 Lisp_Object prop;
1506 int word_len, prop_found = 0;
ef18374f 1507
8c102d5b 1508 for (p = name; *p; p = *q ? q + 1 : q)
ef18374f 1509 {
8c102d5b 1510 if (isdigit (*p))
9331887d 1511 {
8c102d5b 1512 int size_found = 1;
7181ea6a 1513
8c102d5b
CY		 1514 for (q = p + 1; *q && *q != ' '; q++)
1515 if (! isdigit (*q))
1516 {
1517 size_found = 0;
1518 break;
1519 }
1520 if (size_found)
1521 {
1522 double point_size = strtod (p, &q);
1523 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
1524 continue;
1525 }
027a33c0 1526 }
8c102d5b
CY		 1527
1528 for (q = p + 1; *q && *q != ' '; q++)
1529 if (*q == '\\' && q[1])
1530 q++;
1531 word_len = q - p;
1532
1533#define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1534
1535 if (PROP_MATCH ("Ultra-Light", 11))
9331887d 1536 {
8c102d5b
CY		 1537 prop_found = 1;
1538 prop = font_intern_prop ("ultra-light", 11, 1);
1539 FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
9331887d 1540 }
8c102d5b 1541 else if (PROP_MATCH ("Light", 5))
9331887d 1542 {
8c102d5b
CY		 1543 prop_found = 1;
1544 prop = font_intern_prop ("light", 5, 1);
1545 FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
9331887d 1546 }
8c102d5b 1547 else if (PROP_MATCH ("Semi-Bold", 9))
9331887d 1548 {
8c102d5b
CY		 1549 prop_found = 1;
1550 prop = font_intern_prop ("semi-bold", 9, 1);
1551 FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
1552 }
1553 else if (PROP_MATCH ("Bold", 4))
1554 {
1555 prop_found = 1;
1556 prop = font_intern_prop ("bold", 4, 1);
1557 FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
ef18374f 1558 }
8c102d5b
CY		 1559 else if (PROP_MATCH ("Italic", 6))
1560 {
1561 prop_found = 1;
1562 prop = font_intern_prop ("italic", 4, 1);
1563 FONT_SET_STYLE (font, FONT_SLANT_INDEX, prop);
1564 }
1565 else if (PROP_MATCH ("Oblique", 7))
1566 {
1567 prop_found = 1;
1568 prop = font_intern_prop ("oblique", 7, 1);
1569 FONT_SET_STYLE (font, FONT_SLANT_INDEX, prop);
1570 }
1571 else {
1572 if (prop_found)
1573 return -1; /* Unknown property in GTK-style font name. */
1574 family_end = q;
1575 }
ef18374f 1576 }
8c102d5b 1577#undef PROP_MATCH
9ba6fd41 1578
8c102d5b
CY		 1579 if (family_end)
1580 {
1581 Lisp_Object family;
1582 family = font_intern_prop (name, family_end - name, 1);
1583 ASET (font, FONT_FAMILY_INDEX, family);
1584 }
1585 }
17ab8f5d 1586
9331887d 1587 return 0;
ef18374f
KH		 1588}
1589
1590/* Store fontconfig's font name of FONT (font-spec or font-entity) in
1591 NAME (NBYTES length), and return the name length. If
1592 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1593
1594int
1595font_unparse_fcname (font, pixel_size, name, nbytes)
1596 Lisp_Object font;
1597 int pixel_size;
1598 char *name;
1599 int nbytes;
1600{
b1868a1a 1601 Lisp_Object family, foundry;
35027d0c 1602 Lisp_Object tail, val;
ec6fe57c 1603 int point_size;
d0ab1ebe 1604 int dpi;
ec6fe57c 1605 int i, len = 1;
ef18374f 1606 char *p;
a9262bb8 1607 Lisp_Object styles[3];
417a1b10 1608 char *style_names[3] = { "weight", "slant", "width" };
35027d0c 1609 char work[256];
ef18374f 1610
b1868a1a
CY		 1611 family = AREF (font, FONT_FAMILY_INDEX);
1612 if (! NILP (family))
1613 {
1614 if (SYMBOLP (family))
1615 {
1616 family = SYMBOL_NAME (family);
1617 len += SBYTES (family);
1618 }
1619 else
1620 family = Qnil;
1621 }
ec6fe57c
KH		 1622
1623 val = AREF (font, FONT_SIZE_INDEX);
1624 if (INTEGERP (val))
ef18374f 1625 {
ec6fe57c
KH		 1626 if (XINT (val) != 0)
1627 pixel_size = XINT (val);
1628 point_size = -1;
1629 len += 21; /* for ":pixelsize=NUM" */
ef18374f 1630 }
ec6fe57c 1631 else if (FLOATP (val))
ef18374f 1632 {
ec6fe57c
KH		 1633 pixel_size = -1;
1634 point_size = (int) XFLOAT_DATA (val);
1635 len += 11; /* for "-NUM" */
ef18374f 1636 }
ec6fe57c 1637
b1868a1a
CY		 1638 foundry = AREF (font, FONT_FOUNDRY_INDEX);
1639 if (! NILP (foundry))
1640 {
1641 if (SYMBOLP (foundry))
1642 {
1643 foundry = SYMBOL_NAME (foundry);
1644 len += 9 + SBYTES (foundry); /* ":foundry=NAME" */
1645 }
1646 else
1647 foundry = Qnil;
1648 }
ec6fe57c 1649
35027d0c 1650 for (i = 0; i < 3; i++)
a9262bb8 1651 {
35027d0c
KH		 1652 styles[i] = font_style_symbolic (font, FONT_WEIGHT_INDEX + i, 0);
1653 if (! NILP (styles[i]))
1654 len += sprintf (work, ":%s=%s", style_names[i],
1655 SDATA (SYMBOL_NAME (styles[i])));
ec6fe57c 1656 }
35027d0c
KH		 1657
1658 if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
1659 len += sprintf (work, ":dpi=%d", dpi);
1660 if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
1661 len += strlen (":spacing=100");
1662 if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
1663 len += strlen (":scalable=false"); /* or ":scalable=true" */
1664 for (tail = AREF (font, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
ec6fe57c 1665 {
35027d0c
KH		 1666 Lisp_Object key = XCAR (XCAR (tail)), val = XCDR (XCAR (tail));
1667
1668 len += SBYTES (SYMBOL_NAME (key)) + 1; /* for :KEY= */
1669 if (STRINGP (val))
1670 len += SBYTES (val);
1671 else if (INTEGERP (val))
1672 len += sprintf (work, "%d", XINT (val));
1673 else if (SYMBOLP (val))
1674 len += (NILP (val) ? 5 : 4); /* for "false" or "true" */
ec6fe57c
KH		 1675 }
1676
ef18374f
KH		 1677 if (len > nbytes)
1678 return -1;
1679 p = name;
b1868a1a
CY		 1680 if (! NILP (family))
1681 p += sprintf (p, "%s", SDATA (family));
ec6fe57c
KH		 1682 if (point_size > 0)
1683 {
1684 if (p == name)
1685 p += sprintf (p, "%d", point_size);
1686 else
1687 p += sprintf (p, "-%d", point_size);
1688 }
ef18374f
KH		 1689 else if (pixel_size > 0)
1690 p += sprintf (p, ":pixelsize=%d", pixel_size);
35027d0c 1691 if (! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
a9262bb8
KH		 1692 p += sprintf (p, ":foundry=%s",
1693 SDATA (SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX))));
1694 for (i = 0; i < 3; i++)
35027d0c 1695 if (! NILP (styles[i]))
a9262bb8 1696 p += sprintf (p, ":%s=%s", style_names[i],
35027d0c
KH		 1697 SDATA (SYMBOL_NAME (styles[i])));
1698 if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
1699 p += sprintf (p, ":dpi=%d", XINT (AREF (font, FONT_DPI_INDEX)));
1700 if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
1701 p += sprintf (p, ":spacing=%d", XINT (AREF (font, FONT_SPACING_INDEX)));
1702 if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
1703 {
1704 if (XINT (AREF (font, FONT_AVGWIDTH_INDEX)) == 0)
1705 p += sprintf (p, ":scalable=true");
1706 else
1707 p += sprintf (p, ":scalable=false");
1708 }
ef18374f
KH		 1709 return (p - name);
1710}
1711
b1868a1a
CY		 1712/* Store GTK-style font name of FONT (font-spec or font-entity) in
1713 NAME (NBYTES length), and return the name length. F is the frame
1714 on which the font is displayed; it is used to calculate the point
1715 size. */
1716
1717int
1718font_unparse_gtkname (font, f, name, nbytes)
1719 Lisp_Object font;
1720 struct frame *f;
1721 char *name;
1722 int nbytes;
1723{
1724 char *p;
1725 int len = 1;
1726 Lisp_Object family, weight, slant, size;
1727 int point_size = -1;
1728
1729 family = AREF (font, FONT_FAMILY_INDEX);
1730 if (! NILP (family))
1731 {
1732 if (! SYMBOLP (family))
1733 return -1;
1734 family = SYMBOL_NAME (family);
1735 len += SBYTES (family);
1736 }
1737
1738 weight = font_style_symbolic (font, FONT_WEIGHT_INDEX, 0);
93eed26b 1739 if (EQ (weight, Qnormal))
b1868a1a
CY		 1740 weight = Qnil;
1741 else if (! NILP (weight))
1742 {
1743 weight = SYMBOL_NAME (weight);
1744 len += SBYTES (weight);
1745 }
1746
1747 slant = font_style_symbolic (font, FONT_SLANT_INDEX, 0);
93eed26b 1748 if (EQ (slant, Qnormal))
b1868a1a
CY		 1749 slant = Qnil;
1750 else if (! NILP (slant))
1751 {
1752 slant = SYMBOL_NAME (slant);
1753 len += SBYTES (slant);
1754 }
1755
1756 size = AREF (font, FONT_SIZE_INDEX);
1757 /* Convert pixel size to point size. */
1758 if (INTEGERP (size))
1759 {
1760 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
1761 int dpi = 75;
1762 if (INTEGERP (font_dpi))
1763 dpi = XINT (font_dpi);
1764 else if (f)
1765 dpi = f->resy;
1766 point_size = PIXEL_TO_POINT (XINT (size), dpi);
1767 len += 11;
1768 }
1769 else if (FLOATP (size))
1770 {
1771 point_size = (int) XFLOAT_DATA (size);
1772 len += 11;
1773 }
1774
1775 if (len > nbytes)
1776 return -1;
1777
1778 p = name + sprintf (name, "%s", SDATA (family));
1779
1780 if (! NILP (weight))
1781 {
1782 char *q = p;
1783 p += sprintf (p, " %s", SDATA (weight));
1784 q[1] = toupper (q[1]);
1785 }
1786
1787 if (! NILP (slant))
1788 {
1789 char *q = p;
1790 p += sprintf (p, " %s", SDATA (slant));
1791 q[1] = toupper (q[1]);
1792 }
1793
1794 if (point_size > 0)
1795 p += sprintf (p, " %d", point_size);
1796
1797 return (p - name);
1798}
1799
ef18374f
KH		 1800/* Parse NAME (null terminated) and store information in FONT
1801 (font-spec or font-entity). If NAME is successfully parsed, return
35027d0c 1802 0. Otherwise return -1. */
ef18374f
KH		 1803
1804static int
ec6fe57c 1805font_parse_name (name, font)
ef18374f
KH		 1806 char *name;
1807 Lisp_Object font;
ef18374f
KH		 1808{
1809 if (name[0] == '-' || index (name, '*'))
e950d6f1 1810 return font_parse_xlfd (name, font);
ec6fe57c 1811 return font_parse_fcname (name, font);
ef18374f
KH		 1812}
1813
35027d0c
KH		 1814
1815/* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1816 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1817 part. */
45eb10fb 1818
c2f5bfd6 1819void
35027d0c
KH		 1820font_parse_family_registry (family, registry, font_spec)
1821 Lisp_Object family, registry, font_spec;
c2f5bfd6 1822{
35027d0c
KH		 1823 int len;
1824 char *p0, *p1;
1825
d0ab1ebe
KH		 1826 if (! NILP (family)
1827 && NILP (AREF (font_spec, FONT_FAMILY_INDEX)))
c2f5bfd6 1828 {
35027d0c
KH		 1829 CHECK_STRING (family);
1830 len = SBYTES (family);
1831 p0 = (char *) SDATA (family);
1832 p1 = index (p0, '-');
1833 if (p1)
c2f5bfd6 1834 {
d0ab1ebe
KH		 1835 if ((*p0 != '*' || p1 - p0 > 1)
1836 && NILP (AREF (font_spec, FONT_FOUNDRY_INDEX)))
2f286d4f 1837 Ffont_put (font_spec, QCfoundry, font_intern_prop (p0, p1 - p0, 1));
35027d0c
KH		 1838 p1++;
1839 len -= p1 - p0;
2f286d4f 1840 Ffont_put (font_spec, QCfamily, font_intern_prop (p1, len, 1));
c2f5bfd6 1841 }
35027d0c
KH		 1842 else
1843 ASET (font_spec, FONT_FAMILY_INDEX, Fintern (family, Qnil));
c2f5bfd6 1844 }
35027d0c 1845 if (! NILP (registry))
c2f5bfd6 1846 {
35027d0c
KH		 1847 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1848 CHECK_STRING (registry);
1849 len = SBYTES (registry);
1850 p0 = (char *) SDATA (registry);
1851 p1 = index (p0, '-');
1852 if (! p1)
c2f5bfd6 1853 {
35027d0c
KH		 1854 if (SDATA (registry)[len - 1] == '*')
1855 registry = concat2 (registry, build_string ("-*"));
1856 else
1857 registry = concat2 (registry, build_string ("*-*"));
c2f5bfd6 1858 }
35027d0c
KH		 1859 registry = Fdowncase (registry);
1860 ASET (font_spec, FONT_REGISTRY_INDEX, Fintern (registry, Qnil));
c2f5bfd6
KH		 1861 }
1862}
1863
45eb10fb 1864\f
35027d0c
KH		 1865/* This part (through the next ^L) is still experimental and not
1866 tested much. We may drastically change codes. */
10d16101 1867
45eb10fb 1868/* OTF handler */
10d16101 1869
6a3dadd2
KH		 1870#if 0
1871
e950d6f1
KH		 1872#define LGSTRING_HEADER_SIZE 6
1873#define LGSTRING_GLYPH_SIZE 8
1874
1875static int
1876check_gstring (gstring)
1877 Lisp_Object gstring;
1878{
1879 Lisp_Object val;
1880 int i, j;
1881
1882 CHECK_VECTOR (gstring);
1883 val = AREF (gstring, 0);
1884 CHECK_VECTOR (val);
1885 if (ASIZE (val) < LGSTRING_HEADER_SIZE)
1886 goto err;
1887 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
f9ffa1ea
SM		 1888 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
1889 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
1890 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
1891 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
1892 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
1893 CHECK_NATNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
1894 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
1895 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
1896 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
1897 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
e950d6f1 1898
071132a9 1899 for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
e950d6f1
KH		 1900 {
1901 val = LGSTRING_GLYPH (gstring, i);
1902 CHECK_VECTOR (val);
1903 if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
1904 goto err;
f9ffa1ea 1905 if (NILP (AREF (val, LGLYPH_IX_CHAR)))
e950d6f1 1906 break;
f9ffa1ea
SM		 1907 CHECK_NATNUM (AREF (val, LGLYPH_IX_FROM));
1908 CHECK_NATNUM (AREF (val, LGLYPH_IX_TO));
1909 CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
1910 if (!NILP (AREF (val, LGLYPH_IX_CODE)))
1911 CHECK_NATNUM (AREF (val, LGLYPH_IX_CODE));
1912 if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
1913 CHECK_NATNUM (AREF (val, LGLYPH_IX_WIDTH));
1914 if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
e950d6f1 1915 {
f9ffa1ea 1916 val = AREF (val, LGLYPH_IX_ADJUSTMENT);
e950d6f1
KH		 1917 CHECK_VECTOR (val);
1918 if (ASIZE (val) < 3)
1919 goto err;
1920 for (j = 0; j < 3; j++)
1921 CHECK_NUMBER (AREF (val, j));
1922 }
1923 }
1924 return i;
1925 err:
1926 error ("Invalid glyph-string format");
1927 return -1;
1928}
1929
cf385d93
KH		 1930static void
1931check_otf_features (otf_features)
1932 Lisp_Object otf_features;
1933{
35027d0c 1934 Lisp_Object val;
cf385d93
KH		 1935
1936 CHECK_CONS (otf_features);
1937 CHECK_SYMBOL (XCAR (otf_features));
1938 otf_features = XCDR (otf_features);
1939 CHECK_CONS (otf_features);
1940 CHECK_SYMBOL (XCAR (otf_features));
1941 otf_features = XCDR (otf_features);
1942 for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
1943 {
1944 CHECK_SYMBOL (Fcar (val));
1945 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1946 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val)));
1947 }
1948 otf_features = XCDR (otf_features);
1949 for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
1950 {
1951 CHECK_SYMBOL (Fcar (val));
1952 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1953 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val)));
1954 }
1955}
1956
c2f5bfd6
KH		 1957#ifdef HAVE_LIBOTF
1958#include <otf.h>
1959
733fd013 1960Lisp_Object otf_list;
c2f5bfd6
KH		 1961
1962static Lisp_Object
1963otf_tag_symbol (tag)
1964 OTF_Tag tag;
1965{
1966 char name[5];
1967
1968 OTF_tag_name (tag, name);
1969 return Fintern (make_unibyte_string (name, 4), Qnil);
1970}
1971
1972static OTF *
35027d0c
KH		 1973otf_open (file)
1974 Lisp_Object file;
c2f5bfd6 1975{
35027d0c 1976 Lisp_Object val = Fassoc (file, otf_list);
733fd013
KH		 1977 OTF *otf;
1978
1979 if (! NILP (val))
1980 otf = XSAVE_VALUE (XCDR (val))->pointer;
1981 else
c2f5bfd6 1982 {
35027d0c 1983 otf = STRINGP (file) ? OTF_open ((char *) SDATA (file)) : NULL;
733fd013 1984 val = make_save_value (otf, 0);
35027d0c 1985 otf_list = Fcons (Fcons (file, val), otf_list);
c2f5bfd6 1986 }
733fd013 1987 return otf;
c2f5bfd6
KH		 1988}
1989
1990
1991/* Return a list describing which scripts/languages FONT supports by
1992 which GSUB/GPOS features of OpenType tables. See the comment of
51c01100 1993 (struct font_driver).otf_capability. */
c2f5bfd6
KH		 1994
1995Lisp_Object
1996font_otf_capability (font)
1997 struct font *font;
1998{
1999 OTF *otf;
2000 Lisp_Object capability = Fcons (Qnil, Qnil);
2001 int i;
2002
35027d0c 2003 otf = otf_open (font->props[FONT_FILE_INDEX]);
c2f5bfd6
KH		 2004 if (! otf)
2005 return Qnil;
2006 for (i = 0; i < 2; i++)
2007 {
2008 OTF_GSUB_GPOS *gsub_gpos;
2009 Lisp_Object script_list = Qnil;
2010 int j;
2011
2012 if (OTF_get_features (otf, i == 0) < 0)
2013 continue;
2014 gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
2015 for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
2016 {
2017 OTF_Script *script = gsub_gpos->ScriptList.Script + j;
2018 Lisp_Object langsys_list = Qnil;
2019 Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
2020 int k;
2021
2022 for (k = script->LangSysCount; k >= 0; k--)
2023 {
2024 OTF_LangSys *langsys;
2025 Lisp_Object feature_list = Qnil;
2026 Lisp_Object langsys_tag;
2027 int l;
2028
e80e09b4 2029 if (k == script->LangSysCount)
c2f5bfd6
KH		 2030 {
2031 langsys = &script->DefaultLangSys;
2032 langsys_tag = Qnil;
2033 }
2034 else
2035 {
2036 langsys = script->LangSys + k;
2037 langsys_tag
2038 = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
2039 }
e80e09b4 2040 for (l = langsys->FeatureCount - 1; l >= 0; l--)
c2f5bfd6
KH		 2041 {
2042 OTF_Feature *feature
2043 = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
2044 Lisp_Object feature_tag
2045 = otf_tag_symbol (feature->FeatureTag);
2046
2047 feature_list = Fcons (feature_tag, feature_list);
2048 }
2049 langsys_list = Fcons (Fcons (langsys_tag, feature_list),
2050 langsys_list);
2051 }
2052 script_list = Fcons (Fcons (script_tag, langsys_list),
2053 script_list);
2054 }
2055
2056 if (i == 0)
2057 XSETCAR (capability, script_list);
2058 else
2059 XSETCDR (capability, script_list);
2060 }
2061
2062 return capability;
2063}
2064
733fd013
KH		 2065/* Parse OTF features in SPEC and write a proper features spec string
2066 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2067 assured that the sufficient memory has already allocated for
2068 FEATURES. */
2069
e80e09b4 2070static void
733fd013 2071generate_otf_features (spec, features)
c2f5bfd6 2072 Lisp_Object spec;
733fd013 2073 char *features;
c2f5bfd6
KH		 2074{
2075 Lisp_Object val;
35027d0c 2076 char *p;
c2f5bfd6
KH		 2077 int asterisk;
2078
733fd013 2079 p = features;
e80e09b4 2080 *p = '\0';
c2f5bfd6
KH		 2081 for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
2082 {
2083 val = XCAR (spec);
e80e09b4
KH		 2084 CHECK_SYMBOL (val);
2085 if (p > features)
733fd013 2086 *p++ = ',';
c2f5bfd6
KH		 2087 if (SREF (SYMBOL_NAME (val), 0) == '*')
2088 {
2089 asterisk = 1;
e80e09b4 2090 *p++ = '*';
c2f5bfd6
KH		 2091 }
2092 else if (! asterisk)
e80e09b4
KH		 2093 {
2094 val = SYMBOL_NAME (val);
e80e09b4
KH		 2095 p += sprintf (p, "%s", SDATA (val));
2096 }
c2f5bfd6 2097 else
e80e09b4
KH		 2098 {
2099 val = SYMBOL_NAME (val);
e80e09b4
KH		 2100 p += sprintf (p, "~%s", SDATA (val));
2101 }
c2f5bfd6 2102 }
e80e09b4
KH		 2103 if (CONSP (spec))
2104 error ("OTF spec too long");
2105}
2106
733fd013
KH		 2107Lisp_Object
2108font_otf_DeviceTable (device_table)
2109 OTF_DeviceTable *device_table;
2110{
2111 int len = device_table->StartSize - device_table->EndSize + 1;
2112
2113 return Fcons (make_number (len),
2114 make_unibyte_string (device_table->DeltaValue, len));
2115}
2116
2117Lisp_Object
2118font_otf_ValueRecord (value_format, value_record)
2119 int value_format;
2120 OTF_ValueRecord *value_record;
2121{
2122 Lisp_Object val = Fmake_vector (make_number (8), Qnil);
2123
2124 if (value_format & OTF_XPlacement)
43c0454d 2125 ASET (val, 0, make_number (value_record->XPlacement));
733fd013 2126 if (value_format & OTF_YPlacement)
43c0454d 2127 ASET (val, 1, make_number (value_record->YPlacement));
733fd013 2128 if (value_format & OTF_XAdvance)
43c0454d 2129 ASET (val, 2, make_number (value_record->XAdvance));
733fd013 2130 if (value_format & OTF_YAdvance)
43c0454d 2131 ASET (val, 3, make_number (value_record->YAdvance));
733fd013
KH		 2132 if (value_format & OTF_XPlaDevice)
2133 ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
2134 if (value_format & OTF_YPlaDevice)
2135 ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
2136 if (value_format & OTF_XAdvDevice)
2137 ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
2138 if (value_format & OTF_YAdvDevice)
2139 ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
2140 return val;
2141}
2142
2143Lisp_Object
2144font_otf_Anchor (anchor)
2145 OTF_Anchor *anchor;
2146{
2147 Lisp_Object val;
2148
2149 val = Fmake_vector (make_number (anchor->AnchorFormat + 1), Qnil);
2150 ASET (val, 0, make_number (anchor->XCoordinate));
2151 ASET (val, 1, make_number (anchor->YCoordinate));
2152 if (anchor->AnchorFormat == 2)
2153 ASET (val, 2, make_number (anchor->f.f1.AnchorPoint));
2154 else
2155 {
2156 ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
2157 ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
2158 }
2159 return val;
2160}
c2f5bfd6 2161#endif /* HAVE_LIBOTF */
6a3dadd2 2162#endif /* 0 */
c2f5bfd6 2163
c2f5bfd6
KH		 2164\f
2165/* Font sorting */
2166
4007dd1c 2167static unsigned font_score P_ ((Lisp_Object, Lisp_Object *));
c2f5bfd6
KH		 2168static int font_compare P_ ((const void *, const void *));
2169static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object,
7181ea6a 2170 Lisp_Object, int));
c2f5bfd6
KH		 2171
2172/* We sort fonts by scoring each of them against a specified
2173 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2174 the value is, the closer the font is to the font-spec.
2175
4007dd1c
KH		 2176 The lowest 2 bits of the score is used for driver type. The font
2177 available by the most preferred font driver is 0.
35027d0c 2178
4007dd1c 2179 Each 7-bit in the higher 28 bits are used for numeric properties
c2f5bfd6
KH		 2180 WEIGHT, SLANT, WIDTH, and SIZE. */
2181
2182/* How many bits to shift to store the difference value of each font
35027d0c
KH		 2183 property in a score. Note that flots for FONT_TYPE_INDEX and
2184 FONT_REGISTRY_INDEX are not used. */
c2f5bfd6
KH		 2185static int sort_shift_bits[FONT_SIZE_INDEX + 1];
2186
9331887d
KH		 2187/* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2188 The return value indicates how different ENTITY is compared with
51c13510 2189 SPEC_PROP. */
c2f5bfd6
KH		 2190
2191static unsigned
4007dd1c 2192font_score (entity, spec_prop)
9331887d 2193 Lisp_Object entity, *spec_prop;
c2f5bfd6
KH		 2194{
2195 unsigned score = 0;
2196 int i;
c2f5bfd6 2197
35027d0c
KH		 2198 /* Score three style numeric fields. Maximum difference is 127. */
2199 for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
2200 if (! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i]))
2201 {
2202 int diff = (XINT (AREF (entity, i)) >> 8) - (XINT (spec_prop[i]) >> 8);
2203
2204 if (diff < 0)
2205 diff = - diff;
f4cc0153
KH		 2206 if (diff > 0)
2207 score |= min (diff, 127) << sort_shift_bits[i];
35027d0c
KH		 2208 }
2209
2210 /* Score the size. Maximum difference is 127. */
2211 i = FONT_SIZE_INDEX;
2641e213 2212 if (! NILP (spec_prop[i]) && XINT (AREF (entity, i)) > 0)
35027d0c
KH		 2213 {
2214 /* We use the higher 6-bit for the actual size difference. The
2215 lowest bit is set if the DPI is different. */
2216 int diff = XINT (spec_prop[i]) - XINT (AREF (entity, i));
2217
2218 if (diff < 0)
2219 diff = - diff;
d0ab1ebe 2220 diff <<= 1;
35027d0c
KH		 2221 if (! NILP (spec_prop[FONT_DPI_INDEX])
2222 && ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
2223 diff |= 1;
2224 score |= min (diff, 127) << sort_shift_bits[FONT_SIZE_INDEX];
c2f5bfd6
KH		 2225 }
2226
2227 return score;
2228}
2229
2230
2231/* The comparison function for qsort. */
2232
2233static int
2234font_compare (d1, d2)
2235 const void *d1, *d2;
2236{
35027d0c 2237 return (*(unsigned *) d1 - *(unsigned *) d2);
c2f5bfd6
KH		 2238}
2239
2240
2241/* The structure for elements being sorted by qsort. */
2242struct font_sort_data
2243{
2244 unsigned score;
2245 Lisp_Object entity;
2246};
2247
2248
2249/* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2250 If PREFER specifies a point-size, calculate the corresponding
9331887d 2251 pixel-size from QCdpi property of PREFER or from the Y-resolution
7181ea6a 2252 of FRAME before sorting.
35027d0c
KH		 2253
2254 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2255 return the sorted VEC. */
c2f5bfd6
KH		 2256
2257static Lisp_Object
7181ea6a
KH		 2258font_sort_entites (vec, prefer, frame, best_only)
2259 Lisp_Object vec, prefer, frame;
35027d0c 2260 int best_only;
c2f5bfd6 2261{
9331887d 2262 Lisp_Object prefer_prop[FONT_SPEC_MAX];
c2f5bfd6
KH		 2263 int len, i;
2264 struct font_sort_data *data;
35027d0c 2265 unsigned best_score;
4007dd1c
KH		 2266 Lisp_Object best_entity, driver_type;
2267 int driver_order;
2268 struct frame *f = XFRAME (frame);
2269 struct font_driver_list *list;
c2f5bfd6
KH		 2270 USE_SAFE_ALLOCA;
2271
2272 len = ASIZE (vec);
2273 if (len <= 1)
35027d0c 2274 return best_only ? AREF (vec, 0) : vec;
c2f5bfd6 2275
2641e213 2276 for (i = FONT_WEIGHT_INDEX; i <= FONT_DPI_INDEX; i++)
9331887d 2277 prefer_prop[i] = AREF (prefer, i);
9331887d
KH		 2278 if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
2279 prefer_prop[FONT_SIZE_INDEX]
2280 = make_number (font_pixel_size (XFRAME (frame), prefer));
2281
c2f5bfd6
KH		 2282 /* Scoring and sorting. */
2283 SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len);
35027d0c 2284 best_score = 0xFFFFFFFF;
4007dd1c
KH		 2285 /* We are sure that the length of VEC > 1. */
2286 driver_type = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
2287 for (driver_order = 0, list = f->font_driver_list; list;
2288 driver_order++, list = list->next)
2289 if (EQ (driver_type, list->driver->type))
2290 break;
2291 best_entity = data[0].entity = AREF (vec, 0);
2292 best_score = data[0].score
2293 = font_score (data[0].entity, prefer_prop) | driver_order;
c2f5bfd6
KH		 2294 for (i = 0; i < len; i++)
2295 {
4007dd1c
KH		 2296 if (!EQ (driver_type, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
2297 for (driver_order = 0, list = f->font_driver_list; list;
2298 driver_order++, list = list->next)
2299 if (EQ (driver_type, list->driver->type))
2300 break;
c2f5bfd6 2301 data[i].entity = AREF (vec, i);
4007dd1c 2302 data[i].score = font_score (data[i].entity, prefer_prop) | driver_order;
35027d0c
KH		 2303 if (best_only && best_score > data[i].score)
2304 {
2305 best_score = data[i].score;
2306 best_entity = data[i].entity;
2307 if (best_score == 0)
2308 break;
2309 }
c2f5bfd6 2310 }
7181ea6a 2311 if (! best_only)
35027d0c
KH		 2312 {
2313 qsort (data, len, sizeof *data, font_compare);
2314 for (i = 0; i < len; i++)
2315 ASET (vec, i, data[i].entity);
2316 }
2317 else
2318 vec = best_entity;
c2f5bfd6
KH		 2319 SAFE_FREE ();
2320
d0ab1ebe 2321 font_add_log ("sort-by", prefer, vec);
c2f5bfd6
KH		 2322 return vec;
2323}
2324
2325\f
2326/* API of Font Service Layer. */
2327
45eb10fb
KH		 2328/* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2329 sort_shift_bits. Finternal_set_font_selection_order calls this
2330 function with font_sort_order after setting up it. */
2331
c2f5bfd6
KH		 2332void
2333font_update_sort_order (order)
2334 int *order;
2335{
35027d0c 2336 int i, shift_bits;
c2f5bfd6 2337
943b7eea 2338 for (i = 0, shift_bits = 23; i < 4; i++, shift_bits -= 7)
c2f5bfd6
KH		 2339 {
2340 int xlfd_idx = order[i];
2341
2342 if (xlfd_idx == XLFD_WEIGHT_INDEX)
2343 sort_shift_bits[FONT_WEIGHT_INDEX] = shift_bits;
2344 else if (xlfd_idx == XLFD_SLANT_INDEX)
2345 sort_shift_bits[FONT_SLANT_INDEX] = shift_bits;
2346 else if (xlfd_idx == XLFD_SWIDTH_INDEX)
2347 sort_shift_bits[FONT_WIDTH_INDEX] = shift_bits;
2348 else
2349 sort_shift_bits[FONT_SIZE_INDEX] = shift_bits;
2350 }
2351}
2352
51c13510
KH		 2353static int
2354font_check_otf_features (script, langsys, features, table)
2355 Lisp_Object script, langsys, features, table;
2356{
2357 Lisp_Object val;
2358 int negative;
2359
2360 table = assq_no_quit (script, table);
2361 if (NILP (table))
2362 return 0;
2363 table = XCDR (table);
2364 if (! NILP (langsys))
2365 {
2366 table = assq_no_quit (langsys, table);
2367 if (NILP (table))
2368 return 0;
2369 }
2370 else
2371 {
2372 val = assq_no_quit (Qnil, table);
2373 if (NILP (val))
2374 table = XCAR (table);
2375 else
2376 table = val;
2377 }
2378 table = XCDR (table);
2379 for (negative = 0; CONSP (features); features = XCDR (features))
2380 {
2381 if (NILP (XCAR (features)))
2382 negative = 1;
2383 if (NILP (Fmemq (XCAR (features), table)) != negative)
2384 return 0;
2385 }
2386 return 1;
2387}
2388
2389/* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2390
2391static int
3cba9369 2392font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
51c13510
KH		 2393{
2394 Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
2395
2396 script = XCAR (spec);
2397 spec = XCDR (spec);
2398 if (! NILP (spec))
2399 {
2400 langsys = XCAR (spec);
2401 spec = XCDR (spec);
2402 if (! NILP (spec))
2403 {
2404 gsub = XCAR (spec);
2405 spec = XCDR (spec);
2406 if (! NILP (spec))
2407 gpos = XCAR (spec);
2408 }
2409 }
2410
2411 if (! NILP (gsub) && ! font_check_otf_features (script, langsys, gsub,
2412 XCAR (otf_capability)))
2413 return 0;
2414 if (! NILP (gpos) && ! font_check_otf_features (script, langsys, gpos,
2415 XCDR (otf_capability)))
2416 return 0;
2417 return 1;
2418}
2419
45eb10fb 2420
51c13510
KH		 2421
2422/* Check if FONT (font-entity or font-object) matches with the font
2423 specification SPEC. */
45eb10fb 2424
ef18374f 2425int
51c13510
KH		 2426font_match_p (spec, font)
2427 Lisp_Object spec, font;
ef18374f 2428{
51c13510
KH		 2429 Lisp_Object prop[FONT_SPEC_MAX], *props;
2430 Lisp_Object extra, font_extra;
ef18374f
KH		 2431 int i;
2432
51c13510
KH		 2433 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
2434 if (! NILP (AREF (spec, i))
2435 && ! NILP (AREF (font, i))
2436 && ! EQ (AREF (spec, i), AREF (font, i)))
2437 return 0;
2438 props = XFONT_SPEC (spec)->props;
2439 if (FLOATP (props[FONT_SIZE_INDEX]))
2440 {
2441 for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++)
2442 prop[i] = AREF (spec, i);
2443 prop[FONT_SIZE_INDEX]
2444 = make_number (font_pixel_size (XFRAME (selected_frame), spec));
2445 props = prop;
2446 }
2447
2448 if (font_score (font, props) > 0)
2449 return 0;
2450 extra = AREF (spec, FONT_EXTRA_INDEX);
2451 font_extra = AREF (font, FONT_EXTRA_INDEX);
2452 for (; CONSP (extra); extra = XCDR (extra))
35027d0c 2453 {
51c13510
KH		 2454 Lisp_Object key = XCAR (XCAR (extra));
2455 Lisp_Object val = XCDR (XCAR (extra)), val2;
2456
2457 if (EQ (key, QClang))
2458 {
2459 val2 = assq_no_quit (key, font_extra);
2460 if (NILP (val2))
2461 return 0;
2462 val2 = XCDR (val2);
2463 if (CONSP (val))
2464 {
2465 if (! CONSP (val2))
2466 return 0;
2467 while (CONSP (val))
2468 if (NILP (Fmemq (val, val2)))
2469 return 0;
2470 }
2471 else
2472 if (CONSP (val2)
2473 ? NILP (Fmemq (val, XCDR (val2)))
2474 : ! EQ (val, val2))
2475 return 0;
2476 }
2477 else if (EQ (key, QCscript))
2478 {
2479 val2 = assq_no_quit (val, Vscript_representative_chars);
2480 if (! NILP (val2))
2481 for (val2 = XCDR (val2); CONSP (val2); val2 = XCDR (val2))
2482 if (font_encode_char (font, XINT (XCAR (val2)))
2483 == FONT_INVALID_CODE)
2484 return 0;
2485 }
2486 else if (EQ (key, QCotf))
2487 {
2488 struct font *fontp;
2489
2490 if (! FONT_OBJECT_P (font))
2491 return 0;
2492 fontp = XFONT_OBJECT (font);
2493 if (! fontp->driver->otf_capability)
2494 return 0;
2495 val2 = fontp->driver->otf_capability (fontp);
2496 if (NILP (val2) || ! font_check_otf (val, val2))
2497 return 0;
2498 }
35027d0c
KH		 2499 }
2500
51c13510 2501 return 1;
ef18374f 2502}
ca4da08a 2503\f
819e81df 2504
ca4da08a
KH		 2505/* Font cache
2506
2507 Each font backend has the callback function get_cache, and it
2508 returns a cons cell of which cdr part can be freely used for
2509 caching fonts. The cons cell may be shared by multiple frames
2510 and/or multiple font drivers. So, we arrange the cdr part as this:
2511
2512 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2513
2514 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2515 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2516 cons (FONT-SPEC FONT-ENTITY ...). */
2517
2518static void font_prepare_cache P_ ((FRAME_PTR, struct font_driver *));
2519static void font_finish_cache P_ ((FRAME_PTR, struct font_driver *));
2520static Lisp_Object font_get_cache P_ ((FRAME_PTR, struct font_driver *));
2521static void font_clear_cache P_ ((FRAME_PTR, Lisp_Object,
2522 struct font_driver *));
2523
2524static void
2525font_prepare_cache (f, driver)
2526 FRAME_PTR f;
2527 struct font_driver *driver;
2528{
2529 Lisp_Object cache, val;
2530
2531 cache = driver->get_cache (f);
2532 val = XCDR (cache);
2533 while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
2534 val = XCDR (val);
2535 if (NILP (val))
2536 {
2537 val = Fcons (driver->type, Fcons (make_number (1), Qnil));
2538 XSETCDR (cache, Fcons (val, XCDR (cache)));
2539 }
2540 else
2541 {
2542 val = XCDR (XCAR (val));
2543 XSETCAR (val, make_number (XINT (XCAR (val)) + 1));
2544 }
2545}
2546
43c0454d 2547
ca4da08a
KH		 2548static void
2549font_finish_cache (f, driver)
2550 FRAME_PTR f;
2551 struct font_driver *driver;
2552{
2553 Lisp_Object cache, val, tmp;
2554
2555
2556 cache = driver->get_cache (f);
2557 val = XCDR (cache);
2558 while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
2559 cache = val, val = XCDR (val);
d0ab1ebe 2560 font_assert (! NILP (val));
ca4da08a 2561 tmp = XCDR (XCAR (val));
43c0454d 2562 XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1));
ca4da08a
KH		 2563 if (XINT (XCAR (tmp)) == 0)
2564 {
2565 font_clear_cache (f, XCAR (val), driver);
2566 XSETCDR (cache, XCDR (val));
2567 }
ca4da08a
KH		 2568}
2569
43c0454d 2570
ca4da08a
KH		 2571static Lisp_Object
2572font_get_cache (f, driver)
2573 FRAME_PTR f;
2574 struct font_driver *driver;
2575{
2576 Lisp_Object val = driver->get_cache (f);
2577 Lisp_Object type = driver->type;
2578
d0ab1ebe 2579 font_assert (CONSP (val));
ca4da08a 2580 for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val));
d0ab1ebe 2581 font_assert (CONSP (val));
ca4da08a
KH		 2582 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2583 val = XCDR (XCAR (val));
2584 return val;
2585}
2586
43c0454d
KH		 2587static int num_fonts;
2588
ca4da08a
KH		 2589static void
2590font_clear_cache (f, cache, driver)
2591 FRAME_PTR f;
2592 Lisp_Object cache;
2593 struct font_driver *driver;
2594{
2595 Lisp_Object tail, elt;
51c01100 2596
ca4da08a
KH		 2597 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2598 for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
2599 {
2600 elt = XCAR (tail);
be9442ad 2601 if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)) && VECTORP (XCDR (elt)))
ca4da08a
KH		 2602 {
2603 Lisp_Object vec = XCDR (elt);
2604 int i;
2605
2606 for (i = 0; i < ASIZE (vec); i++)
2607 {
2608 Lisp_Object entity = AREF (vec, i);
2609
2610 if (EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
2611 {
2612 Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
2613
2614 for (; CONSP (objlist); objlist = XCDR (objlist))
2615 {
2616 Lisp_Object val = XCAR (objlist);
35027d0c 2617 struct font *font = XFONT_OBJECT (val);
ca4da08a 2618
5e634ec9
KH		 2619 if (! NILP (AREF (val, FONT_TYPE_INDEX)))
2620 {
2621 font_assert (font && driver == font->driver);
2622 driver->close (f, font);
2623 num_fonts--;
2624 }
ca4da08a
KH		 2625 }
2626 if (driver->free_entity)
2627 driver->free_entity (entity);
2628 }
2629 }
2630 }
2631 }
2632 XSETCDR (cache, Qnil);
2633}
2634\f
2635
c2f5bfd6
KH		 2636static Lisp_Object scratch_font_spec, scratch_font_prefer;
2637
35027d0c
KH		 2638Lisp_Object
2639font_delete_unmatched (list, spec, size)
2640 Lisp_Object list, spec;
2641 int size;
2642{
d0ab1ebe 2643 Lisp_Object entity, val;
35027d0c 2644 enum font_property_index prop;
45eb10fb 2645
d0ab1ebe 2646 for (val = Qnil; CONSP (list); list = XCDR (list))
35027d0c 2647 {
d0ab1ebe 2648 entity = XCAR (list);
35027d0c
KH		 2649 for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
2650 if (INTEGERP (AREF (spec, prop))
2651 && ((XINT (AREF (spec, prop)) >> 8)
2652 != (XINT (AREF (entity, prop)) >> 8)))
2653 prop = FONT_SPEC_MAX;
7181ea6a 2654 if (prop < FONT_SPEC_MAX
35027d0c
KH		 2655 && size
2656 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
2657 {
2658 int diff = XINT (AREF (entity, FONT_SIZE_INDEX)) - size;
c2f5bfd6 2659
35027d0c
KH		 2660 if (diff != 0
2661 && (diff < 0 ? -diff > FONT_PIXEL_SIZE_QUANTUM
2662 : diff > FONT_PIXEL_SIZE_QUANTUM))
2663 prop = FONT_SPEC_MAX;
2664 }
7181ea6a
KH		 2665 if (prop < FONT_SPEC_MAX
2666 && INTEGERP (AREF (spec, FONT_DPI_INDEX))
2667 && INTEGERP (AREF (entity, FONT_DPI_INDEX))
2668 && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX)))
2669 prop = FONT_SPEC_MAX;
2670 if (prop < FONT_SPEC_MAX
2671 && INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX))
2672 && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
2673 && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX),
2674 AREF (entity, FONT_AVGWIDTH_INDEX)))
2675 prop = FONT_SPEC_MAX;
35027d0c 2676 if (prop < FONT_SPEC_MAX)
d0ab1ebe 2677 val = Fcons (entity, val);
35027d0c 2678 }
d0ab1ebe 2679 return val;
35027d0c
KH		 2680}
2681
2682
2683/* Return a vector of font-entities matching with SPEC on FRAME. */
2684
2685Lisp_Object
c2f5bfd6
KH		 2686font_list_entities (frame, spec)
2687 Lisp_Object frame, spec;
2688{
2689 FRAME_PTR f = XFRAME (frame);
2690 struct font_driver_list *driver_list = f->font_driver_list;
4007dd1c 2691 Lisp_Object ftype, val;
35027d0c
KH		 2692 Lisp_Object *vec;
2693 int size;
2694 int need_filtering = 0;
c2f5bfd6
KH		 2695 int i;
2696
d0ab1ebe 2697 font_assert (FONT_SPEC_P (spec));
c2f5bfd6 2698
35027d0c
KH		 2699 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
2700 size = XINT (AREF (spec, FONT_SIZE_INDEX));
2701 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
2702 size = font_pixel_size (f, spec);
2703 else
2704 size = 0;
2705
c2f5bfd6 2706 ftype = AREF (spec, FONT_TYPE_INDEX);
4007dd1c 2707 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
35027d0c 2708 ASET (scratch_font_spec, i, AREF (spec, i));
4007dd1c 2709 for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
35027d0c
KH		 2710 {
2711 ASET (scratch_font_spec, i, Qnil);
2712 if (! NILP (AREF (spec, i)))
2713 need_filtering = 1;
4007dd1c
KH		 2714 if (i == FONT_DPI_INDEX)
2715 /* Skip FONT_SPACING_INDEX */
2716 i++;
35027d0c 2717 }
aa50ca2f 2718 ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
35027d0c
KH		 2719 ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
2720
4007dd1c 2721 vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
35027d0c
KH		 2722 if (! vec)
2723 return null_vector;
51c01100 2724
c2f5bfd6 2725 for (i = 0; driver_list; driver_list = driver_list->next)
417a1b10
KH		 2726 if (driver_list->on
2727 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
c2f5bfd6 2728 {
ca4da08a 2729 Lisp_Object cache = font_get_cache (f, driver_list->driver);
c2f5bfd6 2730
e4c93315 2731 ASET (scratch_font_spec, FONT_TYPE_INDEX, driver_list->driver->type);
4007dd1c
KH		 2732 val = assoc_no_quit (scratch_font_spec, XCDR (cache));
2733 if (CONSP (val))
2734 val = XCDR (val);
2735 else
c2f5bfd6 2736 {
4007dd1c 2737 Lisp_Object copy;
35027d0c 2738
4007dd1c
KH		 2739 val = driver_list->driver->list (frame, scratch_font_spec);
2740 copy = Fcopy_font_spec (scratch_font_spec);
2741 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2742 XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
c2f5bfd6 2743 }
4007dd1c
KH		 2744 if (! NILP (val) && need_filtering)
2745 val = font_delete_unmatched (val, spec, size);
2746 if (! NILP (val))
2747 vec[i++] = val;
c2f5bfd6 2748 }
35027d0c 2749
d0ab1ebe
KH		 2750 val = (i > 0 ? Fvconcat (i, vec) : null_vector);
2751 font_add_log ("list", spec, val);
2752 return (val);
c2f5bfd6
KH		 2753}
2754
45eb10fb 2755
35027d0c
KH		 2756/* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2757 nil, is an array of face's attributes, which specifies preferred
2758 font-related attributes. */
45eb10fb 2759
e950d6f1 2760static Lisp_Object
35027d0c
KH		 2761font_matching_entity (f, attrs, spec)
2762 FRAME_PTR f;
2763 Lisp_Object *attrs, spec;
e950d6f1 2764{
e950d6f1
KH		 2765 struct font_driver_list *driver_list = f->font_driver_list;
2766 Lisp_Object ftype, size, entity;
35027d0c 2767 Lisp_Object frame;
e950d6f1 2768
35027d0c 2769 XSETFRAME (frame, f);
e950d6f1
KH		 2770 ftype = AREF (spec, FONT_TYPE_INDEX);
2771 size = AREF (spec, FONT_SIZE_INDEX);
2772 if (FLOATP (size))
2773 ASET (spec, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
2774 entity = Qnil;
2775 for (; driver_list; driver_list = driver_list->next)
2776 if (driver_list->on
2777 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
2778 {
ca4da08a 2779 Lisp_Object cache = font_get_cache (f, driver_list->driver);
7cee5d63 2780 Lisp_Object copy;
e950d6f1 2781
e950d6f1 2782 ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type);
35027d0c 2783 entity = assoc_no_quit (spec, XCDR (cache));
7cee5d63 2784 if (CONSP (entity))
e950d6f1
KH		 2785 entity = XCDR (entity);
2786 else
2787 {
2788 entity = driver_list->driver->match (frame, spec);
7cee5d63
KH		 2789 copy = Fcopy_font_spec (spec);
2790 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2791 XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache)));
e950d6f1
KH		 2792 }
2793 if (! NILP (entity))
2794 break;
2795 }
2796 ASET (spec, FONT_TYPE_INDEX, ftype);
2797 ASET (spec, FONT_SIZE_INDEX, size);
d0ab1ebe 2798 font_add_log ("match", spec, entity);
e950d6f1
KH		 2799 return entity;
2800}
2801
45eb10fb
KH		 2802
2803/* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2804 opened font object. */
2805
c2f5bfd6
KH		 2806static Lisp_Object
2807font_open_entity (f, entity, pixel_size)
2808 FRAME_PTR f;
2809 Lisp_Object entity;
2810 int pixel_size;
2811{
2812 struct font_driver_list *driver_list;
43c0454d 2813 Lisp_Object objlist, size, val, font_object;
c2f5bfd6 2814 struct font *font;
d26424c5 2815 int min_width, height;
c2f5bfd6 2816
d0ab1ebe 2817 font_assert (FONT_ENTITY_P (entity));
c2f5bfd6 2818 size = AREF (entity, FONT_SIZE_INDEX);
c2f5bfd6
KH		 2819 if (XINT (size) != 0)
2820 pixel_size = XINT (size);
2821
2822 for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
2823 objlist = XCDR (objlist))
5e634ec9
KH		 2824 if (! NILP (AREF (XCAR (objlist), FONT_TYPE_INDEX))
2825 && XFONT_OBJECT (XCAR (objlist))->pixel_size == pixel_size)
35027d0c
KH		 2826 return XCAR (objlist);
2827
2828 val = AREF (entity, FONT_TYPE_INDEX);
2829 for (driver_list = f->font_driver_list;
2830 driver_list && ! EQ (driver_list->driver->type, val);
2831 driver_list = driver_list->next);
2832 if (! driver_list)
2833 return Qnil;
c2f5bfd6 2834
35027d0c 2835 font_object = driver_list->driver->open (f, entity, pixel_size);
d0ab1ebe 2836 font_add_log ("open", entity, font_object);
43c0454d 2837 if (NILP (font_object))
35027d0c
KH		 2838 return Qnil;
2839 ASET (entity, FONT_OBJLIST_INDEX,
2840 Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
5e634ec9 2841 ASET (font_object, FONT_OBJLIST_INDEX, Qnil);
35027d0c
KH		 2842 num_fonts++;
2843
2844 font = XFONT_OBJECT (font_object);
2845 min_width = (font->min_width ? font->min_width
2846 : font->average_width ? font->average_width
2847 : font->space_width ? font->space_width
2848 : 1);
d26424c5 2849 height = (font->height ? font->height : 1);
819e81df 2850#ifdef HAVE_WINDOW_SYSTEM
35027d0c
KH		 2851 FRAME_X_DISPLAY_INFO (f)->n_fonts++;
2852 if (FRAME_X_DISPLAY_INFO (f)->n_fonts == 1)
43c0454d 2853 {
35027d0c 2854 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width;
d26424c5 2855 FRAME_SMALLEST_FONT_HEIGHT (f) = height;
35027d0c
KH		 2856 fonts_changed_p = 1;
2857 }
2858 else
2859 {
2860 if (FRAME_SMALLEST_CHAR_WIDTH (f) > min_width)
2861 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width, fonts_changed_p = 1;
d26424c5
KH		 2862 if (FRAME_SMALLEST_FONT_HEIGHT (f) > height)
2863 FRAME_SMALLEST_FONT_HEIGHT (f) = height, fonts_changed_p = 1;
43c0454d 2864 }
819e81df 2865#endif
43c0454d
KH		 2866
2867 return font_object;
c2f5bfd6
KH		 2868}
2869
45eb10fb
KH		 2870
2871/* Close FONT_OBJECT that is opened on frame F. */
2872
c2f5bfd6
KH		 2873void
2874font_close_object (f, font_object)
2875 FRAME_PTR f;
2876 Lisp_Object font_object;
2877{
35027d0c 2878 struct font *font = XFONT_OBJECT (font_object);
c2f5bfd6 2879
5e634ec9
KH		 2880 if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
2881 /* Already closed. */
2882 return;
2883 font_add_log ("close", font_object, Qnil);
2884 font->driver->close (f, font);
819e81df 2885#ifdef HAVE_WINDOW_SYSTEM
5e634ec9
KH		 2886 font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
2887 FRAME_X_DISPLAY_INFO (f)->n_fonts--;
819e81df 2888#endif
5e634ec9 2889 num_fonts--;
c2f5bfd6
KH		 2890}
2891
45eb10fb 2892
1701724c
KH		 2893/* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2894 FONT is a font-entity and it must be opened to check. */
45eb10fb 2895
c2f5bfd6 2896int
1b834a8d 2897font_has_char (f, font, c)
c2f5bfd6 2898 FRAME_PTR f;
1b834a8d 2899 Lisp_Object font;
c2f5bfd6
KH		 2900 int c;
2901{
1b834a8d 2902 struct font *fontp;
c2f5bfd6 2903
1b834a8d
KH		 2904 if (FONT_ENTITY_P (font))
2905 {
2906 Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
2907 struct font_driver_list *driver_list;
2908
2909 for (driver_list = f->font_driver_list;
2910 driver_list && ! EQ (driver_list->driver->type, type);
2911 driver_list = driver_list->next);
2912 if (! driver_list)
2913 return 0;
2914 if (! driver_list->driver->has_char)
2915 return -1;
2916 return driver_list->driver->has_char (font, c);
2917 }
2918
d0ab1ebe 2919 font_assert (FONT_OBJECT_P (font));
35027d0c 2920 fontp = XFONT_OBJECT (font);
1b834a8d
KH		 2921 if (fontp->driver->has_char)
2922 {
35027d0c 2923 int result = fontp->driver->has_char (font, c);
1b834a8d
KH		 2924
2925 if (result >= 0)
2926 return result;
2927 }
2928 return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
c2f5bfd6
KH		 2929}
2930
45eb10fb
KH		 2931
2932/* Return the glyph ID of FONT_OBJECT for character C. */
2933
c2f5bfd6
KH		 2934unsigned
2935font_encode_char (font_object, c)
2936 Lisp_Object font_object;
2937 int c;
2938{
35027d0c 2939 struct font *font;
c2f5bfd6 2940
d0ab1ebe 2941 font_assert (FONT_OBJECT_P (font_object));
35027d0c 2942 font = XFONT_OBJECT (font_object);
c2f5bfd6
KH		 2943 return font->driver->encode_char (font, c);
2944}
2945
45eb10fb
KH		 2946
2947/* Return the name of FONT_OBJECT. */
2948
ef18374f 2949Lisp_Object
c2f5bfd6
KH		 2950font_get_name (font_object)
2951 Lisp_Object font_object;
2952{
d0ab1ebe 2953 font_assert (FONT_OBJECT_P (font_object));
35027d0c 2954 return AREF (font_object, FONT_NAME_INDEX);
ef18374f
KH		 2955}
2956
45eb10fb
KH		 2957
2958/* Return the specification of FONT_OBJECT. */
2959
ef18374f
KH		 2960Lisp_Object
2961font_get_spec (font_object)
2962 Lisp_Object font_object;
2963{
35027d0c 2964 Lisp_Object spec = font_make_spec ();
ef18374f
KH		 2965 int i;
2966
2967 for (i = 0; i < FONT_SIZE_INDEX; i++)
35027d0c
KH		 2968 ASET (spec, i, AREF (font_object, i));
2969 ASET (spec, FONT_SIZE_INDEX,
2970 make_number (XFONT_OBJECT (font_object)->pixel_size));
ef18374f 2971 return spec;
c2f5bfd6
KH		 2972}
2973
35027d0c
KH		 2974Lisp_Object
2975font_spec_from_name (font_name)
2976 Lisp_Object font_name;
2977{
2978 Lisp_Object args[2];
2979
2980 args[0] = QCname;
2981 args[1] = font_name;
2982 return Ffont_spec (2, args);
2983}
2984
45eb10fb 2985
35027d0c
KH		 2986void
2987font_clear_prop (attrs, prop)
2988 Lisp_Object *attrs;
2989 enum font_property_index prop;
2990{
2991 Lisp_Object font = attrs[LFACE_FONT_INDEX];
45eb10fb 2992
35027d0c
KH		 2993 if (! FONTP (font))
2994 return;
2995 if (NILP (AREF (font, prop))
4007dd1c
KH		 2996 && prop != FONT_FAMILY_INDEX && prop != FONT_FOUNDRY_INDEX
2997 && prop != FONT_SIZE_INDEX)
35027d0c
KH		 2998 return;
2999 font = Fcopy_font_spec (font);
3000 ASET (font, prop, Qnil);
4007dd1c 3001 if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
35027d0c 3002 {
4007dd1c
KH		 3003 if (prop == FONT_FAMILY_INDEX)
3004 ASET (font, FONT_FOUNDRY_INDEX, Qnil);
35027d0c 3005 ASET (font, FONT_ADSTYLE_INDEX, Qnil);
4007dd1c 3006 ASET (font, FONT_REGISTRY_INDEX, Qnil);
35027d0c
KH		 3007 ASET (font, FONT_SIZE_INDEX, Qnil);
3008 ASET (font, FONT_DPI_INDEX, Qnil);
3009 ASET (font, FONT_SPACING_INDEX, Qnil);
3010 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3011 }
3012 else if (prop == FONT_SIZE_INDEX)
3013 {
3014 ASET (font, FONT_DPI_INDEX, Qnil);
3015 ASET (font, FONT_SPACING_INDEX, Qnil);
3016 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3017 }
3018 attrs[LFACE_FONT_INDEX] = font;
3019}
3020
3021void
3022font_update_lface (f, attrs)
3023 FRAME_PTR f;
3024 Lisp_Object *attrs;
c2f5bfd6 3025{
d0ab1ebe 3026 Lisp_Object spec;
35027d0c
KH		 3027
3028 spec = attrs[LFACE_FONT_INDEX];
3029 if (! FONT_SPEC_P (spec))
3030 return;
3031
4007dd1c
KH		 3032 if (! NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
3033 attrs[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FOUNDRY_INDEX));
3034 if (! NILP (AREF (spec, FONT_FAMILY_INDEX)))
3035 attrs[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FAMILY_INDEX));
35027d0c
KH		 3036 if (! NILP (AREF (spec, FONT_WEIGHT_INDEX)))
3037 attrs[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (spec);
3038 if (! NILP (AREF (spec, FONT_SLANT_INDEX)))
3039 attrs[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (spec);;
3040 if (! NILP (AREF (spec, FONT_WIDTH_INDEX)))
3041 attrs[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (spec);
3042 if (! NILP (AREF (spec, FONT_SIZE_INDEX)))
3043 {
3044 int point;
3045
3046 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
3047 {
3048 Lisp_Object val;
3049 int dpi = f->resy;
3050
3051 val = Ffont_get (spec, QCdpi);
3052 if (! NILP (val))
3053 dpi = XINT (val);
3054 point = PIXEL_TO_POINT (XINT (AREF (spec, FONT_SIZE_INDEX)) * 10,
3055 dpi);
3056 }
3057 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
3058 point = XFLOAT_DATA (AREF (spec, FONT_SIZE_INDEX)) * 10;
3059 attrs[LFACE_HEIGHT_INDEX] = make_number (point);
3060 }
c2f5bfd6
KH		 3061}
3062
45eb10fb 3063
35027d0c
KH		 3064/* Return a font-entity satisfying SPEC and best matching with face's
3065 font related attributes in ATTRS. C, if not negative, is a
1701724c 3066 character that the entity must support. */
c2f5bfd6
KH		 3067
3068Lisp_Object
35027d0c 3069font_find_for_lface (f, attrs, spec, c)
c2f5bfd6 3070 FRAME_PTR f;
35027d0c 3071 Lisp_Object *attrs;
c2f5bfd6 3072 Lisp_Object spec;
1701724c 3073 int c;
c2f5bfd6 3074{
4007dd1c 3075 Lisp_Object work;
35027d0c 3076 Lisp_Object frame, entities, val, props[FONT_REGISTRY_INDEX + 1] ;
22459668 3077 Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
1d1e1245 3078 int pixel_size;
22459668 3079 int i, j, k, l, result;
d0a47776
KH		 3080
3081 registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
3082 if (NILP (registry[0]))
3083 {
edfda783 3084 registry[0] = DEFAULT_ENCODING;
d0a47776
KH		 3085 registry[1] = Qascii_0;
3086 registry[2] = null_vector;
3087 }
3088 else
3089 registry[1] = null_vector;
c2f5bfd6 3090
4007dd1c 3091 if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
fe5ddfbc 3092 {
35027d0c 3093 struct charset *encoding, *repertory;
1701724c 3094
4007dd1c
KH		 3095 if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
3096 &encoding, &repertory) < 0)
35027d0c
KH		 3097 return Qnil;
3098 if (repertory)
1701724c 3099 {
35027d0c 3100 if (ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
1701724c 3101 return Qnil;
35027d0c
KH		 3102 /* Any font of this registry support C. So, let's
3103 suppress the further checking. */
3104 c = -1;
1701724c 3105 }
35027d0c
KH		 3106 else if (c > encoding->max_char)
3107 return Qnil;
c2f5bfd6
KH		 3108 }
3109
4007dd1c 3110 work = Fcopy_font_spec (spec);
35027d0c
KH		 3111 XSETFRAME (frame, f);
3112 size = AREF (spec, FONT_SIZE_INDEX);
1d1e1245
KH		 3113 pixel_size = font_pixel_size (f, spec);
3114 if (pixel_size == 0)
3115 {
3116 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
3117
3118 pixel_size = POINT_TO_PIXEL (pt / 10, f->resy);
3119 }
4007dd1c
KH		 3120 ASET (work, FONT_SIZE_INDEX, Qnil);
3121 foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
3122 if (! NILP (foundry[0]))
3123 foundry[1] = null_vector;
3124 else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
3125 {
071132a9
KH		 3126 val = attrs[LFACE_FOUNDRY_INDEX];
3127 foundry[0] = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
4007dd1c
KH		 3128 foundry[1] = Qnil;
3129 foundry[2] = null_vector;
3130 }
3131 else
3132 foundry[0] = Qnil, foundry[1] = null_vector;
3133
22459668
KH		 3134 adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
3135 if (! NILP (adstyle[0]))
3136 adstyle[1] = null_vector;
3137 else if (FONTP (attrs[LFACE_FONT_INDEX]))
3138 {
3139 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3140
3141 if (! NILP (AREF (face_font, FONT_ADSTYLE_INDEX)))
3142 {
3143 adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
3144 adstyle[1] = Qnil;
3145 adstyle[2] = null_vector;
3146 }
3147 else
3148 adstyle[0] = Qnil, adstyle[1] = null_vector;
3149 }
3150 else
3151 adstyle[0] = Qnil, adstyle[1] = null_vector;
3152
3153
4007dd1c
KH		 3154 val = AREF (work, FONT_FAMILY_INDEX);
3155 if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
071132a9
KH		 3156 {
3157 val = attrs[LFACE_FAMILY_INDEX];
3158 val = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
3159 }
4007dd1c
KH		 3160 if (NILP (val))
3161 {
3162 family = alloca ((sizeof family[0]) * 2);
3163 family[0] = Qnil;
3164 family[1] = null_vector; /* terminator. */
3165 }
3166 else
3167 {
3168 Lisp_Object alters
3169 = Fassoc_string (val, Vface_alternative_font_family_alist, Qt);
3170
3171 if (! NILP (alters))
3172 {
3173 family = alloca ((sizeof family[0]) * (XINT (Flength (alters)) + 2));
3174 for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
3175 family[i] = XCAR (alters);
3176 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3177 family[i++] = Qnil;
3178 family[i] = null_vector;
3179 }
3180 else
3181 {
3182 family = alloca ((sizeof family[0]) * 3);
3183 i = 0;
3184 family[i++] = val;
3185 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3186 family[i++] = Qnil;
3187 family[i] = null_vector;
3188 }
3189 }
3190
d0a47776 3191 for (i = 0; SYMBOLP (family[i]); i++)
4007dd1c 3192 {
d0a47776
KH		 3193 ASET (work, FONT_FAMILY_INDEX, family[i]);
3194 for (j = 0; SYMBOLP (foundry[j]); j++)
4007dd1c 3195 {
d0a47776
KH		 3196 ASET (work, FONT_FOUNDRY_INDEX, foundry[j]);
3197 for (k = 0; SYMBOLP (registry[k]); k++)
3198 {
904a2e0e 3199 ASET (work, FONT_REGISTRY_INDEX, registry[k]);
22459668
KH		 3200 for (l = 0; SYMBOLP (adstyle[l]); l++)
3201 {
3202 ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
3203 entities = font_list_entities (frame, work);
3204 if (ASIZE (entities) > 0)
3205 goto found;
3206 }
d0a47776 3207 }
4007dd1c 3208 }
4007dd1c 3209 }
d0a47776
KH		 3210 return Qnil;
3211 found:
35027d0c
KH		 3212 if (ASIZE (entities) == 1)
3213 {
3214 if (c < 0)
3215 return AREF (entities, 0);
3216 }
3217 else
c2f5bfd6 3218 {
fe5ddfbc 3219 /* Sort fonts by properties specified in LFACE. */
ec6fe57c 3220 Lisp_Object prefer = scratch_font_prefer;
d0ab1ebe 3221
35027d0c 3222 for (i = 0; i < FONT_EXTRA_INDEX; i++)
4007dd1c 3223 ASET (prefer, i, AREF (work, i));
79f105c9
KH		 3224 if (FONTP (attrs[LFACE_FONT_INDEX]))
3225 {
3226 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3227
3228 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3229 if (NILP (AREF (prefer, i)))
3230 ASET (prefer, i, AREF (face_font, i));
3231 }
35027d0c
KH		 3232 if (NILP (AREF (prefer, FONT_WEIGHT_INDEX)))
3233 FONT_SET_STYLE (prefer, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
3234 if (NILP (AREF (prefer, FONT_SLANT_INDEX)))
3235 FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
3236 if (NILP (AREF (prefer, FONT_WIDTH_INDEX)))
3237 FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
1d1e1245 3238 ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size));
7181ea6a 3239 entities = font_sort_entites (entities, prefer, frame, c < 0);
c2f5bfd6 3240 }
1701724c 3241 if (c < 0)
35027d0c 3242 return entities;
45eb10fb 3243
35027d0c
KH		 3244 for (i = 0; i < ASIZE (entities); i++)
3245 {
3246 int j;
3247
3248 val = AREF (entities, i);
3249 if (i > 0)
3250 {
3251 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3252 if (! EQ (AREF (val, j), props[j]))
3253 break;
3254 if (j > FONT_REGISTRY_INDEX)
3255 continue;
3256 }
3257 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3258 props[j] = AREF (val, j);
3259 result = font_has_char (f, val, c);
3260 if (result > 0)
3261 return val;
3262 if (result == 0)
3263 return Qnil;
3264 val = font_open_for_lface (f, val, attrs, spec);
3265 if (NILP (val))
3266 continue;
3267 result = font_has_char (f, val, c);
3268 font_close_object (f, val);
3269 if (result > 0)
3270 return AREF (entities, i);
3271 }
1701724c
KH		 3272 return Qnil;
3273}
45eb10fb
KH		 3274
3275
c2f5bfd6 3276Lisp_Object
35027d0c 3277font_open_for_lface (f, entity, attrs, spec)
c2f5bfd6 3278 FRAME_PTR f;
c2f5bfd6 3279 Lisp_Object entity;
35027d0c 3280 Lisp_Object *attrs;
733fd013 3281 Lisp_Object spec;
c2f5bfd6 3282{
9331887d 3283 int size;
c2f5bfd6 3284
4007dd1c
KH		 3285 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX))
3286 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
3287 size = XINT (AREF (entity, FONT_SIZE_INDEX));
3288 else if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
1d1e1245 3289 size = font_pixel_size (f, spec);
733fd013
KH		 3290 else
3291 {
35027d0c 3292 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
733fd013
KH		 3293
3294 pt /= 10;
3295 size = POINT_TO_PIXEL (pt, f->resy);
ed96cde8
AR		 3296#ifdef HAVE_NS
3297 if (size == 0)
3298 {
3299 Lisp_Object ffsize = get_frame_param(f, Qfontsize);
3300 size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
3301 }
3302#endif
733fd013 3303 }
c2f5bfd6
KH		 3304 return font_open_entity (f, entity, size);
3305}
3306
45eb10fb 3307
35027d0c
KH		 3308/* Find a font satisfying SPEC and best matching with face's
3309 attributes in ATTRS on FRAME, and return the opened
3310 font-object. */
45eb10fb 3311
35027d0c
KH		 3312Lisp_Object
3313font_load_for_lface (f, attrs, spec)
c2f5bfd6 3314 FRAME_PTR f;
35027d0c 3315 Lisp_Object *attrs, spec;
c2f5bfd6 3316{
35027d0c 3317 Lisp_Object entity;
ef18374f 3318
35027d0c
KH		 3319 entity = font_find_for_lface (f, attrs, spec, -1);
3320 if (NILP (entity))
ef18374f 3321 {
35027d0c
KH		 3322 /* No font is listed for SPEC, but each font-backend may have
3323 the different criteria about "font matching". So, try
3324 it. */
3325 entity = font_matching_entity (f, attrs, spec);
3326 if (NILP (entity))
3327 return Qnil;
c2f5bfd6 3328 }
35027d0c 3329 return font_open_for_lface (f, entity, attrs, spec);
c2f5bfd6
KH		 3330}
3331
45eb10fb
KH		 3332
3333/* Make FACE on frame F ready to use the font opened for FACE. */
3334
c2f5bfd6
KH		 3335void
3336font_prepare_for_face (f, face)
3337 FRAME_PTR f;
3338 struct face *face;
3339{
35027d0c
KH		 3340 if (face->font->driver->prepare_face)
3341 face->font->driver->prepare_face (f, face);
c2f5bfd6
KH		 3342}
3343
45eb10fb
KH		 3344
3345/* Make FACE on frame F stop using the font opened for FACE. */
3346
c2f5bfd6
KH		 3347void
3348font_done_for_face (f, face)
3349 FRAME_PTR f;
3350 struct face *face;
3351{
35027d0c
KH		 3352 if (face->font->driver->done_face)
3353 face->font->driver->done_face (f, face);
c2f5bfd6
KH		 3354 face->extra = NULL;
3355}
3356
45eb10fb
KH		 3357
3358/* Open a font best matching with NAME on frame F. If no proper font
3359 is found, return Qnil. */
3360
c2f5bfd6
KH		 3361Lisp_Object
3362font_open_by_name (f, name)
3363 FRAME_PTR f;
3364 char *name;
3365{
ef18374f 3366 Lisp_Object args[2];
4007dd1c 3367 Lisp_Object spec, attrs[LFACE_VECTOR_SIZE];
a9262bb8 3368
ef18374f
KH		 3369 args[0] = QCname;
3370 args[1] = make_unibyte_string (name, strlen (name));
3371 spec = Ffont_spec (2, args);
4007dd1c
KH		 3372 /* We set up the default font-related attributes of a face to prefer
3373 a moderate font. */
3374 attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
3375 attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
3376 = attrs[LFACE_SLANT_INDEX] = Qnormal;
ed96cde8 3377#ifndef HAVE_NS
4007dd1c 3378 attrs[LFACE_HEIGHT_INDEX] = make_number (120);
ed96cde8
AR		 3379#else
3380 attrs[LFACE_HEIGHT_INDEX] = make_number (0);
3381#endif
4007dd1c
KH		 3382 attrs[LFACE_FONT_INDEX] = Qnil;
3383
3384 return font_load_for_lface (f, attrs, spec);
c2f5bfd6
KH		 3385}
3386
3387
3388/* Register font-driver DRIVER. This function is used in two ways.
3389
417a1b10
KH		 3390 The first is with frame F non-NULL. In this case, make DRIVER
3391 available (but not yet activated) on F. All frame creaters
3392 (e.g. Fx_create_frame) must call this function at least once with
3393 an available font-driver.
c2f5bfd6
KH		 3394
3395 The second is with frame F NULL. In this case, DRIVER is globally
3396 registered in the variable `font_driver_list'. All font-driver
3397 implementations must call this function in its syms_of_XXXX
3398 (e.g. syms_of_xfont). */
3399
3400void
3401register_font_driver (driver, f)
3402 struct font_driver *driver;
3403 FRAME_PTR f;
3404{
3405 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
3406 struct font_driver_list *prev, *list;
3407
3408 if (f && ! driver->draw)
43a1d19b 3409 error ("Unusable font driver for a frame: %s",
c2f5bfd6
KH		 3410 SDATA (SYMBOL_NAME (driver->type)));
3411
3412 for (prev = NULL, list = root; list; prev = list, list = list->next)
cf23b845 3413 if (EQ (list->driver->type, driver->type))
c2f5bfd6
KH		 3414 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
3415
3416 list = malloc (sizeof (struct font_driver_list));
417a1b10 3417 list->on = 0;
c2f5bfd6
KH		 3418 list->driver = driver;
3419 list->next = NULL;
3420 if (prev)
3421 prev->next = list;
3422 else if (f)
3423 f->font_driver_list = list;
3424 else
3425 font_driver_list = list;
72606e45
KH		 3426 if (! f)
3427 num_font_drivers++;
c2f5bfd6
KH		 3428}
3429
45eb10fb 3430
f697fff0 3431/* Make the frame F use font backends listed in NEW_DRIVERS (list of
ca4da08a
KH		 3432 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3433 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
417a1b10 3434
ca4da08a
KH		 3435 A caller must free all realized faces if any in advance. The
3436 return value is a list of font backends actually made used on
3437 F. */
e950d6f1
KH		 3438
3439Lisp_Object
3440font_update_drivers (f, new_drivers)
417a1b10
KH		 3441 FRAME_PTR f;
3442 Lisp_Object new_drivers;
417a1b10
KH		 3443{
3444 Lisp_Object active_drivers = Qnil;
4007dd1c 3445 struct font_driver *driver;
417a1b10
KH		 3446 struct font_driver_list *list;
3447
4007dd1c
KH		 3448 /* At first, turn off non-requested drivers, and turn on requested
3449 drivers. */
f697fff0 3450 for (list = f->font_driver_list; list; list = list->next)
4007dd1c
KH		 3451 {
3452 driver = list->driver;
3453 if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers)))
3454 != list->on)
3455 {
3456 if (list->on)
3457 {
3458 if (driver->end_for_frame)
3459 driver->end_for_frame (f);
3460 font_finish_cache (f, driver);
3461 list->on = 0;
3462 }
3463 else
3464 {
3465 if (! driver->start_for_frame
3466 || driver->start_for_frame (f) == 0)
3467 {
3468 font_prepare_cache (f, driver);
3469 list->on = 1;
3470 }
3471 }
3472 }
3473 }
3474
3475 if (NILP (new_drivers))
3476 return Qnil;
3477
3478 if (! EQ (new_drivers, Qt))
3479 {
3480 /* Re-order the driver list according to new_drivers. */
3306c6dc 3481 struct font_driver_list **list_table, **next;
4007dd1c
KH		 3482 Lisp_Object tail;
3483 int i;
3484
3485 list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
3486 for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
3487 {
3488 for (list = f->font_driver_list; list; list = list->next)
3489 if (list->on && EQ (list->driver->type, XCAR (tail)))
3490 break;
3491 if (list)
3492 list_table[i++] = list;
3493 }
3494 for (list = f->font_driver_list; list; list = list->next)
3495 if (! list->on)
3496 list_table[i] = list;
3497 list_table[i] = NULL;
3498
3306c6dc 3499 next = &f->font_driver_list;
4007dd1c
KH		 3500 for (i = 0; list_table[i]; i++)
3501 {
3306c6dc
AS		 3502 *next = list_table[i];
3503 next = &(*next)->next;
4007dd1c 3504 }
3306c6dc 3505 *next = NULL;
4007dd1c 3506 }
417a1b10 3507
4007dd1c
KH		 3508 for (list = f->font_driver_list; list; list = list->next)
3509 if (list->on)
3510 active_drivers = nconc2 (active_drivers,
3511 Fcons (list->driver->type, Qnil));
e950d6f1 3512 return active_drivers;
417a1b10
KH		 3513}
3514
f697fff0
KH		 3515int
3516font_put_frame_data (f, driver, data)
3517 FRAME_PTR f;
3518 struct font_driver *driver;
3519 void *data;
3520{
3521 struct font_data_list *list, *prev;
3522
3523 for (prev = NULL, list = f->font_data_list; list;
3524 prev = list, list = list->next)
3525 if (list->driver == driver)
3526 break;
3527 if (! data)
3528 {
3529 if (list)
3530 {
3531 if (prev)
3532 prev->next = list->next;
3533 else
3534 f->font_data_list = list->next;
3535 free (list);
3536 }
3537 return 0;
3538 }
3539
3540 if (! list)
3541 {
3542 list = malloc (sizeof (struct font_data_list));
3543 if (! list)
3544 return -1;
3545 list->driver = driver;
3546 list->next = f->font_data_list;
3547 f->font_data_list = list;
3548 }
3549 list->data = data;
3550 return 0;
3551}
3552
3553
3554void *
3555font_get_frame_data (f, driver)
3556 FRAME_PTR f;
3557 struct font_driver *driver;
3558{
3559 struct font_data_list *list;
3560
3561 for (list = f->font_data_list; list; list = list->next)
3562 if (list->driver == driver)
3563 break;
3564 if (! list)
3565 return NULL;
3566 return list->data;
3567}
3568
417a1b10 3569
45eb10fb 3570/* Return the font used to draw character C by FACE at buffer position
e3ee0340
KH		 3571 POS in window W. If STRING is non-nil, it is a string containing C
3572 at index POS. If C is negative, get C from the current buffer or
3573 STRING. */
45eb10fb 3574
10d16101 3575Lisp_Object
e3ee0340 3576font_at (c, pos, face, w, string)
10d16101
KH		 3577 int c;
3578 EMACS_INT pos;
3579 struct face *face;
3580 struct window *w;
e3ee0340 3581 Lisp_Object string;
10d16101
KH		 3582{
3583 FRAME_PTR f;
e3ee0340 3584 int multibyte;
35027d0c 3585 Lisp_Object font_object;
e3ee0340
KH		 3586
3587 if (c < 0)
3588 {
3589 if (NILP (string))
3590 {
3591 multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3592 if (multibyte)
3593 {
3594 EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
3595
3596 c = FETCH_CHAR (pos_byte);
3597 }
3598 else
3599 c = FETCH_BYTE (pos);
3600 }
3601 else
3602 {
3603 unsigned char *str;
3604
3605 multibyte = STRING_MULTIBYTE (string);
3606 if (multibyte)
3607 {
3608 EMACS_INT pos_byte = string_char_to_byte (string, pos);
3609
3610 str = SDATA (string) + pos_byte;
3611 c = STRING_CHAR (str, 0);
3612 }
3613 else
3614 c = SDATA (string)[pos];
3615 }
3616 }
10d16101
KH		 3617
3618 f = XFRAME (w->frame);
1385a806
KH		 3619 if (! FRAME_WINDOW_P (f))
3620 return Qnil;
10d16101
KH		 3621 if (! face)
3622 {
e3ee0340 3623 int face_id;
0f8b27ea 3624 EMACS_INT endptr;
e3ee0340
KH		 3625
3626 if (STRINGP (string))
3627 face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
10d16101
KH		 3628 DEFAULT_FACE_ID, 0);
3629 else
e3ee0340 3630 face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
10d16101
KH		 3631 pos + 100, 0);
3632 face = FACE_FROM_ID (f, face_id);
3633 }
e3ee0340
KH		 3634 if (multibyte)
3635 {
3636 int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
3637 face = FACE_FROM_ID (f, face_id);
3638 }
35027d0c 3639 if (! face->font)
10d16101 3640 return Qnil;
35027d0c 3641
35027d0c
KH		 3642 XSETFONT (font_object, face->font);
3643 return font_object;
3644}
3645
3646
071132a9
KH		 3647#ifdef HAVE_WINDOW_SYSTEM
3648
3649/* Check how many characters after POS (at most to *LIMIT) can be
3650 displayed by the same font on the window W. FACE, if non-NULL, is
3651 the face selected for the character at POS. If STRING is not nil,
3652 it is the string to check instead of the current buffer. In that
3653 case, FACE must be not NULL.
027a33c0 3654
071132a9
KH		 3655 The return value is the font-object for the character at POS.
3656 *LIMIT is set to the position where that font can't be used.
35027d0c 3657
071132a9
KH		 3658 It is assured that the current buffer (or STRING) is multibyte. */
3659
3660Lisp_Object
3661font_range (pos, limit, w, face, string)
3662 EMACS_INT pos, *limit;
3663 struct window *w;
35027d0c 3664 struct face *face;
35027d0c
KH		 3665 Lisp_Object string;
3666{
071132a9 3667 EMACS_INT pos_byte, ignore, start, start_byte;
35027d0c 3668 int c;
071132a9 3669 Lisp_Object font_object = Qnil;
35027d0c
KH		 3670
3671 if (NILP (string))
3672 {
35027d0c 3673 pos_byte = CHAR_TO_BYTE (pos);
071132a9
KH		 3674 if (! face)
3675 {
3676 int face_id;
3677
3678 face_id = face_at_buffer_position (w, pos, 0, 0, &ignore, *limit, 0);
3679 face = FACE_FROM_ID (XFRAME (w->frame), face_id);
3680 }
35027d0c
KH		 3681 }
3682 else
3683 {
071132a9 3684 font_assert (face);
35027d0c
KH		 3685 pos_byte = string_char_to_byte (string, pos);
3686 }
3687
071132a9
KH		 3688 start = pos, start_byte = pos_byte;
3689 while (pos < *limit)
35027d0c 3690 {
071132a9 3691 Lisp_Object category;
35027d0c
KH		 3692
3693 if (NILP (string))
3694 FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
3695 else
3696 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
071132a9 3697 if (NILP (font_object))
35027d0c 3698 {
071132a9
KH		 3699 font_object = font_for_char (face, c, pos - 1, string);
3700 if (NILP (font_object))
3701 return Qnil;
35027d0c
KH		 3702 continue;
3703 }
071132a9
KH		 3704
3705 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3706 if (! EQ (category, QCf)
3707 && font_encode_char (font_object, c) == FONT_INVALID_CODE)
35027d0c 3708 {
071132a9
KH		 3709 Lisp_Object f = font_for_char (face, c, pos - 1, string);
3710 EMACS_INT i, i_byte;
3711
3712
3713 if (NILP (f))
3714 {
3715 *limit = pos - 1;
3716 return font_object;
3717 }
3718 i = start, i_byte = start_byte;
3719 while (i < pos - 1)
3720 {
3721
3722 if (NILP (string))
3723 FETCH_CHAR_ADVANCE_NO_CHECK (c, i, i_byte);
3724 else
3725 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, i, i_byte);
3726 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3727 if (! EQ (category, QCf)
3728 && font_encode_char (f, c) == FONT_INVALID_CODE)
3729 {
3730 *limit = pos - 1;
3731 return font_object;
3732 }
3733 }
3734 font_object = f;
35027d0c
KH		 3735 }
3736 }
071132a9 3737 return font_object;
10d16101 3738}
071132a9 3739#endif
10d16101 3740
c2f5bfd6
KH		 3741\f
3742/* Lisp API */
3743
35027d0c 3744DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
6c8ec042 3745 doc: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
35027d0c
KH		 3746Return nil otherwise.
3747Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
027a33c0 3748which kind of font it is. It must be one of `font-spec', `font-entity',
35027d0c
KH		 3749`font-object'. */)
3750 (object, extra_type)
3751 Lisp_Object object, extra_type;
c2f5bfd6 3752{
35027d0c
KH		 3753 if (NILP (extra_type))
3754 return (FONTP (object) ? Qt : Qnil);
3755 if (EQ (extra_type, Qfont_spec))
3756 return (FONT_SPEC_P (object) ? Qt : Qnil);
3757 if (EQ (extra_type, Qfont_entity))
3758 return (FONT_ENTITY_P (object) ? Qt : Qnil);
3759 if (EQ (extra_type, Qfont_object))
3760 return (FONT_OBJECT_P (object) ? Qt : Qnil);
3761 wrong_type_argument (intern ("font-extra-type"), extra_type);
c2f5bfd6
KH		 3762}
3763
3764DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
45eb10fb
KH		 3765 doc: /* Return a newly created font-spec with arguments as properties.
3766
3767ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3768valid font property name listed below:
3769
3770`:family', `:weight', `:slant', `:width'
3771
3772They are the same as face attributes of the same name. See
51c01100 3773`set-face-attribute'.
45eb10fb
KH		 3774
3775`:foundry'
3776
3777VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3778
3779`:adstyle'
3780
3781VALUE must be a string or a symbol specifying the additional
35027d0c 3782typographic style information of a font, e.g. ``sans''.
45eb10fb
KH		 3783
3784`:registry'
3785
3786VALUE must be a string or a symbol specifying the charset registry and
3787encoding of a font, e.g. ``iso8859-1''.
3788
3789`:size'
3790
3791VALUE must be a non-negative integer or a floating point number
35027d0c 3792specifying the font size. It specifies the font size in pixels
f697fff0 3793(if VALUE is an integer), or in points (if VALUE is a float).
2babb359
KH		 3794
3795`:name'
3796
7a18a178
JB		 3797VALUE must be a string of XLFD-style or fontconfig-style font name.
3798usage: (font-spec ARGS ...) */)
c2f5bfd6
KH		 3799 (nargs, args)
3800 int nargs;
3801 Lisp_Object *args;
3802{
35027d0c 3803 Lisp_Object spec = font_make_spec ();
c2f5bfd6
KH		 3804 int i;
3805
3806 for (i = 0; i < nargs; i += 2)
3807 {
c2f5bfd6
KH		 3808 Lisp_Object key = args[i], val = args[i + 1];
3809
35027d0c
KH		 3810 if (EQ (key, QCname))
3811 {
3812 CHECK_STRING (val);
3813 font_parse_name ((char *) SDATA (val), spec);
3814 font_put_extra (spec, key, val);
3815 }
c2f5bfd6 3816 else
4485a28e 3817 {
35027d0c
KH		 3818 int idx = get_font_prop_index (key);
3819
3820 if (idx >= 0)
ec6fe57c 3821 {
35027d0c
KH		 3822 val = font_prop_validate (idx, Qnil, val);
3823 if (idx < FONT_EXTRA_INDEX)
3824 ASET (spec, idx, val);
3825 else
3826 font_put_extra (spec, key, val);
ec6fe57c 3827 }
35027d0c
KH		 3828 else
3829 font_put_extra (spec, key, font_prop_validate (0, key, val));
4485a28e 3830 }
e950d6f1 3831 }
c2f5bfd6
KH		 3832 return spec;
3833}
3834
35027d0c
KH		 3835DEFUN ("copy-font-spec", Fcopy_font_spec, Scopy_font_spec, 1, 1, 0,
3836 doc: /* Return a copy of FONT as a font-spec. */)
3837 (font)
3838 Lisp_Object font;
3839{
d26424c5 3840 Lisp_Object new_spec, tail, prev, extra;
35027d0c
KH		 3841 int i;
3842
3843 CHECK_FONT (font);
3844 new_spec = font_make_spec ();
3845 for (i = 1; i < FONT_EXTRA_INDEX; i++)
3846 ASET (new_spec, i, AREF (font, i));
d26424c5
KH		 3847 extra = Fcopy_sequence (AREF (font, FONT_EXTRA_INDEX));
3848 /* We must remove :font-entity property. */
3849 for (prev = Qnil, tail = extra; CONSP (tail); prev = tail, tail = XCDR (tail))
3850 if (EQ (XCAR (XCAR (tail)), QCfont_entity))
3851 {
3852 if (NILP (prev))
3853 extra = XCDR (extra);
3854 else
3855 XSETCDR (prev, XCDR (tail));
3856 break;
3857 }
35027d0c
KH		 3858 ASET (new_spec, FONT_EXTRA_INDEX, extra);
3859 return new_spec;
3860}
3861
3862DEFUN ("merge-font-spec", Fmerge_font_spec, Smerge_font_spec, 2, 2, 0,
3863 doc: /* Merge font-specs FROM and TO, and return a new font-spec.
3864Every specified properties in FROM override the corresponding
3865properties in TO. */)
3866 (from, to)
3867 Lisp_Object from, to;
3868{
3869 Lisp_Object extra, tail;
3870 int i;
3871
3872 CHECK_FONT (from);
3873 CHECK_FONT (to);
3874 to = Fcopy_font_spec (to);
3875 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3876 ASET (to, i, AREF (from, i));
3877 extra = AREF (to, FONT_EXTRA_INDEX);
3878 for (tail = AREF (from, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
3879 if (! EQ (XCAR (XCAR (tail)), Qfont_entity))
3880 {
3881 Lisp_Object slot = assq_no_quit (XCAR (XCAR (tail)), extra);
3882
3883 if (! NILP (slot))
3884 XSETCDR (slot, XCDR (XCAR (tail)));
3885 else
3886 extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
3887 }
3888 ASET (to, FONT_EXTRA_INDEX, extra);
3889 return to;
3890}
c2f5bfd6
KH		 3891
3892DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
45eb10fb 3893 doc: /* Return the value of FONT's property KEY.
e950d6f1 3894FONT is a font-spec, a font-entity, or a font-object. */)
45eb10fb
KH		 3895 (font, key)
3896 Lisp_Object font, key;
c2f5bfd6 3897{
35027d0c 3898 int idx;
c2f5bfd6 3899
35027d0c
KH		 3900 CHECK_FONT (font);
3901 CHECK_SYMBOL (key);
e80e09b4 3902
35027d0c 3903 idx = get_font_prop_index (key);
2babb359
KH		 3904 if (idx >= FONT_WEIGHT_INDEX && idx <= FONT_WIDTH_INDEX)
3905 return font_style_symbolic (font, idx, 0);
35027d0c 3906 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
c2f5bfd6 3907 return AREF (font, idx);
35027d0c 3908 return Fcdr (Fassq (key, AREF (font, FONT_EXTRA_INDEX)));
c2f5bfd6
KH		 3909}
3910
51cf11be
AS		 3911#ifdef HAVE_WINDOW_SYSTEM
3912
b1868a1a
CY		 3913DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1, 2, 0,
3914 doc: /* Return a plist of face attributes generated by FONT.
3915FONT is a font name, a font-spec, a font-entity, or a font-object.
3916The return value is a list of the form
3917
6f568955 3918\(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
b1868a1a 3919
48105a6a 3920where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
5989ba2f
CY		 3921compatible with `set-face-attribute'. Some of these key-attribute pairs
3922may be omitted from the list if they are not specified by FONT.
b1868a1a 3923
48105a6a
JB		 3924The optional argument FRAME specifies the frame that the face attributes
3925are to be displayed on. If omitted, the selected frame is used. */)
b1868a1a 3926 (font, frame)
6f568955 3927 Lisp_Object font, frame;
b1868a1a
CY		 3928{
3929 struct frame *f;
3930 Lisp_Object plist[10];
3931 Lisp_Object val;
5989ba2f 3932 int n = 0;
b1868a1a
CY		 3933
3934 if (NILP (frame))
3935 frame = selected_frame;
3936 CHECK_LIVE_FRAME (frame);
3937 f = XFRAME (frame);
3938
3939 if (STRINGP (font))
3940 {
3941 int fontset = fs_query_fontset (font, 0);
3942 Lisp_Object name = font;
3943 if (fontset >= 0)
3944 font = fontset_ascii (fontset);
3945 font = font_spec_from_name (name);
3946 if (! FONTP (font))
3947 signal_error ("Invalid font name", name);
3948 }
3949 else if (! FONTP (font))
3950 signal_error ("Invalid font object", font);
3951
b1868a1a 3952 val = AREF (font, FONT_FAMILY_INDEX);
5989ba2f
CY		 3953 if (! NILP (val))
3954 {
3955 plist[n++] = QCfamily;
3956 plist[n++] = SYMBOL_NAME (val);
3957 }
b1868a1a 3958
b1868a1a
CY		 3959 val = AREF (font, FONT_SIZE_INDEX);
3960 if (INTEGERP (val))
3961 {
3962 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
3963 int dpi = INTEGERP (font_dpi) ? XINT (font_dpi) : f->resy;
5989ba2f 3964 plist[n++] = QCheight;
c3bb5465 3965 plist[n++] = make_number (PIXEL_TO_POINT (XINT (val) * 10, dpi));
b1868a1a
CY		 3966 }
3967 else if (FLOATP (val))
5989ba2f
CY		 3968 {
3969 plist[n++] = QCheight;
3970 plist[n++] = make_number (10 * (int) XFLOAT_DATA (val));
3971 }
b1868a1a 3972
b1868a1a 3973 val = FONT_WEIGHT_FOR_FACE (font);
5989ba2f
CY		 3974 if (! NILP (val))
3975 {
3976 plist[n++] = QCweight;
3977 plist[n++] = val;
3978 }
b1868a1a 3979
b1868a1a 3980 val = FONT_SLANT_FOR_FACE (font);
5989ba2f
CY		 3981 if (! NILP (val))
3982 {
3983 plist[n++] = QCslant;
3984 plist[n++] = val;
3985 }
b1868a1a 3986
b1868a1a 3987 val = FONT_WIDTH_FOR_FACE (font);
5989ba2f
CY		 3988 if (! NILP (val))
3989 {
3990 plist[n++] = QCwidth;
3991 plist[n++] = val;
3992 }
b1868a1a 3993
5989ba2f 3994 return Flist (n, plist);
b1868a1a 3995}
c2f5bfd6 3996
51cf11be
AS		 3997#endif
3998
c2f5bfd6 3999DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
51c01100 4000 doc: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
c2f5bfd6
KH		 4001 (font_spec, prop, val)
4002 Lisp_Object font_spec, prop, val;
4003{
35027d0c 4004 int idx;
c2f5bfd6
KH		 4005
4006 CHECK_FONT_SPEC (font_spec);
35027d0c
KH		 4007 idx = get_font_prop_index (prop);
4008 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
69eb9e8b 4009 ASET (font_spec, idx, font_prop_validate (idx, Qnil, val));
c2f5bfd6 4010 else
35027d0c 4011 font_put_extra (font_spec, prop, font_prop_validate (0, prop, val));
c2f5bfd6
KH		 4012 return val;
4013}
4014
4015DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
4016 doc: /* List available fonts matching FONT-SPEC on the current frame.
4017Optional 2nd argument FRAME specifies the target frame.
4018Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
45eb10fb
KH		 4019Optional 4th argument PREFER, if non-nil, is a font-spec to
4020control the order of the returned list. Fonts are sorted by
027a33c0 4021how close they are to PREFER. */)
c2f5bfd6
KH		 4022 (font_spec, frame, num, prefer)
4023 Lisp_Object font_spec, frame, num, prefer;
4024{
4025 Lisp_Object vec, list, tail;
4026 int n = 0, i, len;
4027
4028 if (NILP (frame))
4029 frame = selected_frame;
4030 CHECK_LIVE_FRAME (frame);
35027d0c 4031 CHECK_FONT_SPEC (font_spec);
c2f5bfd6
KH		 4032 if (! NILP (num))
4033 {
4034 CHECK_NUMBER (num);
4035 n = XINT (num);
4036 if (n <= 0)
4037 return Qnil;
4038 }
4039 if (! NILP (prefer))
35027d0c 4040 CHECK_FONT_SPEC (prefer);
c2f5bfd6
KH		 4041
4042 vec = font_list_entities (frame, font_spec);
4043 len = ASIZE (vec);
4044 if (len == 0)
4045 return Qnil;
4046 if (len == 1)
4047 return Fcons (AREF (vec, 0), Qnil);
4048
4049 if (! NILP (prefer))
7181ea6a 4050 vec = font_sort_entites (vec, prefer, frame, 0);
c2f5bfd6
KH		 4051
4052 list = tail = Fcons (AREF (vec, 0), Qnil);
4053 if (n == 0 || n > len)
4054 n = len;
4055 for (i = 1; i < n; i++)
4056 {
4057 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
4058
4059 XSETCDR (tail, val);
4060 tail = val;
4061 }
4062 return list;
4063}
4064
35027d0c 4065DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
c2f5bfd6 4066 doc: /* List available font families on the current frame.
027a33c0 4067Optional argument FRAME, if non-nil, specifies the target frame. */)
c2f5bfd6
KH		 4068 (frame)
4069 Lisp_Object frame;
4070{
4071 FRAME_PTR f;
4072 struct font_driver_list *driver_list;
4073 Lisp_Object list;
4074
4075 if (NILP (frame))
4076 frame = selected_frame;
4077 CHECK_LIVE_FRAME (frame);
4078 f = XFRAME (frame);
4079 list = Qnil;
4080 for (driver_list = f->font_driver_list; driver_list;
4081 driver_list = driver_list->next)
4082 if (driver_list->driver->list_family)
4083 {
4084 Lisp_Object val = driver_list->driver->list_family (frame);
4085
4086 if (NILP (list))
4087 list = val;
4088 else
4089 {
4090 Lisp_Object tail = list;
4091
4092 for (; CONSP (val); val = XCDR (val))
4093 if (NILP (Fmemq (XCAR (val), tail)))
4094 list = Fcons (XCAR (val), list);
4095 }
4096 }
4097 return list;
4098}
4099
4100DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
4101 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
4102Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4103 (font_spec, frame)
4104 Lisp_Object font_spec, frame;
4105{
4106 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
4107
4108 if (CONSP (val))
4109 val = XCAR (val);
4110 return val;
4111}
4112
d0ab1ebe 4113DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
c2f5bfd6
KH		 4114 doc: /* Return XLFD name of FONT.
4115FONT is a font-spec, font-entity, or font-object.
d0ab1ebe
KH		 4116If the name is too long for XLFD (maximum 255 chars), return nil.
4117If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4118the consecutive wildcards are folded to one. */)
4119 (font, fold_wildcards)
4120 Lisp_Object font, fold_wildcards;
c2f5bfd6
KH		 4121{
4122 char name[256];
4123 int pixel_size = 0;
4124
35027d0c
KH		 4125 CHECK_FONT (font);
4126
4127 if (FONT_OBJECT_P (font))
c2f5bfd6 4128 {
35027d0c 4129 Lisp_Object font_name = AREF (font, FONT_NAME_INDEX);
c2f5bfd6 4130
35027d0c
KH		 4131 if (STRINGP (font_name)
4132 && SDATA (font_name)[0] == '-')
d0ab1ebe
KH		 4133 {
4134 if (NILP (fold_wildcards))
4135 return font_name;
4136 strcpy (name, (char *) SDATA (font_name));
4137 goto done;
4138 }
35027d0c 4139 pixel_size = XFONT_OBJECT (font)->pixel_size;
c2f5bfd6 4140 }
c2f5bfd6
KH		 4141 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
4142 return Qnil;
d0ab1ebe
KH		 4143 done:
4144 if (! NILP (fold_wildcards))
4145 {
4146 char *p0 = name, *p1;
4147
4148 while ((p1 = strstr (p0, "-*-*")))
4149 {
4150 strcpy (p1, p1 + 2);
4151 p0 = p1;
4152 }
4153 }
4154
c2f5bfd6
KH		 4155 return build_string (name);
4156}
4157
4158DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
4159 doc: /* Clear font cache. */)
4160 ()
4161{
4162 Lisp_Object list, frame;
4163
4164 FOR_EACH_FRAME (list, frame)
4165 {
4166 FRAME_PTR f = XFRAME (frame);
4167 struct font_driver_list *driver_list = f->font_driver_list;
4168
4169 for (; driver_list; driver_list = driver_list->next)
417a1b10
KH		 4170 if (driver_list->on)
4171 {
ca4da08a
KH		 4172 Lisp_Object cache = driver_list->driver->get_cache (f);
4173 Lisp_Object val;
51c01100 4174
ca4da08a 4175 val = XCDR (cache);
43c0454d
KH		 4176 while (! NILP (val)
4177 && ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
ca4da08a 4178 val = XCDR (val);
d0ab1ebe 4179 font_assert (! NILP (val));
ca4da08a
KH		 4180 val = XCDR (XCAR (val));
4181 if (XINT (XCAR (val)) == 0)
417a1b10 4182 {
ca4da08a
KH		 4183 font_clear_cache (f, XCAR (val), driver_list->driver);
4184 XSETCDR (cache, XCDR (val));
417a1b10 4185 }
417a1b10 4186 }
c2f5bfd6
KH		 4187 }
4188
4189 return Qnil;
4190}
4191
071132a9
KH		 4192\f
4193void
4194font_fill_lglyph_metrics (glyph, font_object)
4195 Lisp_Object glyph, font_object;
c2f5bfd6 4196{
071132a9 4197 struct font *font = XFONT_OBJECT (font_object);
f62ab7c5
EZ		 4198 unsigned code;
4199 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4200 EMACS_INT ecode = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
071132a9 4201 struct font_metrics metrics;
c2f5bfd6 4202
f62ab7c5
EZ		 4203 LGLYPH_SET_CODE (glyph, ecode);
4204 code = ecode;
071132a9
KH		 4205 font->driver->text_extents (font, &code, 1, &metrics);
4206 LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
4207 LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
4208 LGLYPH_SET_WIDTH (glyph, metrics.width);
4209 LGLYPH_SET_ASCENT (glyph, metrics.ascent);
4210 LGLYPH_SET_DESCENT (glyph, metrics.descent);
c2f5bfd6
KH		 4211}
4212
c2f5bfd6 4213
071132a9
KH		 4214DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0,
4215 doc: /* Shape the glyph-string GSTRING.
4216Shaping means substituting glyphs and/or adjusting positions of glyphs
4217to get the correct visual image of character sequences set in the
4218header of the glyph-string.
1701724c 4219
071132a9
KH		 4220If the shaping was successful, the value is GSTRING itself or a newly
4221created glyph-string. Otherwise, the value is nil. */)
4222 (gstring)
4223 Lisp_Object gstring;
1701724c
KH		 4224{
4225 struct font *font;
071132a9 4226 Lisp_Object font_object, n, glyph;
fc3a285e 4227 int i, j, from, to;
071132a9
KH		 4228
4229 if (! composition_gstring_p (gstring))
4230 signal_error ("Invalid glyph-string: ", gstring);
4231 if (! NILP (LGSTRING_ID (gstring)))
4232 return gstring;
4233 font_object = LGSTRING_FONT (gstring);
4234 CHECK_FONT_OBJECT (font_object);
35027d0c 4235 font = XFONT_OBJECT (font_object);
b876ea91
KH		 4236 if (! font->driver->shape)
4237 return Qnil;
4238
40fb53d6
KH		 4239 /* Try at most three times with larger gstring each time. */
4240 for (i = 0; i < 3; i++)
4241 {
40fb53d6
KH		 4242 n = font->driver->shape (gstring);
4243 if (INTEGERP (n))
4244 break;
071132a9
KH		 4245 gstring = larger_vector (gstring,
4246 ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
4247 Qnil);
40fb53d6 4248 }
071132a9 4249 if (i == 3 || XINT (n) == 0)
1701724c 4250 return Qnil;
071132a9
KH		 4251
4252 glyph = LGSTRING_GLYPH (gstring, 0);
fc3a285e
KH		 4253 from = LGLYPH_FROM (glyph);
4254 to = LGLYPH_TO (glyph);
4255 for (i = 1, j = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
071132a9
KH		 4256 {
4257 Lisp_Object this = LGSTRING_GLYPH (gstring, i);
10d16101 4258
071132a9
KH		 4259 if (NILP (this))
4260 break;
4261 if (NILP (LGLYPH_ADJUSTMENT (this)))
fc3a285e
KH		 4262 {
4263 if (j < i - 1)
4264 for (; j < i; j++)
4265 {
4266 glyph = LGSTRING_GLYPH (gstring, j);
4267 LGLYPH_SET_FROM (glyph, from);
4268 LGLYPH_SET_TO (glyph, to);
4269 }
4270 from = LGLYPH_FROM (this);
4271 to = LGLYPH_TO (this);
4272 j = i;
4273 }
071132a9 4274 else
b2937119 4275 {
fc3a285e
KH		 4276 if (from > LGLYPH_FROM (this))
4277 from = LGLYPH_FROM (this);
4278 if (to < LGLYPH_TO (this))
4279 to = LGLYPH_TO (this);
b2937119 4280 }
10d16101 4281 }
fc3a285e
KH		 4282 if (j < i - 1)
4283 for (; j < i; j++)
4284 {
4285 glyph = LGSTRING_GLYPH (gstring, j);
4286 LGLYPH_SET_FROM (glyph, from);
4287 LGLYPH_SET_TO (glyph, to);
4288 }
071132a9 4289 return composition_gstring_put_cache (gstring, XINT (n));
c2f5bfd6
KH		 4290}
4291
6a3dadd2
KH		 4292#if 0
4293
733fd013
KH		 4294DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
4295 doc: /* Apply OpenType features on glyph-string GSTRING-IN.
51c01100 4296OTF-FEATURES specifies which features to apply in this format:
733fd013 4297 (SCRIPT LANGSYS GSUB GPOS)
e80e09b4
KH		 4298where
4299 SCRIPT is a symbol specifying a script tag of OpenType,
4300 LANGSYS is a symbol specifying a langsys tag of OpenType,
733fd013 4301 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
e80e09b4
KH		 4302
4303If LANGYS is nil, the default langsys is selected.
4304
51c01100
JB		 4305The features are applied in the order they appear in the list. The
4306symbol `*' means to apply all available features not present in this
733fd013
KH		 4307list, and the remaining features are ignored. For instance, (vatu
4308pstf * haln) is to apply vatu and pstf in this order, then to apply
4309all available features other than vatu, pstf, and haln.
e80e09b4
KH		 4310
4311The features are applied to the glyphs in the range FROM and TO of
733fd013 4312the glyph-string GSTRING-IN.
e80e09b4 4313
51c01100 4314If some feature is actually applicable, the resulting glyphs are
e80e09b4
KH		 4315produced in the glyph-string GSTRING-OUT from the index INDEX. In
4316this case, the value is the number of produced glyphs.
4317
4318If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4319the value is 0.
4320
51c01100 4321If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
e80e09b4
KH		 4322produced in GSTRING-OUT, and the value is nil.
4323
4324See the documentation of `font-make-gstring' for the format of
4325glyph-string. */)
733fd013
KH		 4326 (otf_features, gstring_in, from, to, gstring_out, index)
4327 Lisp_Object otf_features, gstring_in, from, to, gstring_out, index;
e80e09b4
KH		 4328{
4329 Lisp_Object font_object = LGSTRING_FONT (gstring_in);
733fd013
KH		 4330 Lisp_Object val;
4331 struct font *font;
e80e09b4
KH		 4332 int len, num;
4333
733fd013 4334 check_otf_features (otf_features);
35027d0c
KH		 4335 CHECK_FONT_OBJECT (font_object);
4336 font = XFONT_OBJECT (font_object);
733fd013 4337 if (! font->driver->otf_drive)
e80e09b4
KH		 4338 error ("Font backend %s can't drive OpenType GSUB table",
4339 SDATA (SYMBOL_NAME (font->driver->type)));
733fd013
KH		 4340 CHECK_CONS (otf_features);
4341 CHECK_SYMBOL (XCAR (otf_features));
4342 val = XCDR (otf_features);
4343 CHECK_SYMBOL (XCAR (val));
4344 val = XCDR (otf_features);
4345 if (! NILP (val))
4346 CHECK_CONS (val);
e80e09b4
KH		 4347 len = check_gstring (gstring_in);
4348 CHECK_VECTOR (gstring_out);
4349 CHECK_NATNUM (from);
4350 CHECK_NATNUM (to);
4351 CHECK_NATNUM (index);
4352
4353 if (XINT (from) >= XINT (to) || XINT (to) > len)
4354 args_out_of_range_3 (from, to, make_number (len));
4355 if (XINT (index) >= ASIZE (gstring_out))
4356 args_out_of_range (index, make_number (ASIZE (gstring_out)));
733fd013
KH		 4357 num = font->driver->otf_drive (font, otf_features,
4358 gstring_in, XINT (from), XINT (to),
4359 gstring_out, XINT (index), 0);
e80e09b4
KH		 4360 if (num < 0)
4361 return Qnil;
4362 return make_number (num);
4363}
4364
e80e09b4
KH		 4365DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
4366 3, 3, 0,
4367 doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
51c01100 4368OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
e80e09b4
KH		 4369in this format:
4370 (SCRIPT LANGSYS FEATURE ...)
027a33c0 4371See the documentation of `font-drive-otf' for more detail.
e80e09b4
KH		 4372
4373The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4374where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4375character code corresponding to the glyph or nil if there's no
4376corresponding character. */)
733fd013
KH		 4377 (font_object, character, otf_features)
4378 Lisp_Object font_object, character, otf_features;
e80e09b4
KH		 4379{
4380 struct font *font;
4381 Lisp_Object gstring_in, gstring_out, g;
4382 Lisp_Object alternates;
4383 int i, num;
4384
4385 CHECK_FONT_GET_OBJECT (font_object, font);
733fd013 4386 if (! font->driver->otf_drive)
e950d6f1
KH		 4387 error ("Font backend %s can't drive OpenType GSUB table",
4388 SDATA (SYMBOL_NAME (font->driver->type)));
e80e09b4 4389 CHECK_CHARACTER (character);
733fd013 4390 CHECK_CONS (otf_features);
e80e09b4
KH		 4391
4392 gstring_in = Ffont_make_gstring (font_object, make_number (1));
4393 g = LGSTRING_GLYPH (gstring_in, 0);
f9ffa1ea 4394 LGLYPH_SET_CHAR (g, XINT (character));
e80e09b4 4395 gstring_out = Ffont_make_gstring (font_object, make_number (10));
733fd013
KH		 4396 while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
4397 gstring_out, 0, 1)) < 0)
e80e09b4
KH		 4398 gstring_out = Ffont_make_gstring (font_object,
4399 make_number (ASIZE (gstring_out) * 2));
4400 alternates = Qnil;
4401 for (i = 0; i < num; i++)
4402 {
4403 Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
f9ffa1ea
SM		 4404 int c = LGLYPH_CHAR (g);
4405 unsigned code = LGLYPH_CODE (g);
e80e09b4
KH		 4406
4407 alternates = Fcons (Fcons (make_number (code),
4408 c > 0 ? make_number (c) : Qnil),
4409 alternates);
4410 }
4411 return Fnreverse (alternates);
4412}
6a3dadd2 4413#endif /* 0 */
c2f5bfd6
KH		 4414
4415#ifdef FONT_DEBUG
4416
4417DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
4418 doc: /* Open FONT-ENTITY. */)
4419 (font_entity, size, frame)
4420 Lisp_Object font_entity;
4421 Lisp_Object size;
4422 Lisp_Object frame;
4423{
4424 int isize;
4425
4426 CHECK_FONT_ENTITY (font_entity);
c2f5bfd6
KH		 4427 if (NILP (frame))
4428 frame = selected_frame;
4429 CHECK_LIVE_FRAME (frame);
51c01100 4430
35027d0c
KH		 4431 if (NILP (size))
4432 isize = XINT (AREF (font_entity, FONT_SIZE_INDEX));
4433 else
4434 {
4435 CHECK_NUMBER_OR_FLOAT (size);
4436 if (FLOATP (size))
4437 isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
4438 else
4439 isize = XINT (size);
4440 if (isize == 0)
4441 isize = 120;
4442 }
c2f5bfd6
KH		 4443 return font_open_entity (XFRAME (frame), font_entity, isize);
4444}
4445
4446DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
4447 doc: /* Close FONT-OBJECT. */)
4448 (font_object, frame)
4449 Lisp_Object font_object, frame;
4450{
4451 CHECK_FONT_OBJECT (font_object);
4452 if (NILP (frame))
4453 frame = selected_frame;
4454 CHECK_LIVE_FRAME (frame);
4455 font_close_object (XFRAME (frame), font_object);
4456 return Qnil;
4457}
4458
4459DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
e80e09b4
KH		 4460 doc: /* Return information about FONT-OBJECT.
4461The value is a vector:
4462 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
e0708580 4463 CAPABILITY ]
e80e09b4
KH		 4464
4465NAME is a string of the font name (or nil if the font backend doesn't
4466provide a name).
4467
4468FILENAME is a string of the font file (or nil if the font backend
4469doesn't provide a file name).
4470
4471PIXEL-SIZE is a pixel size by which the font is opened.
4472
027a33c0 4473SIZE is a maximum advance width of the font in pixels.
e80e09b4
KH		 4474
4475ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
027a33c0 4476pixels.
e80e09b4 4477
e0708580
KH		 4478CAPABILITY is a list whose first element is a symbol representing the
4479font format \(x, opentype, truetype, type1, pcf, or bdf) and the
027a33c0 4480remaining elements describe the details of the font capability.
e0708580
KH		 4481
4482If the font is OpenType font, the form of the list is
4483 \(opentype GSUB GPOS)
4484where GSUB shows which "GSUB" features the font supports, and GPOS
4485shows which "GPOS" features the font supports. Both GSUB and GPOS are
4486lists of the format:
4487 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4488
4489If the font is not OpenType font, currently the length of the form is
4490one.
e80e09b4
KH		 4491
4492SCRIPT is a symbol representing OpenType script tag.
4493
4494LANGSYS is a symbol representing OpenType langsys tag, or nil
4495representing the default langsys.
4496
51c01100 4497FEATURE is a symbol representing OpenType feature tag.
e80e09b4 4498
51c01100 4499If the font is not OpenType font, CAPABILITY is nil. */)
c2f5bfd6
KH		 4500 (font_object)
4501 Lisp_Object font_object;
4502{
4503 struct font *font;
4504 Lisp_Object val;
4505
4506 CHECK_FONT_GET_OBJECT (font_object, font);
4507
4508 val = Fmake_vector (make_number (9), Qnil);
35027d0c
KH		 4509 ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
4510 ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
c2f5bfd6 4511 ASET (val, 2, make_number (font->pixel_size));
35027d0c 4512 ASET (val, 3, make_number (font->max_width));
c2f5bfd6
KH		 4513 ASET (val, 4, make_number (font->ascent));
4514 ASET (val, 5, make_number (font->descent));
35027d0c
KH		 4515 ASET (val, 6, make_number (font->space_width));
4516 ASET (val, 7, make_number (font->average_width));
c2f5bfd6 4517 if (font->driver->otf_capability)
e0708580 4518 ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
c2f5bfd6
KH		 4519 return val;
4520}
4521
4522DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
4523 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4524Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4525 (font_object, string)
4526 Lisp_Object font_object, string;
4527{
4528 struct font *font;
4529 int i, len;
4530 Lisp_Object vec;
4531
4532 CHECK_FONT_GET_OBJECT (font_object, font);
4533 CHECK_STRING (string);
4534 len = SCHARS (string);
4535 vec = Fmake_vector (make_number (len), Qnil);
4536 for (i = 0; i < len; i++)
4537 {
4538 Lisp_Object ch = Faref (string, make_number (i));
4539 Lisp_Object val;
4540 int c = XINT (ch);
4541 unsigned code;
2930d117 4542 EMACS_INT cod;
c2f5bfd6
KH		 4543 struct font_metrics metrics;
4544
2930d117 4545 cod = code = font->driver->encode_char (font, c);
c2f5bfd6
KH		 4546 if (code == FONT_INVALID_CODE)
4547 continue;
4548 val = Fmake_vector (make_number (6), Qnil);
2930d117 4549 if (cod <= MOST_POSITIVE_FIXNUM)
c2f5bfd6
KH		 4550 ASET (val, 0, make_number (code));
4551 else
4552 ASET (val, 0, Fcons (make_number (code >> 16),
4553 make_number (code & 0xFFFF)));
51c01100 4554 font->driver->text_extents (font, &code, 1, &metrics);
c2f5bfd6
KH		 4555 ASET (val, 1, make_number (metrics.lbearing));
4556 ASET (val, 2, make_number (metrics.rbearing));
4557 ASET (val, 3, make_number (metrics.width));
4558 ASET (val, 4, make_number (metrics.ascent));
4559 ASET (val, 5, make_number (metrics.descent));
4560 ASET (vec, i, val);
4561 }
4562 return vec;
4563}
4564
ec6fe57c 4565DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
67b5d7de 4566 doc: /* Return t if and only if font-spec SPEC matches with FONT.
ec6fe57c
KH		 4567FONT is a font-spec, font-entity, or font-object. */)
4568 (spec, font)
4569 Lisp_Object spec, font;
4570{
4571 CHECK_FONT_SPEC (spec);
35027d0c 4572 CHECK_FONT (font);
ec6fe57c
KH		 4573
4574 return (font_match_p (spec, font) ? Qt : Qnil);
4575}
4576
1701724c 4577DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
51c01100 4578 doc: /* Return a font-object for displaying a character at POSITION.
10d16101
KH		 4579Optional second arg WINDOW, if non-nil, is a window displaying
4580the current buffer. It defaults to the currently selected window. */)
1701724c
KH		 4581 (position, window, string)
4582 Lisp_Object position, window, string;
10d16101
KH		 4583{
4584 struct window *w;
e3ee0340 4585 EMACS_INT pos;
10d16101 4586
1701724c
KH		 4587 if (NILP (string))
4588 {
4589 CHECK_NUMBER_COERCE_MARKER (position);
4590 pos = XINT (position);
4591 if (pos < BEGV || pos >= ZV)
4592 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1701724c
KH		 4593 }
4594 else
4595 {
1701724c
KH		 4596 CHECK_NUMBER (position);
4597 CHECK_STRING (string);
4598 pos = XINT (position);
4599 if (pos < 0 || pos >= SCHARS (string))
4600 args_out_of_range (string, position);
1701724c 4601 }
10d16101
KH		 4602 if (NILP (window))
4603 window = selected_window;
4604 CHECK_LIVE_WINDOW (window);
40fb53d6 4605 w = XWINDOW (window);
10d16101 4606
40fb53d6 4607 return font_at (-1, pos, NULL, w, string);
10d16101
KH		 4608}
4609
c2f5bfd6
KH		 4610#if 0
4611DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
4612 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4613The value is a number of glyphs drawn.
4614Type C-l to recover what previously shown. */)
4615 (font_object, string)
4616 Lisp_Object font_object, string;
4617{
4618 Lisp_Object frame = selected_frame;
4619 FRAME_PTR f = XFRAME (frame);
4620 struct font *font;
4621 struct face *face;
4622 int i, len, width;
4623 unsigned *code;
4624
4625 CHECK_FONT_GET_OBJECT (font_object, font);
4626 CHECK_STRING (string);
4627 len = SCHARS (string);
4628 code = alloca (sizeof (unsigned) * len);
4629 for (i = 0; i < len; i++)
4630 {
4631 Lisp_Object ch = Faref (string, make_number (i));
4632 Lisp_Object val;
4633 int c = XINT (ch);
4634
4635 code[i] = font->driver->encode_char (font, c);
4636 if (code[i] == FONT_INVALID_CODE)
4637 break;
4638 }
4639 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4640 face->fontp = font;
4641 if (font->driver->prepare_face)
4642 font->driver->prepare_face (f, face);
4643 width = font->driver->text_extents (font, code, i, NULL);
4644 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
4645 if (font->driver->done_face)
4646 font->driver->done_face (f, face);
4647 face->fontp = NULL;
4648 return make_number (len);
4649}
4650#endif
4651
4652#endif /* FONT_DEBUG */
4653
a266686a
KH		 4654#ifdef HAVE_WINDOW_SYSTEM
4655
72606e45
KH		 4656DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
4657 doc: /* Return information about a font named NAME on frame FRAME.
4658If FRAME is omitted or nil, use the selected frame.
4659The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4660 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4661where
4662 OPENED-NAME is the name used for opening the font,
4663 FULL-NAME is the full name of the font,
4664 SIZE is the maximum bound width of the font,
4665 HEIGHT is the height of the font,
4666 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4667 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4668 how to compose characters.
4669If the named font is not yet loaded, return nil. */)
4670 (name, frame)
4671 Lisp_Object name, frame;
4672{
4673 FRAME_PTR f;
4674 struct font *font;
4675 Lisp_Object info;
4676 Lisp_Object font_object;
4677
4678 (*check_window_system_func) ();
4679
4680 if (! FONTP (name))
4681 CHECK_STRING (name);
4682 if (NILP (frame))
4683 frame = selected_frame;
4684 CHECK_LIVE_FRAME (frame);
4685 f = XFRAME (frame);
4686
4687 if (STRINGP (name))
4688 {
4689 int fontset = fs_query_fontset (name, 0);
4690
4691 if (fontset >= 0)
4692 name = fontset_ascii (fontset);
4693 font_object = font_open_by_name (f, (char *) SDATA (name));
4694 }
4695 else if (FONT_OBJECT_P (name))
4696 font_object = name;
4697 else if (FONT_ENTITY_P (name))
4698 font_object = font_open_entity (f, name, 0);
4699 else
4700 {
4701 struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4702 Lisp_Object entity = font_matching_entity (f, face->lface, name);
4703
4704 font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
4705 }
4706 if (NILP (font_object))
4707 return Qnil;
4708 font = XFONT_OBJECT (font_object);
4709
4710 info = Fmake_vector (make_number (7), Qnil);
4711 XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
4712 XVECTOR (info)->contents[1] = AREF (font_object, FONT_NAME_INDEX);
4713 XVECTOR (info)->contents[2] = make_number (font->pixel_size);
4714 XVECTOR (info)->contents[3] = make_number (font->height);
4715 XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
4716 XVECTOR (info)->contents[5] = make_number (font->relative_compose);
4717 XVECTOR (info)->contents[6] = make_number (font->default_ascent);
4718
4719#if 0
4720 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4721 close it now. Perhaps, we should manage font-objects
4722 by `reference-count'. */
4723 font_close_object (f, font_object);
4724#endif
4725 return info;
4726}
a266686a 4727#endif
72606e45 4728
c2f5bfd6 4729\f
d0ab1ebe
KH		 4730#define BUILD_STYLE_TABLE(TBL) \
4731 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4732
4733static Lisp_Object
4734build_style_table (entry, nelement)
4735 struct table_entry *entry;
4736 int nelement;
4737{
4738 int i, j;
4739 Lisp_Object table, elt;
17ab8f5d 4740
d0ab1ebe
KH		 4741 table = Fmake_vector (make_number (nelement), Qnil);
4742 for (i = 0; i < nelement; i++)
4743 {
4744 for (j = 0; entry[i].names[j]; j++);
4745 elt = Fmake_vector (make_number (j + 1), Qnil);
4746 ASET (elt, 0, make_number (entry[i].numeric));
4747 for (j = 0; entry[i].names[j]; j++)
17ab8f5d 4748 ASET (elt, j + 1, intern (entry[i].names[j]));
d0ab1ebe
KH		 4749 ASET (table, i, elt);
4750 }
4751 return table;
4752}
4753
4754static Lisp_Object Vfont_log;
4755static int font_log_env_checked;
4756
d0818984
KH		 4757/* The deferred font-log data of the form [ACTION ARG RESULT].
4758 If ACTION is not nil, that is added to the log when font_add_log is
4759 called next time. At that time, ACTION is set back to nil. */
4760static Lisp_Object Vfont_log_deferred;
4761
4762/* Prepend the font-related logging data in Vfont_log if it is not
4763 `t'. ACTION describes a kind of font-related action (e.g. listing,
4764 opening), ARG is the argument for the action, and RESULT is the
4765 result of the action. */
d0ab1ebe
KH		 4766void
4767font_add_log (action, arg, result)
4768 char *action;
4769 Lisp_Object arg, result;
4770{
4771 Lisp_Object tail, val;
4772 int i;
4773
4774 if (! font_log_env_checked)
4775 {
4776 Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
4777 font_log_env_checked = 1;
4778 }
4779 if (EQ (Vfont_log, Qt))
4780 return;
d0818984
KH		 4781 if (STRINGP (AREF (Vfont_log_deferred, 0)))
4782 {
071132a9 4783 char *str = (char *) SDATA (AREF (Vfont_log_deferred, 0));
d0818984
KH		 4784
4785 ASET (Vfont_log_deferred, 0, Qnil);
4786 font_add_log (str, AREF (Vfont_log_deferred, 1),
4787 AREF (Vfont_log_deferred, 2));
4788 }
4789
d0ab1ebe 4790 if (FONTP (arg))
db716644
KH		 4791 {
4792 Lisp_Object tail, elt;
4793 Lisp_Object equalstr = build_string ("=");
4794
4795 val = Ffont_xlfd_name (arg, Qt);
4796 for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
4797 tail = XCDR (tail))
4798 {
4799 elt = XCAR (tail);
4800 if (EQ (XCAR (elt), QCscript))
4801 val = concat3 (val, SYMBOL_NAME (QCscript),
4802 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
4803 else if (EQ (XCAR (elt), QClang))
4804 val = concat3 (val, SYMBOL_NAME (QClang),
4805 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
4806 else if (EQ (XCAR (elt), QCotf) && CONSP (XCDR (elt)))
4807 val = concat3 (val, SYMBOL_NAME (QCotf),
4808 concat2 (equalstr,
4809 SYMBOL_NAME (XCAR (XCDR (elt)))));
4810 }
4811 arg = val;
4812 }
d0ab1ebe 4813 if (FONTP (result))
d26424c5
KH		 4814 {
4815 val = Ffont_xlfd_name (result, Qt);
4816 if (! FONT_SPEC_P (result))
4817 val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
4818 build_string (":"), val);
4819 result = val;
4820 }
d0ab1ebe
KH		 4821 else if (CONSP (result))
4822 {
4823 result = Fcopy_sequence (result);
4824 for (tail = result; CONSP (tail); tail = XCDR (tail))
4825 {
4826 val = XCAR (tail);
4827 if (FONTP (val))
4828 val = Ffont_xlfd_name (val, Qt);
4829 XSETCAR (tail, val);
4830 }
4831 }
4832 else if (VECTORP (result))
4833 {
4834 result = Fcopy_sequence (result);
4835 for (i = 0; i < ASIZE (result); i++)
4836 {
4837 val = AREF (result, i);
4838 if (FONTP (val))
4839 val = Ffont_xlfd_name (val, Qt);
4840 ASET (result, i, val);
4841 }
4842 }
4843 Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
4844}
4845
d0818984
KH		 4846/* Record a font-related logging data to be added to Vfont_log when
4847 font_add_log is called next time. ACTION, ARG, RESULT are the same
4848 as font_add_log. */
4849
4850void
4851font_deferred_log (action, arg, result)
4852 char *action;
4853 Lisp_Object arg, result;
4854{
4855 ASET (Vfont_log_deferred, 0, build_string (action));
4856 ASET (Vfont_log_deferred, 1, arg);
4857 ASET (Vfont_log_deferred, 2, result);
4858}
4859
c2f5bfd6
KH		 4860extern void syms_of_ftfont P_ (());
4861extern void syms_of_xfont P_ (());
4862extern void syms_of_xftfont P_ (());
4863extern void syms_of_ftxfont P_ (());
4864extern void syms_of_bdffont P_ (());
4865extern void syms_of_w32font P_ (());
4866extern void syms_of_atmfont P_ (());
edfda783 4867extern void syms_of_nsfont P_ (());
c2f5bfd6
KH		 4868
4869void
4870syms_of_font ()
4871{
4007dd1c
KH		 4872 sort_shift_bits[FONT_TYPE_INDEX] = 0;
4873 sort_shift_bits[FONT_SLANT_INDEX] = 2;
4874 sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
4875 sort_shift_bits[FONT_SIZE_INDEX] = 16;
4876 sort_shift_bits[FONT_WIDTH_INDEX] = 23;
4877 /* Note that the other elements in sort_shift_bits are not used. */
c2f5bfd6 4878
1701724c
KH		 4879 staticpro (&font_charset_alist);
4880 font_charset_alist = Qnil;
4881
35027d0c
KH		 4882 DEFSYM (Qfont_spec, "font-spec");
4883 DEFSYM (Qfont_entity, "font-entity");
4884 DEFSYM (Qfont_object, "font-object");
4885
e0708580 4886 DEFSYM (Qopentype, "opentype");
c2f5bfd6 4887
9e1bb909 4888 DEFSYM (Qascii_0, "ascii-0");
1bb1d99b
KH		 4889 DEFSYM (Qiso8859_1, "iso8859-1");
4890 DEFSYM (Qiso10646_1, "iso10646-1");
4891 DEFSYM (Qunicode_bmp, "unicode-bmp");
cf96c5c2 4892 DEFSYM (Qunicode_sip, "unicode-sip");
1bb1d99b 4893
071132a9
KH		 4894 DEFSYM (QCf, "Cf");
4895
c2f5bfd6 4896 DEFSYM (QCotf, ":otf");
35027d0c 4897 DEFSYM (QClang, ":lang");
c2f5bfd6 4898 DEFSYM (QCscript, ":script");
4c496d0d 4899 DEFSYM (QCantialias, ":antialias");
c2f5bfd6
KH		 4900
4901 DEFSYM (QCfoundry, ":foundry");
4902 DEFSYM (QCadstyle, ":adstyle");
4903 DEFSYM (QCregistry, ":registry");
9331887d
KH		 4904 DEFSYM (QCspacing, ":spacing");
4905 DEFSYM (QCdpi, ":dpi");
ec6fe57c 4906 DEFSYM (QCscalable, ":scalable");
35027d0c
KH		 4907 DEFSYM (QCavgwidth, ":avgwidth");
4908 DEFSYM (QCfont_entity, ":font-entity");
4909 DEFSYM (QCfc_unknown_spec, ":fc-unknown-spec");
c2f5bfd6 4910
ec6fe57c
KH		 4911 DEFSYM (Qc, "c");
4912 DEFSYM (Qm, "m");
4913 DEFSYM (Qp, "p");
4914 DEFSYM (Qd, "d");
4915
c2f5bfd6
KH		 4916 staticpro (&null_vector);
4917 null_vector = Fmake_vector (make_number (0), Qnil);
4918
4919 staticpro (&scratch_font_spec);
4920 scratch_font_spec = Ffont_spec (0, NULL);
4921 staticpro (&scratch_font_prefer);
4922 scratch_font_prefer = Ffont_spec (0, NULL);
4923
d0818984
KH		 4924 staticpro (&Vfont_log_deferred);
4925 Vfont_log_deferred = Fmake_vector (make_number (3), Qnil);
4926
6a3dadd2 4927#if 0
733fd013
KH		 4928#ifdef HAVE_LIBOTF
4929 staticpro (&otf_list);
4930 otf_list = Qnil;
6a3dadd2
KH		 4931#endif /* HAVE_LIBOTF */
4932#endif /* 0 */
733fd013 4933
c2f5bfd6
KH		 4934 defsubr (&Sfontp);
4935 defsubr (&Sfont_spec);
4936 defsubr (&Sfont_get);
51cf11be 4937#ifdef HAVE_WINDOW_SYSTEM
b1868a1a 4938 defsubr (&Sfont_face_attributes);
51cf11be 4939#endif
c2f5bfd6
KH		 4940 defsubr (&Sfont_put);
4941 defsubr (&Slist_fonts);
35027d0c 4942 defsubr (&Sfont_family_list);
c2f5bfd6
KH		 4943 defsubr (&Sfind_font);
4944 defsubr (&Sfont_xlfd_name);
4945 defsubr (&Sclear_font_cache);
071132a9 4946 defsubr (&Sfont_shape_gstring);
6a3dadd2 4947#if 0
733fd013 4948 defsubr (&Sfont_drive_otf);
e80e09b4 4949 defsubr (&Sfont_otf_alternates);
6a3dadd2 4950#endif /* 0 */
c2f5bfd6
KH		 4951
4952#ifdef FONT_DEBUG
4953 defsubr (&Sopen_font);
4954 defsubr (&Sclose_font);
4955 defsubr (&Squery_font);
4956 defsubr (&Sget_font_glyphs);
ec6fe57c 4957 defsubr (&Sfont_match_p);
10d16101 4958 defsubr (&Sfont_at);
c2f5bfd6
KH		 4959#if 0
4960 defsubr (&Sdraw_string);
4961#endif
4962#endif /* FONT_DEBUG */
a266686a 4963#ifdef HAVE_WINDOW_SYSTEM
72606e45 4964 defsubr (&Sfont_info);
a266686a 4965#endif
c2f5bfd6 4966
819e81df
KH		 4967 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
4968 doc: /*
4969Alist of fontname patterns vs the corresponding encoding and repertory info.
4970Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4971where ENCODING is a charset or a char-table,
4972and REPERTORY is a charset, a char-table, or nil.
4973
027a33c0 4974If ENCODING and REPERTORY are the same, the element can have the form
819e81df
KH		 4975\(REGEXP . ENCODING).
4976
4977ENCODING is for converting a character to a glyph code of the font.
4978If ENCODING is a charset, encoding a character by the charset gives
4979the corresponding glyph code. If ENCODING is a char-table, looking up
4980the table by a character gives the corresponding glyph code.
4981
4982REPERTORY specifies a repertory of characters supported by the font.
4983If REPERTORY is a charset, all characters beloging to the charset are
4984supported. If REPERTORY is a char-table, all characters who have a
027a33c0 4985non-nil value in the table are supported. If REPERTORY is nil, Emacs
819e81df
KH		 4986gets the repertory information by an opened font and ENCODING. */);
4987 Vfont_encoding_alist = Qnil;
4988
d0ab1ebe
KH		 4989 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table,
4990 doc: /* Vector of valid font weight values.
4991Each element has the form:
4992 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
17ab8f5d 4993NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
d0ab1ebe
KH		 4994 Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
4995
4996 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table,
4997 doc: /* Vector of font slant symbols vs the corresponding numeric values.
17ab8f5d 4998See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 4999 Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
5000
5001 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table,
5002 doc: /* Alist of font width symbols vs the corresponding numeric values.
17ab8f5d 5003See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5004 Vfont_width_table = BUILD_STYLE_TABLE (width_table);
5005
5006 staticpro (&font_style_table);
5007 font_style_table = Fmake_vector (make_number (3), Qnil);
5008 ASET (font_style_table, 0, Vfont_weight_table);
5009 ASET (font_style_table, 1, Vfont_slant_table);
5010 ASET (font_style_table, 2, Vfont_width_table);
5011
5012 DEFVAR_LISP ("font-log", &Vfont_log, doc: /*
5013*Logging list of font related actions and results.
5014The value t means to suppress the logging.
5015The initial value is set to nil if the environment variable
5016EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5017 Vfont_log = Qnil;
5018
819e81df 5019#ifdef HAVE_WINDOW_SYSTEM
c2f5bfd6 5020#ifdef HAVE_FREETYPE
35027d0c 5021 syms_of_ftfont ();
c2f5bfd6 5022#ifdef HAVE_X_WINDOWS
35027d0c
KH		 5023 syms_of_xfont ();
5024 syms_of_ftxfont ();
c2f5bfd6 5025#ifdef HAVE_XFT
35027d0c 5026 syms_of_xftfont ();
c2f5bfd6
KH		 5027#endif /* HAVE_XFT */
5028#endif /* HAVE_X_WINDOWS */
5029#else /* not HAVE_FREETYPE */
5030#ifdef HAVE_X_WINDOWS
35027d0c 5031 syms_of_xfont ();
c2f5bfd6
KH		 5032#endif /* HAVE_X_WINDOWS */
5033#endif /* not HAVE_FREETYPE */
5034#ifdef HAVE_BDFFONT
35027d0c 5035 syms_of_bdffont ();
c2f5bfd6
KH		 5036#endif /* HAVE_BDFFONT */
5037#ifdef WINDOWSNT
35027d0c 5038 syms_of_w32font ();
c2f5bfd6 5039#endif /* WINDOWSNT */
edfda783
AR		 5040#ifdef HAVE_NS
5041 syms_of_nsfont ();
5042#endif /* HAVE_NS */
819e81df 5043#endif /* HAVE_WINDOW_SYSTEM */
c2f5bfd6 5044}
885b7d09
MB		 5045
5046/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5047 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.