HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(Fraise_frame): On text-only terminals select frame in
[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;
819ab95f 2768 Lisp_Object work = Fcopy_font_spec (spec);
e950d6f1 2769
35027d0c 2770 XSETFRAME (frame, f);
e950d6f1
KH		 2771 ftype = AREF (spec, FONT_TYPE_INDEX);
2772 size = AREF (spec, FONT_SIZE_INDEX);
819ab95f 2773
8d0e382e
AR		 2774 if (FLOATP (size))
2775 ASET (work, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
819ab95f
KH		 2776 FONT_SET_STYLE (work, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
2777 FONT_SET_STYLE (work, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
2778 FONT_SET_STYLE (work, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
2779
e950d6f1
KH		 2780 entity = Qnil;
2781 for (; driver_list; driver_list = driver_list->next)
2782 if (driver_list->on
2783 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
2784 {
ca4da08a 2785 Lisp_Object cache = font_get_cache (f, driver_list->driver);
7cee5d63 2786 Lisp_Object copy;
e950d6f1 2787
819ab95f
KH		 2788 ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
2789 entity = assoc_no_quit (work, XCDR (cache));
7cee5d63 2790 if (CONSP (entity))
e950d6f1
KH		 2791 entity = XCDR (entity);
2792 else
2793 {
819ab95f
KH		 2794 entity = driver_list->driver->match (frame, work);
2795 copy = Fcopy_font_spec (work);
7cee5d63
KH		 2796 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2797 XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache)));
e950d6f1
KH		 2798 }
2799 if (! NILP (entity))
2800 break;
2801 }
819ab95f 2802 font_add_log ("match", work, entity);
e950d6f1
KH		 2803 return entity;
2804}
2805
45eb10fb
KH		 2806
2807/* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2808 opened font object. */
2809
c2f5bfd6
KH		 2810static Lisp_Object
2811font_open_entity (f, entity, pixel_size)
2812 FRAME_PTR f;
2813 Lisp_Object entity;
2814 int pixel_size;
2815{
2816 struct font_driver_list *driver_list;
43c0454d 2817 Lisp_Object objlist, size, val, font_object;
c2f5bfd6 2818 struct font *font;
d26424c5 2819 int min_width, height;
c2f5bfd6 2820
d0ab1ebe 2821 font_assert (FONT_ENTITY_P (entity));
c2f5bfd6 2822 size = AREF (entity, FONT_SIZE_INDEX);
c2f5bfd6
KH		 2823 if (XINT (size) != 0)
2824 pixel_size = XINT (size);
2825
2826 for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
2827 objlist = XCDR (objlist))
5e634ec9
KH		 2828 if (! NILP (AREF (XCAR (objlist), FONT_TYPE_INDEX))
2829 && XFONT_OBJECT (XCAR (objlist))->pixel_size == pixel_size)
35027d0c
KH		 2830 return XCAR (objlist);
2831
2832 val = AREF (entity, FONT_TYPE_INDEX);
2833 for (driver_list = f->font_driver_list;
2834 driver_list && ! EQ (driver_list->driver->type, val);
2835 driver_list = driver_list->next);
2836 if (! driver_list)
2837 return Qnil;
c2f5bfd6 2838
35027d0c 2839 font_object = driver_list->driver->open (f, entity, pixel_size);
d0ab1ebe 2840 font_add_log ("open", entity, font_object);
43c0454d 2841 if (NILP (font_object))
35027d0c
KH		 2842 return Qnil;
2843 ASET (entity, FONT_OBJLIST_INDEX,
2844 Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
5e634ec9 2845 ASET (font_object, FONT_OBJLIST_INDEX, Qnil);
35027d0c
KH		 2846 num_fonts++;
2847
2848 font = XFONT_OBJECT (font_object);
2849 min_width = (font->min_width ? font->min_width
2850 : font->average_width ? font->average_width
2851 : font->space_width ? font->space_width
2852 : 1);
d26424c5 2853 height = (font->height ? font->height : 1);
819e81df 2854#ifdef HAVE_WINDOW_SYSTEM
35027d0c
KH		 2855 FRAME_X_DISPLAY_INFO (f)->n_fonts++;
2856 if (FRAME_X_DISPLAY_INFO (f)->n_fonts == 1)
43c0454d 2857 {
35027d0c 2858 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width;
d26424c5 2859 FRAME_SMALLEST_FONT_HEIGHT (f) = height;
35027d0c
KH		 2860 fonts_changed_p = 1;
2861 }
2862 else
2863 {
2864 if (FRAME_SMALLEST_CHAR_WIDTH (f) > min_width)
2865 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width, fonts_changed_p = 1;
d26424c5
KH		 2866 if (FRAME_SMALLEST_FONT_HEIGHT (f) > height)
2867 FRAME_SMALLEST_FONT_HEIGHT (f) = height, fonts_changed_p = 1;
43c0454d 2868 }
819e81df 2869#endif
43c0454d
KH		 2870
2871 return font_object;
c2f5bfd6
KH		 2872}
2873
45eb10fb
KH		 2874
2875/* Close FONT_OBJECT that is opened on frame F. */
2876
c2f5bfd6
KH		 2877void
2878font_close_object (f, font_object)
2879 FRAME_PTR f;
2880 Lisp_Object font_object;
2881{
35027d0c 2882 struct font *font = XFONT_OBJECT (font_object);
c2f5bfd6 2883
5e634ec9
KH		 2884 if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
2885 /* Already closed. */
2886 return;
2887 font_add_log ("close", font_object, Qnil);
2888 font->driver->close (f, font);
819e81df 2889#ifdef HAVE_WINDOW_SYSTEM
5e634ec9
KH		 2890 font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
2891 FRAME_X_DISPLAY_INFO (f)->n_fonts--;
819e81df 2892#endif
5e634ec9 2893 num_fonts--;
c2f5bfd6
KH		 2894}
2895
45eb10fb 2896
1701724c
KH		 2897/* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2898 FONT is a font-entity and it must be opened to check. */
45eb10fb 2899
c2f5bfd6 2900int
1b834a8d 2901font_has_char (f, font, c)
c2f5bfd6 2902 FRAME_PTR f;
1b834a8d 2903 Lisp_Object font;
c2f5bfd6
KH		 2904 int c;
2905{
1b834a8d 2906 struct font *fontp;
c2f5bfd6 2907
1b834a8d
KH		 2908 if (FONT_ENTITY_P (font))
2909 {
2910 Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
2911 struct font_driver_list *driver_list;
2912
2913 for (driver_list = f->font_driver_list;
2914 driver_list && ! EQ (driver_list->driver->type, type);
2915 driver_list = driver_list->next);
2916 if (! driver_list)
2917 return 0;
2918 if (! driver_list->driver->has_char)
2919 return -1;
2920 return driver_list->driver->has_char (font, c);
2921 }
2922
d0ab1ebe 2923 font_assert (FONT_OBJECT_P (font));
35027d0c 2924 fontp = XFONT_OBJECT (font);
1b834a8d
KH		 2925 if (fontp->driver->has_char)
2926 {
35027d0c 2927 int result = fontp->driver->has_char (font, c);
1b834a8d
KH		 2928
2929 if (result >= 0)
2930 return result;
2931 }
2932 return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
c2f5bfd6
KH		 2933}
2934
45eb10fb
KH		 2935
2936/* Return the glyph ID of FONT_OBJECT for character C. */
2937
c2f5bfd6
KH		 2938unsigned
2939font_encode_char (font_object, c)
2940 Lisp_Object font_object;
2941 int c;
2942{
35027d0c 2943 struct font *font;
c2f5bfd6 2944
d0ab1ebe 2945 font_assert (FONT_OBJECT_P (font_object));
35027d0c 2946 font = XFONT_OBJECT (font_object);
c2f5bfd6
KH		 2947 return font->driver->encode_char (font, c);
2948}
2949
45eb10fb
KH		 2950
2951/* Return the name of FONT_OBJECT. */
2952
ef18374f 2953Lisp_Object
c2f5bfd6
KH		 2954font_get_name (font_object)
2955 Lisp_Object font_object;
2956{
d0ab1ebe 2957 font_assert (FONT_OBJECT_P (font_object));
35027d0c 2958 return AREF (font_object, FONT_NAME_INDEX);
ef18374f
KH		 2959}
2960
45eb10fb
KH		 2961
2962/* Return the specification of FONT_OBJECT. */
2963
ef18374f
KH		 2964Lisp_Object
2965font_get_spec (font_object)
2966 Lisp_Object font_object;
2967{
35027d0c 2968 Lisp_Object spec = font_make_spec ();
ef18374f
KH		 2969 int i;
2970
2971 for (i = 0; i < FONT_SIZE_INDEX; i++)
35027d0c
KH		 2972 ASET (spec, i, AREF (font_object, i));
2973 ASET (spec, FONT_SIZE_INDEX,
2974 make_number (XFONT_OBJECT (font_object)->pixel_size));
ef18374f 2975 return spec;
c2f5bfd6
KH		 2976}
2977
35027d0c
KH		 2978Lisp_Object
2979font_spec_from_name (font_name)
2980 Lisp_Object font_name;
2981{
2982 Lisp_Object args[2];
2983
2984 args[0] = QCname;
2985 args[1] = font_name;
2986 return Ffont_spec (2, args);
2987}
2988
45eb10fb 2989
35027d0c
KH		 2990void
2991font_clear_prop (attrs, prop)
2992 Lisp_Object *attrs;
2993 enum font_property_index prop;
2994{
2995 Lisp_Object font = attrs[LFACE_FONT_INDEX];
45eb10fb 2996
35027d0c
KH		 2997 if (! FONTP (font))
2998 return;
2999 if (NILP (AREF (font, prop))
4007dd1c
KH		 3000 && prop != FONT_FAMILY_INDEX && prop != FONT_FOUNDRY_INDEX
3001 && prop != FONT_SIZE_INDEX)
35027d0c
KH		 3002 return;
3003 font = Fcopy_font_spec (font);
3004 ASET (font, prop, Qnil);
4007dd1c 3005 if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
35027d0c 3006 {
4007dd1c
KH		 3007 if (prop == FONT_FAMILY_INDEX)
3008 ASET (font, FONT_FOUNDRY_INDEX, Qnil);
35027d0c 3009 ASET (font, FONT_ADSTYLE_INDEX, Qnil);
4007dd1c 3010 ASET (font, FONT_REGISTRY_INDEX, Qnil);
35027d0c
KH		 3011 ASET (font, FONT_SIZE_INDEX, Qnil);
3012 ASET (font, FONT_DPI_INDEX, Qnil);
3013 ASET (font, FONT_SPACING_INDEX, Qnil);
3014 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3015 }
3016 else if (prop == FONT_SIZE_INDEX)
3017 {
3018 ASET (font, FONT_DPI_INDEX, Qnil);
3019 ASET (font, FONT_SPACING_INDEX, Qnil);
3020 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3021 }
3022 attrs[LFACE_FONT_INDEX] = font;
3023}
3024
3025void
3026font_update_lface (f, attrs)
3027 FRAME_PTR f;
3028 Lisp_Object *attrs;
c2f5bfd6 3029{
d0ab1ebe 3030 Lisp_Object spec;
35027d0c
KH		 3031
3032 spec = attrs[LFACE_FONT_INDEX];
3033 if (! FONT_SPEC_P (spec))
3034 return;
3035
4007dd1c
KH		 3036 if (! NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
3037 attrs[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FOUNDRY_INDEX));
3038 if (! NILP (AREF (spec, FONT_FAMILY_INDEX)))
3039 attrs[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FAMILY_INDEX));
35027d0c
KH		 3040 if (! NILP (AREF (spec, FONT_WEIGHT_INDEX)))
3041 attrs[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (spec);
3042 if (! NILP (AREF (spec, FONT_SLANT_INDEX)))
3043 attrs[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (spec);;
3044 if (! NILP (AREF (spec, FONT_WIDTH_INDEX)))
3045 attrs[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (spec);
3046 if (! NILP (AREF (spec, FONT_SIZE_INDEX)))
3047 {
3048 int point;
3049
3050 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
3051 {
3052 Lisp_Object val;
3053 int dpi = f->resy;
3054
3055 val = Ffont_get (spec, QCdpi);
3056 if (! NILP (val))
3057 dpi = XINT (val);
3058 point = PIXEL_TO_POINT (XINT (AREF (spec, FONT_SIZE_INDEX)) * 10,
3059 dpi);
3060 }
3061 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
3062 point = XFLOAT_DATA (AREF (spec, FONT_SIZE_INDEX)) * 10;
3063 attrs[LFACE_HEIGHT_INDEX] = make_number (point);
3064 }
c2f5bfd6
KH		 3065}
3066
45eb10fb 3067
35027d0c
KH		 3068/* Return a font-entity satisfying SPEC and best matching with face's
3069 font related attributes in ATTRS. C, if not negative, is a
1701724c 3070 character that the entity must support. */
c2f5bfd6
KH		 3071
3072Lisp_Object
35027d0c 3073font_find_for_lface (f, attrs, spec, c)
c2f5bfd6 3074 FRAME_PTR f;
35027d0c 3075 Lisp_Object *attrs;
c2f5bfd6 3076 Lisp_Object spec;
1701724c 3077 int c;
c2f5bfd6 3078{
4007dd1c 3079 Lisp_Object work;
35027d0c 3080 Lisp_Object frame, entities, val, props[FONT_REGISTRY_INDEX + 1] ;
22459668 3081 Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
1d1e1245 3082 int pixel_size;
22459668 3083 int i, j, k, l, result;
d0a47776
KH		 3084
3085 registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
3086 if (NILP (registry[0]))
3087 {
edfda783 3088 registry[0] = DEFAULT_ENCODING;
d0a47776
KH		 3089 registry[1] = Qascii_0;
3090 registry[2] = null_vector;
3091 }
3092 else
3093 registry[1] = null_vector;
c2f5bfd6 3094
4007dd1c 3095 if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
fe5ddfbc 3096 {
35027d0c 3097 struct charset *encoding, *repertory;
1701724c 3098
4007dd1c
KH		 3099 if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
3100 &encoding, &repertory) < 0)
35027d0c
KH		 3101 return Qnil;
3102 if (repertory)
1701724c 3103 {
35027d0c 3104 if (ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
1701724c 3105 return Qnil;
35027d0c
KH		 3106 /* Any font of this registry support C. So, let's
3107 suppress the further checking. */
3108 c = -1;
1701724c 3109 }
35027d0c
KH		 3110 else if (c > encoding->max_char)
3111 return Qnil;
c2f5bfd6
KH		 3112 }
3113
4007dd1c 3114 work = Fcopy_font_spec (spec);
35027d0c
KH		 3115 XSETFRAME (frame, f);
3116 size = AREF (spec, FONT_SIZE_INDEX);
1d1e1245
KH		 3117 pixel_size = font_pixel_size (f, spec);
3118 if (pixel_size == 0)
3119 {
3120 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
3121
3122 pixel_size = POINT_TO_PIXEL (pt / 10, f->resy);
3123 }
4007dd1c
KH		 3124 ASET (work, FONT_SIZE_INDEX, Qnil);
3125 foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
3126 if (! NILP (foundry[0]))
3127 foundry[1] = null_vector;
3128 else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
3129 {
071132a9
KH		 3130 val = attrs[LFACE_FOUNDRY_INDEX];
3131 foundry[0] = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
4007dd1c
KH		 3132 foundry[1] = Qnil;
3133 foundry[2] = null_vector;
3134 }
3135 else
3136 foundry[0] = Qnil, foundry[1] = null_vector;
3137
22459668
KH		 3138 adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
3139 if (! NILP (adstyle[0]))
3140 adstyle[1] = null_vector;
3141 else if (FONTP (attrs[LFACE_FONT_INDEX]))
3142 {
3143 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3144
3145 if (! NILP (AREF (face_font, FONT_ADSTYLE_INDEX)))
3146 {
3147 adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
3148 adstyle[1] = Qnil;
3149 adstyle[2] = null_vector;
3150 }
3151 else
3152 adstyle[0] = Qnil, adstyle[1] = null_vector;
3153 }
3154 else
3155 adstyle[0] = Qnil, adstyle[1] = null_vector;
3156
3157
4007dd1c
KH		 3158 val = AREF (work, FONT_FAMILY_INDEX);
3159 if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
071132a9
KH		 3160 {
3161 val = attrs[LFACE_FAMILY_INDEX];
3162 val = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
3163 }
4007dd1c
KH		 3164 if (NILP (val))
3165 {
3166 family = alloca ((sizeof family[0]) * 2);
3167 family[0] = Qnil;
3168 family[1] = null_vector; /* terminator. */
3169 }
3170 else
3171 {
3172 Lisp_Object alters
819ab95f
KH		 3173 = Fassoc_string (val, Vface_alternative_font_family_alist,
3174#ifndef HAVE_NS
3175 Qt
3176#else
3177 Qnil
3178#endif
3179 );
4007dd1c
KH		 3180
3181 if (! NILP (alters))
3182 {
3183 family = alloca ((sizeof family[0]) * (XINT (Flength (alters)) + 2));
3184 for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
3185 family[i] = XCAR (alters);
3186 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3187 family[i++] = Qnil;
3188 family[i] = null_vector;
3189 }
3190 else
3191 {
3192 family = alloca ((sizeof family[0]) * 3);
3193 i = 0;
3194 family[i++] = val;
3195 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3196 family[i++] = Qnil;
3197 family[i] = null_vector;
3198 }
3199 }
3200
d0a47776 3201 for (i = 0; SYMBOLP (family[i]); i++)
4007dd1c 3202 {
d0a47776
KH		 3203 ASET (work, FONT_FAMILY_INDEX, family[i]);
3204 for (j = 0; SYMBOLP (foundry[j]); j++)
4007dd1c 3205 {
d0a47776
KH		 3206 ASET (work, FONT_FOUNDRY_INDEX, foundry[j]);
3207 for (k = 0; SYMBOLP (registry[k]); k++)
3208 {
904a2e0e 3209 ASET (work, FONT_REGISTRY_INDEX, registry[k]);
22459668
KH		 3210 for (l = 0; SYMBOLP (adstyle[l]); l++)
3211 {
3212 ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
3213 entities = font_list_entities (frame, work);
3214 if (ASIZE (entities) > 0)
3215 goto found;
3216 }
d0a47776 3217 }
4007dd1c 3218 }
4007dd1c 3219 }
d0a47776
KH		 3220 return Qnil;
3221 found:
35027d0c
KH		 3222 if (ASIZE (entities) == 1)
3223 {
3224 if (c < 0)
3225 return AREF (entities, 0);
3226 }
3227 else
c2f5bfd6 3228 {
fe5ddfbc 3229 /* Sort fonts by properties specified in LFACE. */
ec6fe57c 3230 Lisp_Object prefer = scratch_font_prefer;
d0ab1ebe 3231
35027d0c 3232 for (i = 0; i < FONT_EXTRA_INDEX; i++)
4007dd1c 3233 ASET (prefer, i, AREF (work, i));
79f105c9
KH		 3234 if (FONTP (attrs[LFACE_FONT_INDEX]))
3235 {
3236 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3237
3238 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3239 if (NILP (AREF (prefer, i)))
3240 ASET (prefer, i, AREF (face_font, i));
3241 }
35027d0c
KH		 3242 if (NILP (AREF (prefer, FONT_WEIGHT_INDEX)))
3243 FONT_SET_STYLE (prefer, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
3244 if (NILP (AREF (prefer, FONT_SLANT_INDEX)))
3245 FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
3246 if (NILP (AREF (prefer, FONT_WIDTH_INDEX)))
3247 FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
1d1e1245 3248 ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size));
7181ea6a 3249 entities = font_sort_entites (entities, prefer, frame, c < 0);
c2f5bfd6 3250 }
1701724c 3251 if (c < 0)
35027d0c 3252 return entities;
45eb10fb 3253
35027d0c
KH		 3254 for (i = 0; i < ASIZE (entities); i++)
3255 {
3256 int j;
3257
3258 val = AREF (entities, i);
3259 if (i > 0)
3260 {
3261 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3262 if (! EQ (AREF (val, j), props[j]))
3263 break;
3264 if (j > FONT_REGISTRY_INDEX)
3265 continue;
3266 }
3267 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3268 props[j] = AREF (val, j);
3269 result = font_has_char (f, val, c);
3270 if (result > 0)
3271 return val;
3272 if (result == 0)
3273 return Qnil;
3274 val = font_open_for_lface (f, val, attrs, spec);
3275 if (NILP (val))
3276 continue;
3277 result = font_has_char (f, val, c);
3278 font_close_object (f, val);
3279 if (result > 0)
3280 return AREF (entities, i);
3281 }
1701724c
KH		 3282 return Qnil;
3283}
45eb10fb
KH		 3284
3285
c2f5bfd6 3286Lisp_Object
35027d0c 3287font_open_for_lface (f, entity, attrs, spec)
c2f5bfd6 3288 FRAME_PTR f;
c2f5bfd6 3289 Lisp_Object entity;
35027d0c 3290 Lisp_Object *attrs;
733fd013 3291 Lisp_Object spec;
c2f5bfd6 3292{
9331887d 3293 int size;
c2f5bfd6 3294
4007dd1c
KH		 3295 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX))
3296 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
3297 size = XINT (AREF (entity, FONT_SIZE_INDEX));
3298 else if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
1d1e1245 3299 size = font_pixel_size (f, spec);
733fd013
KH		 3300 else
3301 {
35027d0c 3302 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
733fd013
KH		 3303
3304 pt /= 10;
3305 size = POINT_TO_PIXEL (pt, f->resy);
ed96cde8
AR		 3306#ifdef HAVE_NS
3307 if (size == 0)
3308 {
3309 Lisp_Object ffsize = get_frame_param(f, Qfontsize);
3310 size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
3311 }
3312#endif
733fd013 3313 }
c2f5bfd6
KH		 3314 return font_open_entity (f, entity, size);
3315}
3316
45eb10fb 3317
35027d0c
KH		 3318/* Find a font satisfying SPEC and best matching with face's
3319 attributes in ATTRS on FRAME, and return the opened
3320 font-object. */
45eb10fb 3321
35027d0c
KH		 3322Lisp_Object
3323font_load_for_lface (f, attrs, spec)
c2f5bfd6 3324 FRAME_PTR f;
35027d0c 3325 Lisp_Object *attrs, spec;
c2f5bfd6 3326{
35027d0c 3327 Lisp_Object entity;
ef18374f 3328
35027d0c
KH		 3329 entity = font_find_for_lface (f, attrs, spec, -1);
3330 if (NILP (entity))
ef18374f 3331 {
35027d0c
KH		 3332 /* No font is listed for SPEC, but each font-backend may have
3333 the different criteria about "font matching". So, try
3334 it. */
3335 entity = font_matching_entity (f, attrs, spec);
3336 if (NILP (entity))
3337 return Qnil;
c2f5bfd6 3338 }
35027d0c 3339 return font_open_for_lface (f, entity, attrs, spec);
c2f5bfd6
KH		 3340}
3341
45eb10fb
KH		 3342
3343/* Make FACE on frame F ready to use the font opened for FACE. */
3344
c2f5bfd6
KH		 3345void
3346font_prepare_for_face (f, face)
3347 FRAME_PTR f;
3348 struct face *face;
3349{
35027d0c
KH		 3350 if (face->font->driver->prepare_face)
3351 face->font->driver->prepare_face (f, face);
c2f5bfd6
KH		 3352}
3353
45eb10fb
KH		 3354
3355/* Make FACE on frame F stop using the font opened for FACE. */
3356
c2f5bfd6
KH		 3357void
3358font_done_for_face (f, face)
3359 FRAME_PTR f;
3360 struct face *face;
3361{
35027d0c
KH		 3362 if (face->font->driver->done_face)
3363 face->font->driver->done_face (f, face);
c2f5bfd6
KH		 3364 face->extra = NULL;
3365}
3366
45eb10fb
KH		 3367
3368/* Open a font best matching with NAME on frame F. If no proper font
3369 is found, return Qnil. */
3370
c2f5bfd6
KH		 3371Lisp_Object
3372font_open_by_name (f, name)
3373 FRAME_PTR f;
3374 char *name;
3375{
ef18374f 3376 Lisp_Object args[2];
4007dd1c 3377 Lisp_Object spec, attrs[LFACE_VECTOR_SIZE];
a9262bb8 3378
ef18374f
KH		 3379 args[0] = QCname;
3380 args[1] = make_unibyte_string (name, strlen (name));
3381 spec = Ffont_spec (2, args);
4007dd1c
KH		 3382 /* We set up the default font-related attributes of a face to prefer
3383 a moderate font. */
3384 attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
3385 attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
3386 = attrs[LFACE_SLANT_INDEX] = Qnormal;
ed96cde8 3387#ifndef HAVE_NS
4007dd1c 3388 attrs[LFACE_HEIGHT_INDEX] = make_number (120);
ed96cde8
AR		 3389#else
3390 attrs[LFACE_HEIGHT_INDEX] = make_number (0);
3391#endif
4007dd1c
KH		 3392 attrs[LFACE_FONT_INDEX] = Qnil;
3393
3394 return font_load_for_lface (f, attrs, spec);
c2f5bfd6
KH		 3395}
3396
3397
3398/* Register font-driver DRIVER. This function is used in two ways.
3399
417a1b10
KH		 3400 The first is with frame F non-NULL. In this case, make DRIVER
3401 available (but not yet activated) on F. All frame creaters
3402 (e.g. Fx_create_frame) must call this function at least once with
3403 an available font-driver.
c2f5bfd6
KH		 3404
3405 The second is with frame F NULL. In this case, DRIVER is globally
3406 registered in the variable `font_driver_list'. All font-driver
3407 implementations must call this function in its syms_of_XXXX
3408 (e.g. syms_of_xfont). */
3409
3410void
3411register_font_driver (driver, f)
3412 struct font_driver *driver;
3413 FRAME_PTR f;
3414{
3415 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
3416 struct font_driver_list *prev, *list;
3417
3418 if (f && ! driver->draw)
43a1d19b 3419 error ("Unusable font driver for a frame: %s",
c2f5bfd6
KH		 3420 SDATA (SYMBOL_NAME (driver->type)));
3421
3422 for (prev = NULL, list = root; list; prev = list, list = list->next)
cf23b845 3423 if (EQ (list->driver->type, driver->type))
c2f5bfd6
KH		 3424 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
3425
3426 list = malloc (sizeof (struct font_driver_list));
417a1b10 3427 list->on = 0;
c2f5bfd6
KH		 3428 list->driver = driver;
3429 list->next = NULL;
3430 if (prev)
3431 prev->next = list;
3432 else if (f)
3433 f->font_driver_list = list;
3434 else
3435 font_driver_list = list;
72606e45
KH		 3436 if (! f)
3437 num_font_drivers++;
c2f5bfd6
KH		 3438}
3439
45eb10fb 3440
f697fff0 3441/* Make the frame F use font backends listed in NEW_DRIVERS (list of
ca4da08a
KH		 3442 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3443 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
417a1b10 3444
ca4da08a
KH		 3445 A caller must free all realized faces if any in advance. The
3446 return value is a list of font backends actually made used on
3447 F. */
e950d6f1
KH		 3448
3449Lisp_Object
3450font_update_drivers (f, new_drivers)
417a1b10
KH		 3451 FRAME_PTR f;
3452 Lisp_Object new_drivers;
417a1b10
KH		 3453{
3454 Lisp_Object active_drivers = Qnil;
4007dd1c 3455 struct font_driver *driver;
417a1b10
KH		 3456 struct font_driver_list *list;
3457
4007dd1c
KH		 3458 /* At first, turn off non-requested drivers, and turn on requested
3459 drivers. */
f697fff0 3460 for (list = f->font_driver_list; list; list = list->next)
4007dd1c
KH		 3461 {
3462 driver = list->driver;
3463 if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers)))
3464 != list->on)
3465 {
3466 if (list->on)
3467 {
3468 if (driver->end_for_frame)
3469 driver->end_for_frame (f);
3470 font_finish_cache (f, driver);
3471 list->on = 0;
3472 }
3473 else
3474 {
3475 if (! driver->start_for_frame
3476 || driver->start_for_frame (f) == 0)
3477 {
3478 font_prepare_cache (f, driver);
3479 list->on = 1;
3480 }
3481 }
3482 }
3483 }
3484
3485 if (NILP (new_drivers))
3486 return Qnil;
3487
3488 if (! EQ (new_drivers, Qt))
3489 {
3490 /* Re-order the driver list according to new_drivers. */
3306c6dc 3491 struct font_driver_list **list_table, **next;
4007dd1c
KH		 3492 Lisp_Object tail;
3493 int i;
3494
3495 list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
3496 for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
3497 {
3498 for (list = f->font_driver_list; list; list = list->next)
3499 if (list->on && EQ (list->driver->type, XCAR (tail)))
3500 break;
3501 if (list)
3502 list_table[i++] = list;
3503 }
3504 for (list = f->font_driver_list; list; list = list->next)
3505 if (! list->on)
3506 list_table[i] = list;
3507 list_table[i] = NULL;
3508
3306c6dc 3509 next = &f->font_driver_list;
4007dd1c
KH		 3510 for (i = 0; list_table[i]; i++)
3511 {
3306c6dc
AS		 3512 *next = list_table[i];
3513 next = &(*next)->next;
4007dd1c 3514 }
3306c6dc 3515 *next = NULL;
4007dd1c 3516 }
417a1b10 3517
4007dd1c
KH		 3518 for (list = f->font_driver_list; list; list = list->next)
3519 if (list->on)
3520 active_drivers = nconc2 (active_drivers,
3521 Fcons (list->driver->type, Qnil));
e950d6f1 3522 return active_drivers;
417a1b10
KH		 3523}
3524
f697fff0
KH		 3525int
3526font_put_frame_data (f, driver, data)
3527 FRAME_PTR f;
3528 struct font_driver *driver;
3529 void *data;
3530{
3531 struct font_data_list *list, *prev;
3532
3533 for (prev = NULL, list = f->font_data_list; list;
3534 prev = list, list = list->next)
3535 if (list->driver == driver)
3536 break;
3537 if (! data)
3538 {
3539 if (list)
3540 {
3541 if (prev)
3542 prev->next = list->next;
3543 else
3544 f->font_data_list = list->next;
3545 free (list);
3546 }
3547 return 0;
3548 }
3549
3550 if (! list)
3551 {
3552 list = malloc (sizeof (struct font_data_list));
3553 if (! list)
3554 return -1;
3555 list->driver = driver;
3556 list->next = f->font_data_list;
3557 f->font_data_list = list;
3558 }
3559 list->data = data;
3560 return 0;
3561}
3562
3563
3564void *
3565font_get_frame_data (f, driver)
3566 FRAME_PTR f;
3567 struct font_driver *driver;
3568{
3569 struct font_data_list *list;
3570
3571 for (list = f->font_data_list; list; list = list->next)
3572 if (list->driver == driver)
3573 break;
3574 if (! list)
3575 return NULL;
3576 return list->data;
3577}
3578
417a1b10 3579
45eb10fb 3580/* Return the font used to draw character C by FACE at buffer position
e3ee0340
KH		 3581 POS in window W. If STRING is non-nil, it is a string containing C
3582 at index POS. If C is negative, get C from the current buffer or
3583 STRING. */
45eb10fb 3584
10d16101 3585Lisp_Object
e3ee0340 3586font_at (c, pos, face, w, string)
10d16101
KH		 3587 int c;
3588 EMACS_INT pos;
3589 struct face *face;
3590 struct window *w;
e3ee0340 3591 Lisp_Object string;
10d16101
KH		 3592{
3593 FRAME_PTR f;
e3ee0340 3594 int multibyte;
35027d0c 3595 Lisp_Object font_object;
e3ee0340
KH		 3596
3597 if (c < 0)
3598 {
3599 if (NILP (string))
3600 {
3601 multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3602 if (multibyte)
3603 {
3604 EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
3605
3606 c = FETCH_CHAR (pos_byte);
3607 }
3608 else
3609 c = FETCH_BYTE (pos);
3610 }
3611 else
3612 {
3613 unsigned char *str;
3614
3615 multibyte = STRING_MULTIBYTE (string);
3616 if (multibyte)
3617 {
3618 EMACS_INT pos_byte = string_char_to_byte (string, pos);
3619
3620 str = SDATA (string) + pos_byte;
3621 c = STRING_CHAR (str, 0);
3622 }
3623 else
3624 c = SDATA (string)[pos];
3625 }
3626 }
10d16101
KH		 3627
3628 f = XFRAME (w->frame);
1385a806
KH		 3629 if (! FRAME_WINDOW_P (f))
3630 return Qnil;
10d16101
KH		 3631 if (! face)
3632 {
e3ee0340 3633 int face_id;
0f8b27ea 3634 EMACS_INT endptr;
e3ee0340
KH		 3635
3636 if (STRINGP (string))
3637 face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
10d16101
KH		 3638 DEFAULT_FACE_ID, 0);
3639 else
e3ee0340 3640 face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
10d16101
KH		 3641 pos + 100, 0);
3642 face = FACE_FROM_ID (f, face_id);
3643 }
e3ee0340
KH		 3644 if (multibyte)
3645 {
3646 int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
3647 face = FACE_FROM_ID (f, face_id);
3648 }
35027d0c 3649 if (! face->font)
10d16101 3650 return Qnil;
35027d0c 3651
35027d0c
KH		 3652 XSETFONT (font_object, face->font);
3653 return font_object;
3654}
3655
3656
071132a9
KH		 3657#ifdef HAVE_WINDOW_SYSTEM
3658
3659/* Check how many characters after POS (at most to *LIMIT) can be
3660 displayed by the same font on the window W. FACE, if non-NULL, is
3661 the face selected for the character at POS. If STRING is not nil,
3662 it is the string to check instead of the current buffer. In that
3663 case, FACE must be not NULL.
027a33c0 3664
071132a9
KH		 3665 The return value is the font-object for the character at POS.
3666 *LIMIT is set to the position where that font can't be used.
35027d0c 3667
071132a9
KH		 3668 It is assured that the current buffer (or STRING) is multibyte. */
3669
3670Lisp_Object
3671font_range (pos, limit, w, face, string)
3672 EMACS_INT pos, *limit;
3673 struct window *w;
35027d0c 3674 struct face *face;
35027d0c
KH		 3675 Lisp_Object string;
3676{
071132a9 3677 EMACS_INT pos_byte, ignore, start, start_byte;
35027d0c 3678 int c;
071132a9 3679 Lisp_Object font_object = Qnil;
35027d0c
KH		 3680
3681 if (NILP (string))
3682 {
35027d0c 3683 pos_byte = CHAR_TO_BYTE (pos);
071132a9
KH		 3684 if (! face)
3685 {
3686 int face_id;
3687
3688 face_id = face_at_buffer_position (w, pos, 0, 0, &ignore, *limit, 0);
3689 face = FACE_FROM_ID (XFRAME (w->frame), face_id);
3690 }
35027d0c
KH		 3691 }
3692 else
3693 {
071132a9 3694 font_assert (face);
35027d0c
KH		 3695 pos_byte = string_char_to_byte (string, pos);
3696 }
3697
071132a9
KH		 3698 start = pos, start_byte = pos_byte;
3699 while (pos < *limit)
35027d0c 3700 {
071132a9 3701 Lisp_Object category;
35027d0c
KH		 3702
3703 if (NILP (string))
3704 FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
3705 else
3706 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
071132a9 3707 if (NILP (font_object))
35027d0c 3708 {
071132a9
KH		 3709 font_object = font_for_char (face, c, pos - 1, string);
3710 if (NILP (font_object))
3711 return Qnil;
35027d0c
KH		 3712 continue;
3713 }
071132a9
KH		 3714
3715 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3716 if (! EQ (category, QCf)
3717 && font_encode_char (font_object, c) == FONT_INVALID_CODE)
35027d0c 3718 {
071132a9
KH		 3719 Lisp_Object f = font_for_char (face, c, pos - 1, string);
3720 EMACS_INT i, i_byte;
3721
3722
3723 if (NILP (f))
3724 {
3725 *limit = pos - 1;
3726 return font_object;
3727 }
3728 i = start, i_byte = start_byte;
3729 while (i < pos - 1)
3730 {
3731
3732 if (NILP (string))
3733 FETCH_CHAR_ADVANCE_NO_CHECK (c, i, i_byte);
3734 else
3735 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, i, i_byte);
3736 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3737 if (! EQ (category, QCf)
3738 && font_encode_char (f, c) == FONT_INVALID_CODE)
3739 {
3740 *limit = pos - 1;
3741 return font_object;
3742 }
3743 }
3744 font_object = f;
35027d0c
KH		 3745 }
3746 }
071132a9 3747 return font_object;
10d16101 3748}
071132a9 3749#endif
10d16101 3750
c2f5bfd6
KH		 3751\f
3752/* Lisp API */
3753
35027d0c 3754DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
6c8ec042 3755 doc: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
35027d0c
KH		 3756Return nil otherwise.
3757Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
027a33c0 3758which kind of font it is. It must be one of `font-spec', `font-entity',
35027d0c
KH		 3759`font-object'. */)
3760 (object, extra_type)
3761 Lisp_Object object, extra_type;
c2f5bfd6 3762{
35027d0c
KH		 3763 if (NILP (extra_type))
3764 return (FONTP (object) ? Qt : Qnil);
3765 if (EQ (extra_type, Qfont_spec))
3766 return (FONT_SPEC_P (object) ? Qt : Qnil);
3767 if (EQ (extra_type, Qfont_entity))
3768 return (FONT_ENTITY_P (object) ? Qt : Qnil);
3769 if (EQ (extra_type, Qfont_object))
3770 return (FONT_OBJECT_P (object) ? Qt : Qnil);
3771 wrong_type_argument (intern ("font-extra-type"), extra_type);
c2f5bfd6
KH		 3772}
3773
3774DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
45eb10fb
KH		 3775 doc: /* Return a newly created font-spec with arguments as properties.
3776
3777ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3778valid font property name listed below:
3779
3780`:family', `:weight', `:slant', `:width'
3781
3782They are the same as face attributes of the same name. See
51c01100 3783`set-face-attribute'.
45eb10fb
KH		 3784
3785`:foundry'
3786
3787VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3788
3789`:adstyle'
3790
3791VALUE must be a string or a symbol specifying the additional
35027d0c 3792typographic style information of a font, e.g. ``sans''.
45eb10fb
KH		 3793
3794`:registry'
3795
3796VALUE must be a string or a symbol specifying the charset registry and
3797encoding of a font, e.g. ``iso8859-1''.
3798
3799`:size'
3800
3801VALUE must be a non-negative integer or a floating point number
35027d0c 3802specifying the font size. It specifies the font size in pixels
f697fff0 3803(if VALUE is an integer), or in points (if VALUE is a float).
2babb359
KH		 3804
3805`:name'
3806
7a18a178
JB		 3807VALUE must be a string of XLFD-style or fontconfig-style font name.
3808usage: (font-spec ARGS ...) */)
c2f5bfd6
KH		 3809 (nargs, args)
3810 int nargs;
3811 Lisp_Object *args;
3812{
35027d0c 3813 Lisp_Object spec = font_make_spec ();
c2f5bfd6
KH		 3814 int i;
3815
3816 for (i = 0; i < nargs; i += 2)
3817 {
c2f5bfd6
KH		 3818 Lisp_Object key = args[i], val = args[i + 1];
3819
35027d0c
KH		 3820 if (EQ (key, QCname))
3821 {
3822 CHECK_STRING (val);
3823 font_parse_name ((char *) SDATA (val), spec);
3824 font_put_extra (spec, key, val);
3825 }
c2f5bfd6 3826 else
4485a28e 3827 {
35027d0c
KH		 3828 int idx = get_font_prop_index (key);
3829
3830 if (idx >= 0)
ec6fe57c 3831 {
35027d0c
KH		 3832 val = font_prop_validate (idx, Qnil, val);
3833 if (idx < FONT_EXTRA_INDEX)
3834 ASET (spec, idx, val);
3835 else
3836 font_put_extra (spec, key, val);
ec6fe57c 3837 }
35027d0c
KH		 3838 else
3839 font_put_extra (spec, key, font_prop_validate (0, key, val));
4485a28e 3840 }
e950d6f1 3841 }
c2f5bfd6
KH		 3842 return spec;
3843}
3844
35027d0c
KH		 3845DEFUN ("copy-font-spec", Fcopy_font_spec, Scopy_font_spec, 1, 1, 0,
3846 doc: /* Return a copy of FONT as a font-spec. */)
3847 (font)
3848 Lisp_Object font;
3849{
d26424c5 3850 Lisp_Object new_spec, tail, prev, extra;
35027d0c
KH		 3851 int i;
3852
3853 CHECK_FONT (font);
3854 new_spec = font_make_spec ();
3855 for (i = 1; i < FONT_EXTRA_INDEX; i++)
3856 ASET (new_spec, i, AREF (font, i));
d26424c5
KH		 3857 extra = Fcopy_sequence (AREF (font, FONT_EXTRA_INDEX));
3858 /* We must remove :font-entity property. */
3859 for (prev = Qnil, tail = extra; CONSP (tail); prev = tail, tail = XCDR (tail))
3860 if (EQ (XCAR (XCAR (tail)), QCfont_entity))
3861 {
3862 if (NILP (prev))
3863 extra = XCDR (extra);
3864 else
3865 XSETCDR (prev, XCDR (tail));
3866 break;
3867 }
35027d0c
KH		 3868 ASET (new_spec, FONT_EXTRA_INDEX, extra);
3869 return new_spec;
3870}
3871
3872DEFUN ("merge-font-spec", Fmerge_font_spec, Smerge_font_spec, 2, 2, 0,
3873 doc: /* Merge font-specs FROM and TO, and return a new font-spec.
3874Every specified properties in FROM override the corresponding
3875properties in TO. */)
3876 (from, to)
3877 Lisp_Object from, to;
3878{
3879 Lisp_Object extra, tail;
3880 int i;
3881
3882 CHECK_FONT (from);
3883 CHECK_FONT (to);
3884 to = Fcopy_font_spec (to);
3885 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3886 ASET (to, i, AREF (from, i));
3887 extra = AREF (to, FONT_EXTRA_INDEX);
3888 for (tail = AREF (from, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
3889 if (! EQ (XCAR (XCAR (tail)), Qfont_entity))
3890 {
3891 Lisp_Object slot = assq_no_quit (XCAR (XCAR (tail)), extra);
3892
3893 if (! NILP (slot))
3894 XSETCDR (slot, XCDR (XCAR (tail)));
3895 else
3896 extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
3897 }
3898 ASET (to, FONT_EXTRA_INDEX, extra);
3899 return to;
3900}
c2f5bfd6
KH		 3901
3902DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
45eb10fb 3903 doc: /* Return the value of FONT's property KEY.
e950d6f1 3904FONT is a font-spec, a font-entity, or a font-object. */)
45eb10fb
KH		 3905 (font, key)
3906 Lisp_Object font, key;
c2f5bfd6 3907{
35027d0c 3908 int idx;
c2f5bfd6 3909
35027d0c
KH		 3910 CHECK_FONT (font);
3911 CHECK_SYMBOL (key);
e80e09b4 3912
35027d0c 3913 idx = get_font_prop_index (key);
2babb359
KH		 3914 if (idx >= FONT_WEIGHT_INDEX && idx <= FONT_WIDTH_INDEX)
3915 return font_style_symbolic (font, idx, 0);
35027d0c 3916 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
c2f5bfd6 3917 return AREF (font, idx);
35027d0c 3918 return Fcdr (Fassq (key, AREF (font, FONT_EXTRA_INDEX)));
c2f5bfd6
KH		 3919}
3920
51cf11be
AS		 3921#ifdef HAVE_WINDOW_SYSTEM
3922
b1868a1a
CY		 3923DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1, 2, 0,
3924 doc: /* Return a plist of face attributes generated by FONT.
3925FONT is a font name, a font-spec, a font-entity, or a font-object.
3926The return value is a list of the form
3927
6f568955 3928\(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
b1868a1a 3929
48105a6a 3930where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
5989ba2f
CY		 3931compatible with `set-face-attribute'. Some of these key-attribute pairs
3932may be omitted from the list if they are not specified by FONT.
b1868a1a 3933
48105a6a
JB		 3934The optional argument FRAME specifies the frame that the face attributes
3935are to be displayed on. If omitted, the selected frame is used. */)
b1868a1a 3936 (font, frame)
6f568955 3937 Lisp_Object font, frame;
b1868a1a
CY		 3938{
3939 struct frame *f;
3940 Lisp_Object plist[10];
3941 Lisp_Object val;
5989ba2f 3942 int n = 0;
b1868a1a
CY		 3943
3944 if (NILP (frame))
3945 frame = selected_frame;
3946 CHECK_LIVE_FRAME (frame);
3947 f = XFRAME (frame);
3948
3949 if (STRINGP (font))
3950 {
3951 int fontset = fs_query_fontset (font, 0);
3952 Lisp_Object name = font;
3953 if (fontset >= 0)
3954 font = fontset_ascii (fontset);
3955 font = font_spec_from_name (name);
3956 if (! FONTP (font))
3957 signal_error ("Invalid font name", name);
3958 }
3959 else if (! FONTP (font))
3960 signal_error ("Invalid font object", font);
3961
b1868a1a 3962 val = AREF (font, FONT_FAMILY_INDEX);
5989ba2f
CY		 3963 if (! NILP (val))
3964 {
3965 plist[n++] = QCfamily;
3966 plist[n++] = SYMBOL_NAME (val);
3967 }
b1868a1a 3968
b1868a1a
CY		 3969 val = AREF (font, FONT_SIZE_INDEX);
3970 if (INTEGERP (val))
3971 {
3972 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
3973 int dpi = INTEGERP (font_dpi) ? XINT (font_dpi) : f->resy;
5989ba2f 3974 plist[n++] = QCheight;
c3bb5465 3975 plist[n++] = make_number (PIXEL_TO_POINT (XINT (val) * 10, dpi));
b1868a1a
CY		 3976 }
3977 else if (FLOATP (val))
5989ba2f
CY		 3978 {
3979 plist[n++] = QCheight;
3980 plist[n++] = make_number (10 * (int) XFLOAT_DATA (val));
3981 }
b1868a1a 3982
b1868a1a 3983 val = FONT_WEIGHT_FOR_FACE (font);
5989ba2f
CY		 3984 if (! NILP (val))
3985 {
3986 plist[n++] = QCweight;
3987 plist[n++] = val;
3988 }
b1868a1a 3989
b1868a1a 3990 val = FONT_SLANT_FOR_FACE (font);
5989ba2f
CY		 3991 if (! NILP (val))
3992 {
3993 plist[n++] = QCslant;
3994 plist[n++] = val;
3995 }
b1868a1a 3996
b1868a1a 3997 val = FONT_WIDTH_FOR_FACE (font);
5989ba2f
CY		 3998 if (! NILP (val))
3999 {
4000 plist[n++] = QCwidth;
4001 plist[n++] = val;
4002 }
b1868a1a 4003
5989ba2f 4004 return Flist (n, plist);
b1868a1a 4005}
c2f5bfd6 4006
51cf11be
AS		 4007#endif
4008
c2f5bfd6 4009DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
51c01100 4010 doc: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
c2f5bfd6
KH		 4011 (font_spec, prop, val)
4012 Lisp_Object font_spec, prop, val;
4013{
35027d0c 4014 int idx;
c2f5bfd6
KH		 4015
4016 CHECK_FONT_SPEC (font_spec);
35027d0c
KH		 4017 idx = get_font_prop_index (prop);
4018 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
69eb9e8b 4019 ASET (font_spec, idx, font_prop_validate (idx, Qnil, val));
c2f5bfd6 4020 else
35027d0c 4021 font_put_extra (font_spec, prop, font_prop_validate (0, prop, val));
c2f5bfd6
KH		 4022 return val;
4023}
4024
4025DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
4026 doc: /* List available fonts matching FONT-SPEC on the current frame.
4027Optional 2nd argument FRAME specifies the target frame.
4028Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
45eb10fb
KH		 4029Optional 4th argument PREFER, if non-nil, is a font-spec to
4030control the order of the returned list. Fonts are sorted by
027a33c0 4031how close they are to PREFER. */)
c2f5bfd6
KH		 4032 (font_spec, frame, num, prefer)
4033 Lisp_Object font_spec, frame, num, prefer;
4034{
4035 Lisp_Object vec, list, tail;
4036 int n = 0, i, len;
4037
4038 if (NILP (frame))
4039 frame = selected_frame;
4040 CHECK_LIVE_FRAME (frame);
35027d0c 4041 CHECK_FONT_SPEC (font_spec);
c2f5bfd6
KH		 4042 if (! NILP (num))
4043 {
4044 CHECK_NUMBER (num);
4045 n = XINT (num);
4046 if (n <= 0)
4047 return Qnil;
4048 }
4049 if (! NILP (prefer))
35027d0c 4050 CHECK_FONT_SPEC (prefer);
c2f5bfd6
KH		 4051
4052 vec = font_list_entities (frame, font_spec);
4053 len = ASIZE (vec);
4054 if (len == 0)
4055 return Qnil;
4056 if (len == 1)
4057 return Fcons (AREF (vec, 0), Qnil);
4058
4059 if (! NILP (prefer))
7181ea6a 4060 vec = font_sort_entites (vec, prefer, frame, 0);
c2f5bfd6
KH		 4061
4062 list = tail = Fcons (AREF (vec, 0), Qnil);
4063 if (n == 0 || n > len)
4064 n = len;
4065 for (i = 1; i < n; i++)
4066 {
4067 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
4068
4069 XSETCDR (tail, val);
4070 tail = val;
4071 }
4072 return list;
4073}
4074
35027d0c 4075DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
c2f5bfd6 4076 doc: /* List available font families on the current frame.
027a33c0 4077Optional argument FRAME, if non-nil, specifies the target frame. */)
c2f5bfd6
KH		 4078 (frame)
4079 Lisp_Object frame;
4080{
4081 FRAME_PTR f;
4082 struct font_driver_list *driver_list;
4083 Lisp_Object list;
4084
4085 if (NILP (frame))
4086 frame = selected_frame;
4087 CHECK_LIVE_FRAME (frame);
4088 f = XFRAME (frame);
4089 list = Qnil;
4090 for (driver_list = f->font_driver_list; driver_list;
4091 driver_list = driver_list->next)
4092 if (driver_list->driver->list_family)
4093 {
4094 Lisp_Object val = driver_list->driver->list_family (frame);
4095
4096 if (NILP (list))
4097 list = val;
4098 else
4099 {
4100 Lisp_Object tail = list;
4101
4102 for (; CONSP (val); val = XCDR (val))
4103 if (NILP (Fmemq (XCAR (val), tail)))
4104 list = Fcons (XCAR (val), list);
4105 }
4106 }
4107 return list;
4108}
4109
4110DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
4111 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
4112Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4113 (font_spec, frame)
4114 Lisp_Object font_spec, frame;
4115{
4116 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
4117
4118 if (CONSP (val))
4119 val = XCAR (val);
4120 return val;
4121}
4122
d0ab1ebe 4123DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
c2f5bfd6
KH		 4124 doc: /* Return XLFD name of FONT.
4125FONT is a font-spec, font-entity, or font-object.
d0ab1ebe
KH		 4126If the name is too long for XLFD (maximum 255 chars), return nil.
4127If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4128the consecutive wildcards are folded to one. */)
4129 (font, fold_wildcards)
4130 Lisp_Object font, fold_wildcards;
c2f5bfd6
KH		 4131{
4132 char name[256];
4133 int pixel_size = 0;
4134
35027d0c
KH		 4135 CHECK_FONT (font);
4136
4137 if (FONT_OBJECT_P (font))
c2f5bfd6 4138 {
35027d0c 4139 Lisp_Object font_name = AREF (font, FONT_NAME_INDEX);
c2f5bfd6 4140
35027d0c
KH		 4141 if (STRINGP (font_name)
4142 && SDATA (font_name)[0] == '-')
d0ab1ebe
KH		 4143 {
4144 if (NILP (fold_wildcards))
4145 return font_name;
4146 strcpy (name, (char *) SDATA (font_name));
4147 goto done;
4148 }
35027d0c 4149 pixel_size = XFONT_OBJECT (font)->pixel_size;
c2f5bfd6 4150 }
c2f5bfd6
KH		 4151 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
4152 return Qnil;
d0ab1ebe
KH		 4153 done:
4154 if (! NILP (fold_wildcards))
4155 {
4156 char *p0 = name, *p1;
4157
4158 while ((p1 = strstr (p0, "-*-*")))
4159 {
4160 strcpy (p1, p1 + 2);
4161 p0 = p1;
4162 }
4163 }
4164
c2f5bfd6
KH		 4165 return build_string (name);
4166}
4167
4168DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
4169 doc: /* Clear font cache. */)
4170 ()
4171{
4172 Lisp_Object list, frame;
4173
4174 FOR_EACH_FRAME (list, frame)
4175 {
4176 FRAME_PTR f = XFRAME (frame);
4177 struct font_driver_list *driver_list = f->font_driver_list;
4178
4179 for (; driver_list; driver_list = driver_list->next)
417a1b10
KH		 4180 if (driver_list->on)
4181 {
ca4da08a
KH		 4182 Lisp_Object cache = driver_list->driver->get_cache (f);
4183 Lisp_Object val;
51c01100 4184
ca4da08a 4185 val = XCDR (cache);
43c0454d
KH		 4186 while (! NILP (val)
4187 && ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
ca4da08a 4188 val = XCDR (val);
d0ab1ebe 4189 font_assert (! NILP (val));
ca4da08a
KH		 4190 val = XCDR (XCAR (val));
4191 if (XINT (XCAR (val)) == 0)
417a1b10 4192 {
ca4da08a
KH		 4193 font_clear_cache (f, XCAR (val), driver_list->driver);
4194 XSETCDR (cache, XCDR (val));
417a1b10 4195 }
417a1b10 4196 }
c2f5bfd6
KH		 4197 }
4198
4199 return Qnil;
4200}
4201
071132a9
KH		 4202\f
4203void
4204font_fill_lglyph_metrics (glyph, font_object)
4205 Lisp_Object glyph, font_object;
c2f5bfd6 4206{
071132a9 4207 struct font *font = XFONT_OBJECT (font_object);
f62ab7c5
EZ		 4208 unsigned code;
4209 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4210 EMACS_INT ecode = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
071132a9 4211 struct font_metrics metrics;
c2f5bfd6 4212
f62ab7c5
EZ		 4213 LGLYPH_SET_CODE (glyph, ecode);
4214 code = ecode;
071132a9
KH		 4215 font->driver->text_extents (font, &code, 1, &metrics);
4216 LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
4217 LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
4218 LGLYPH_SET_WIDTH (glyph, metrics.width);
4219 LGLYPH_SET_ASCENT (glyph, metrics.ascent);
4220 LGLYPH_SET_DESCENT (glyph, metrics.descent);
c2f5bfd6
KH		 4221}
4222
c2f5bfd6 4223
071132a9
KH		 4224DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0,
4225 doc: /* Shape the glyph-string GSTRING.
4226Shaping means substituting glyphs and/or adjusting positions of glyphs
4227to get the correct visual image of character sequences set in the
4228header of the glyph-string.
1701724c 4229
071132a9
KH		 4230If the shaping was successful, the value is GSTRING itself or a newly
4231created glyph-string. Otherwise, the value is nil. */)
4232 (gstring)
4233 Lisp_Object gstring;
1701724c
KH		 4234{
4235 struct font *font;
071132a9 4236 Lisp_Object font_object, n, glyph;
fc3a285e 4237 int i, j, from, to;
071132a9
KH		 4238
4239 if (! composition_gstring_p (gstring))
4240 signal_error ("Invalid glyph-string: ", gstring);
4241 if (! NILP (LGSTRING_ID (gstring)))
4242 return gstring;
4243 font_object = LGSTRING_FONT (gstring);
4244 CHECK_FONT_OBJECT (font_object);
35027d0c 4245 font = XFONT_OBJECT (font_object);
b876ea91
KH		 4246 if (! font->driver->shape)
4247 return Qnil;
4248
40fb53d6
KH		 4249 /* Try at most three times with larger gstring each time. */
4250 for (i = 0; i < 3; i++)
4251 {
40fb53d6
KH		 4252 n = font->driver->shape (gstring);
4253 if (INTEGERP (n))
4254 break;
071132a9
KH		 4255 gstring = larger_vector (gstring,
4256 ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
4257 Qnil);
40fb53d6 4258 }
071132a9 4259 if (i == 3 || XINT (n) == 0)
1701724c 4260 return Qnil;
071132a9
KH		 4261
4262 glyph = LGSTRING_GLYPH (gstring, 0);
fc3a285e
KH		 4263 from = LGLYPH_FROM (glyph);
4264 to = LGLYPH_TO (glyph);
4265 for (i = 1, j = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
071132a9
KH		 4266 {
4267 Lisp_Object this = LGSTRING_GLYPH (gstring, i);
10d16101 4268
071132a9
KH		 4269 if (NILP (this))
4270 break;
4271 if (NILP (LGLYPH_ADJUSTMENT (this)))
fc3a285e
KH		 4272 {
4273 if (j < i - 1)
4274 for (; j < i; j++)
4275 {
4276 glyph = LGSTRING_GLYPH (gstring, j);
4277 LGLYPH_SET_FROM (glyph, from);
4278 LGLYPH_SET_TO (glyph, to);
4279 }
4280 from = LGLYPH_FROM (this);
4281 to = LGLYPH_TO (this);
4282 j = i;
4283 }
071132a9 4284 else
b2937119 4285 {
fc3a285e
KH		 4286 if (from > LGLYPH_FROM (this))
4287 from = LGLYPH_FROM (this);
4288 if (to < LGLYPH_TO (this))
4289 to = LGLYPH_TO (this);
b2937119 4290 }
10d16101 4291 }
fc3a285e
KH		 4292 if (j < i - 1)
4293 for (; j < i; j++)
4294 {
4295 glyph = LGSTRING_GLYPH (gstring, j);
4296 LGLYPH_SET_FROM (glyph, from);
4297 LGLYPH_SET_TO (glyph, to);
4298 }
071132a9 4299 return composition_gstring_put_cache (gstring, XINT (n));
c2f5bfd6
KH		 4300}
4301
6a3dadd2
KH		 4302#if 0
4303
733fd013
KH		 4304DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
4305 doc: /* Apply OpenType features on glyph-string GSTRING-IN.
51c01100 4306OTF-FEATURES specifies which features to apply in this format:
733fd013 4307 (SCRIPT LANGSYS GSUB GPOS)
e80e09b4
KH		 4308where
4309 SCRIPT is a symbol specifying a script tag of OpenType,
4310 LANGSYS is a symbol specifying a langsys tag of OpenType,
733fd013 4311 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
e80e09b4
KH		 4312
4313If LANGYS is nil, the default langsys is selected.
4314
51c01100
JB		 4315The features are applied in the order they appear in the list. The
4316symbol `*' means to apply all available features not present in this
733fd013
KH		 4317list, and the remaining features are ignored. For instance, (vatu
4318pstf * haln) is to apply vatu and pstf in this order, then to apply
4319all available features other than vatu, pstf, and haln.
e80e09b4
KH		 4320
4321The features are applied to the glyphs in the range FROM and TO of
733fd013 4322the glyph-string GSTRING-IN.
e80e09b4 4323
51c01100 4324If some feature is actually applicable, the resulting glyphs are
e80e09b4
KH		 4325produced in the glyph-string GSTRING-OUT from the index INDEX. In
4326this case, the value is the number of produced glyphs.
4327
4328If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4329the value is 0.
4330
51c01100 4331If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
e80e09b4
KH		 4332produced in GSTRING-OUT, and the value is nil.
4333
4334See the documentation of `font-make-gstring' for the format of
4335glyph-string. */)
733fd013
KH		 4336 (otf_features, gstring_in, from, to, gstring_out, index)
4337 Lisp_Object otf_features, gstring_in, from, to, gstring_out, index;
e80e09b4
KH		 4338{
4339 Lisp_Object font_object = LGSTRING_FONT (gstring_in);
733fd013
KH		 4340 Lisp_Object val;
4341 struct font *font;
e80e09b4
KH		 4342 int len, num;
4343
733fd013 4344 check_otf_features (otf_features);
35027d0c
KH		 4345 CHECK_FONT_OBJECT (font_object);
4346 font = XFONT_OBJECT (font_object);
733fd013 4347 if (! font->driver->otf_drive)
e80e09b4
KH		 4348 error ("Font backend %s can't drive OpenType GSUB table",
4349 SDATA (SYMBOL_NAME (font->driver->type)));
733fd013
KH		 4350 CHECK_CONS (otf_features);
4351 CHECK_SYMBOL (XCAR (otf_features));
4352 val = XCDR (otf_features);
4353 CHECK_SYMBOL (XCAR (val));
4354 val = XCDR (otf_features);
4355 if (! NILP (val))
4356 CHECK_CONS (val);
e80e09b4
KH		 4357 len = check_gstring (gstring_in);
4358 CHECK_VECTOR (gstring_out);
4359 CHECK_NATNUM (from);
4360 CHECK_NATNUM (to);
4361 CHECK_NATNUM (index);
4362
4363 if (XINT (from) >= XINT (to) || XINT (to) > len)
4364 args_out_of_range_3 (from, to, make_number (len));
4365 if (XINT (index) >= ASIZE (gstring_out))
4366 args_out_of_range (index, make_number (ASIZE (gstring_out)));
733fd013
KH		 4367 num = font->driver->otf_drive (font, otf_features,
4368 gstring_in, XINT (from), XINT (to),
4369 gstring_out, XINT (index), 0);
e80e09b4
KH		 4370 if (num < 0)
4371 return Qnil;
4372 return make_number (num);
4373}
4374
e80e09b4
KH		 4375DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
4376 3, 3, 0,
4377 doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
51c01100 4378OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
e80e09b4
KH		 4379in this format:
4380 (SCRIPT LANGSYS FEATURE ...)
027a33c0 4381See the documentation of `font-drive-otf' for more detail.
e80e09b4
KH		 4382
4383The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4384where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4385character code corresponding to the glyph or nil if there's no
4386corresponding character. */)
733fd013
KH		 4387 (font_object, character, otf_features)
4388 Lisp_Object font_object, character, otf_features;
e80e09b4
KH		 4389{
4390 struct font *font;
4391 Lisp_Object gstring_in, gstring_out, g;
4392 Lisp_Object alternates;
4393 int i, num;
4394
4395 CHECK_FONT_GET_OBJECT (font_object, font);
733fd013 4396 if (! font->driver->otf_drive)
e950d6f1
KH		 4397 error ("Font backend %s can't drive OpenType GSUB table",
4398 SDATA (SYMBOL_NAME (font->driver->type)));
e80e09b4 4399 CHECK_CHARACTER (character);
733fd013 4400 CHECK_CONS (otf_features);
e80e09b4
KH		 4401
4402 gstring_in = Ffont_make_gstring (font_object, make_number (1));
4403 g = LGSTRING_GLYPH (gstring_in, 0);
f9ffa1ea 4404 LGLYPH_SET_CHAR (g, XINT (character));
e80e09b4 4405 gstring_out = Ffont_make_gstring (font_object, make_number (10));
733fd013
KH		 4406 while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
4407 gstring_out, 0, 1)) < 0)
e80e09b4
KH		 4408 gstring_out = Ffont_make_gstring (font_object,
4409 make_number (ASIZE (gstring_out) * 2));
4410 alternates = Qnil;
4411 for (i = 0; i < num; i++)
4412 {
4413 Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
f9ffa1ea
SM		 4414 int c = LGLYPH_CHAR (g);
4415 unsigned code = LGLYPH_CODE (g);
e80e09b4
KH		 4416
4417 alternates = Fcons (Fcons (make_number (code),
4418 c > 0 ? make_number (c) : Qnil),
4419 alternates);
4420 }
4421 return Fnreverse (alternates);
4422}
6a3dadd2 4423#endif /* 0 */
c2f5bfd6
KH		 4424
4425#ifdef FONT_DEBUG
4426
4427DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
4428 doc: /* Open FONT-ENTITY. */)
4429 (font_entity, size, frame)
4430 Lisp_Object font_entity;
4431 Lisp_Object size;
4432 Lisp_Object frame;
4433{
4434 int isize;
4435
4436 CHECK_FONT_ENTITY (font_entity);
c2f5bfd6
KH		 4437 if (NILP (frame))
4438 frame = selected_frame;
4439 CHECK_LIVE_FRAME (frame);
51c01100 4440
35027d0c
KH		 4441 if (NILP (size))
4442 isize = XINT (AREF (font_entity, FONT_SIZE_INDEX));
4443 else
4444 {
4445 CHECK_NUMBER_OR_FLOAT (size);
4446 if (FLOATP (size))
4447 isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
4448 else
4449 isize = XINT (size);
4450 if (isize == 0)
4451 isize = 120;
4452 }
c2f5bfd6
KH		 4453 return font_open_entity (XFRAME (frame), font_entity, isize);
4454}
4455
4456DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
4457 doc: /* Close FONT-OBJECT. */)
4458 (font_object, frame)
4459 Lisp_Object font_object, frame;
4460{
4461 CHECK_FONT_OBJECT (font_object);
4462 if (NILP (frame))
4463 frame = selected_frame;
4464 CHECK_LIVE_FRAME (frame);
4465 font_close_object (XFRAME (frame), font_object);
4466 return Qnil;
4467}
4468
4469DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
e80e09b4
KH		 4470 doc: /* Return information about FONT-OBJECT.
4471The value is a vector:
4472 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
e0708580 4473 CAPABILITY ]
e80e09b4
KH		 4474
4475NAME is a string of the font name (or nil if the font backend doesn't
4476provide a name).
4477
4478FILENAME is a string of the font file (or nil if the font backend
4479doesn't provide a file name).
4480
4481PIXEL-SIZE is a pixel size by which the font is opened.
4482
027a33c0 4483SIZE is a maximum advance width of the font in pixels.
e80e09b4
KH		 4484
4485ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
027a33c0 4486pixels.
e80e09b4 4487
e0708580
KH		 4488CAPABILITY is a list whose first element is a symbol representing the
4489font format \(x, opentype, truetype, type1, pcf, or bdf) and the
027a33c0 4490remaining elements describe the details of the font capability.
e0708580
KH		 4491
4492If the font is OpenType font, the form of the list is
4493 \(opentype GSUB GPOS)
4494where GSUB shows which "GSUB" features the font supports, and GPOS
4495shows which "GPOS" features the font supports. Both GSUB and GPOS are
4496lists of the format:
4497 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4498
4499If the font is not OpenType font, currently the length of the form is
4500one.
e80e09b4
KH		 4501
4502SCRIPT is a symbol representing OpenType script tag.
4503
4504LANGSYS is a symbol representing OpenType langsys tag, or nil
4505representing the default langsys.
4506
51c01100 4507FEATURE is a symbol representing OpenType feature tag.
e80e09b4 4508
51c01100 4509If the font is not OpenType font, CAPABILITY is nil. */)
c2f5bfd6
KH		 4510 (font_object)
4511 Lisp_Object font_object;
4512{
4513 struct font *font;
4514 Lisp_Object val;
4515
4516 CHECK_FONT_GET_OBJECT (font_object, font);
4517
4518 val = Fmake_vector (make_number (9), Qnil);
35027d0c
KH		 4519 ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
4520 ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
c2f5bfd6 4521 ASET (val, 2, make_number (font->pixel_size));
35027d0c 4522 ASET (val, 3, make_number (font->max_width));
c2f5bfd6
KH		 4523 ASET (val, 4, make_number (font->ascent));
4524 ASET (val, 5, make_number (font->descent));
35027d0c
KH		 4525 ASET (val, 6, make_number (font->space_width));
4526 ASET (val, 7, make_number (font->average_width));
c2f5bfd6 4527 if (font->driver->otf_capability)
e0708580 4528 ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
c2f5bfd6
KH		 4529 return val;
4530}
4531
4532DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
4533 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4534Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4535 (font_object, string)
4536 Lisp_Object font_object, string;
4537{
4538 struct font *font;
4539 int i, len;
4540 Lisp_Object vec;
4541
4542 CHECK_FONT_GET_OBJECT (font_object, font);
4543 CHECK_STRING (string);
4544 len = SCHARS (string);
4545 vec = Fmake_vector (make_number (len), Qnil);
4546 for (i = 0; i < len; i++)
4547 {
4548 Lisp_Object ch = Faref (string, make_number (i));
4549 Lisp_Object val;
4550 int c = XINT (ch);
4551 unsigned code;
2930d117 4552 EMACS_INT cod;
c2f5bfd6
KH		 4553 struct font_metrics metrics;
4554
2930d117 4555 cod = code = font->driver->encode_char (font, c);
c2f5bfd6
KH		 4556 if (code == FONT_INVALID_CODE)
4557 continue;
4558 val = Fmake_vector (make_number (6), Qnil);
2930d117 4559 if (cod <= MOST_POSITIVE_FIXNUM)
c2f5bfd6
KH		 4560 ASET (val, 0, make_number (code));
4561 else
4562 ASET (val, 0, Fcons (make_number (code >> 16),
4563 make_number (code & 0xFFFF)));
51c01100 4564 font->driver->text_extents (font, &code, 1, &metrics);
c2f5bfd6
KH		 4565 ASET (val, 1, make_number (metrics.lbearing));
4566 ASET (val, 2, make_number (metrics.rbearing));
4567 ASET (val, 3, make_number (metrics.width));
4568 ASET (val, 4, make_number (metrics.ascent));
4569 ASET (val, 5, make_number (metrics.descent));
4570 ASET (vec, i, val);
4571 }
4572 return vec;
4573}
4574
ec6fe57c 4575DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
67b5d7de 4576 doc: /* Return t if and only if font-spec SPEC matches with FONT.
ec6fe57c
KH		 4577FONT is a font-spec, font-entity, or font-object. */)
4578 (spec, font)
4579 Lisp_Object spec, font;
4580{
4581 CHECK_FONT_SPEC (spec);
35027d0c 4582 CHECK_FONT (font);
ec6fe57c
KH		 4583
4584 return (font_match_p (spec, font) ? Qt : Qnil);
4585}
4586
1701724c 4587DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
51c01100 4588 doc: /* Return a font-object for displaying a character at POSITION.
10d16101
KH		 4589Optional second arg WINDOW, if non-nil, is a window displaying
4590the current buffer. It defaults to the currently selected window. */)
1701724c
KH		 4591 (position, window, string)
4592 Lisp_Object position, window, string;
10d16101
KH		 4593{
4594 struct window *w;
e3ee0340 4595 EMACS_INT pos;
10d16101 4596
1701724c
KH		 4597 if (NILP (string))
4598 {
4599 CHECK_NUMBER_COERCE_MARKER (position);
4600 pos = XINT (position);
4601 if (pos < BEGV || pos >= ZV)
4602 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1701724c
KH		 4603 }
4604 else
4605 {
1701724c
KH		 4606 CHECK_NUMBER (position);
4607 CHECK_STRING (string);
4608 pos = XINT (position);
4609 if (pos < 0 || pos >= SCHARS (string))
4610 args_out_of_range (string, position);
1701724c 4611 }
10d16101
KH		 4612 if (NILP (window))
4613 window = selected_window;
4614 CHECK_LIVE_WINDOW (window);
40fb53d6 4615 w = XWINDOW (window);
10d16101 4616
40fb53d6 4617 return font_at (-1, pos, NULL, w, string);
10d16101
KH		 4618}
4619
c2f5bfd6
KH		 4620#if 0
4621DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
4622 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4623The value is a number of glyphs drawn.
4624Type C-l to recover what previously shown. */)
4625 (font_object, string)
4626 Lisp_Object font_object, string;
4627{
4628 Lisp_Object frame = selected_frame;
4629 FRAME_PTR f = XFRAME (frame);
4630 struct font *font;
4631 struct face *face;
4632 int i, len, width;
4633 unsigned *code;
4634
4635 CHECK_FONT_GET_OBJECT (font_object, font);
4636 CHECK_STRING (string);
4637 len = SCHARS (string);
4638 code = alloca (sizeof (unsigned) * len);
4639 for (i = 0; i < len; i++)
4640 {
4641 Lisp_Object ch = Faref (string, make_number (i));
4642 Lisp_Object val;
4643 int c = XINT (ch);
4644
4645 code[i] = font->driver->encode_char (font, c);
4646 if (code[i] == FONT_INVALID_CODE)
4647 break;
4648 }
4649 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4650 face->fontp = font;
4651 if (font->driver->prepare_face)
4652 font->driver->prepare_face (f, face);
4653 width = font->driver->text_extents (font, code, i, NULL);
4654 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
4655 if (font->driver->done_face)
4656 font->driver->done_face (f, face);
4657 face->fontp = NULL;
4658 return make_number (len);
4659}
4660#endif
4661
4662#endif /* FONT_DEBUG */
4663
a266686a
KH		 4664#ifdef HAVE_WINDOW_SYSTEM
4665
72606e45
KH		 4666DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
4667 doc: /* Return information about a font named NAME on frame FRAME.
4668If FRAME is omitted or nil, use the selected frame.
4669The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4670 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4671where
4672 OPENED-NAME is the name used for opening the font,
4673 FULL-NAME is the full name of the font,
4674 SIZE is the maximum bound width of the font,
4675 HEIGHT is the height of the font,
4676 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4677 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4678 how to compose characters.
4679If the named font is not yet loaded, return nil. */)
4680 (name, frame)
4681 Lisp_Object name, frame;
4682{
4683 FRAME_PTR f;
4684 struct font *font;
4685 Lisp_Object info;
4686 Lisp_Object font_object;
4687
4688 (*check_window_system_func) ();
4689
4690 if (! FONTP (name))
4691 CHECK_STRING (name);
4692 if (NILP (frame))
4693 frame = selected_frame;
4694 CHECK_LIVE_FRAME (frame);
4695 f = XFRAME (frame);
4696
4697 if (STRINGP (name))
4698 {
4699 int fontset = fs_query_fontset (name, 0);
4700
4701 if (fontset >= 0)
4702 name = fontset_ascii (fontset);
4703 font_object = font_open_by_name (f, (char *) SDATA (name));
4704 }
4705 else if (FONT_OBJECT_P (name))
4706 font_object = name;
4707 else if (FONT_ENTITY_P (name))
4708 font_object = font_open_entity (f, name, 0);
4709 else
4710 {
4711 struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4712 Lisp_Object entity = font_matching_entity (f, face->lface, name);
4713
4714 font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
4715 }
4716 if (NILP (font_object))
4717 return Qnil;
4718 font = XFONT_OBJECT (font_object);
4719
4720 info = Fmake_vector (make_number (7), Qnil);
4721 XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
4722 XVECTOR (info)->contents[1] = AREF (font_object, FONT_NAME_INDEX);
4723 XVECTOR (info)->contents[2] = make_number (font->pixel_size);
4724 XVECTOR (info)->contents[3] = make_number (font->height);
4725 XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
4726 XVECTOR (info)->contents[5] = make_number (font->relative_compose);
4727 XVECTOR (info)->contents[6] = make_number (font->default_ascent);
4728
4729#if 0
4730 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4731 close it now. Perhaps, we should manage font-objects
4732 by `reference-count'. */
4733 font_close_object (f, font_object);
4734#endif
4735 return info;
4736}
a266686a 4737#endif
72606e45 4738
c2f5bfd6 4739\f
d0ab1ebe
KH		 4740#define BUILD_STYLE_TABLE(TBL) \
4741 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4742
4743static Lisp_Object
4744build_style_table (entry, nelement)
4745 struct table_entry *entry;
4746 int nelement;
4747{
4748 int i, j;
4749 Lisp_Object table, elt;
17ab8f5d 4750
d0ab1ebe
KH		 4751 table = Fmake_vector (make_number (nelement), Qnil);
4752 for (i = 0; i < nelement; i++)
4753 {
4754 for (j = 0; entry[i].names[j]; j++);
4755 elt = Fmake_vector (make_number (j + 1), Qnil);
4756 ASET (elt, 0, make_number (entry[i].numeric));
4757 for (j = 0; entry[i].names[j]; j++)
17ab8f5d 4758 ASET (elt, j + 1, intern (entry[i].names[j]));
d0ab1ebe
KH		 4759 ASET (table, i, elt);
4760 }
4761 return table;
4762}
4763
4764static Lisp_Object Vfont_log;
4765static int font_log_env_checked;
4766
d0818984
KH		 4767/* The deferred font-log data of the form [ACTION ARG RESULT].
4768 If ACTION is not nil, that is added to the log when font_add_log is
4769 called next time. At that time, ACTION is set back to nil. */
4770static Lisp_Object Vfont_log_deferred;
4771
4772/* Prepend the font-related logging data in Vfont_log if it is not
4773 `t'. ACTION describes a kind of font-related action (e.g. listing,
4774 opening), ARG is the argument for the action, and RESULT is the
4775 result of the action. */
d0ab1ebe
KH		 4776void
4777font_add_log (action, arg, result)
4778 char *action;
4779 Lisp_Object arg, result;
4780{
4781 Lisp_Object tail, val;
4782 int i;
4783
4784 if (! font_log_env_checked)
4785 {
4786 Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
4787 font_log_env_checked = 1;
4788 }
4789 if (EQ (Vfont_log, Qt))
4790 return;
d0818984
KH		 4791 if (STRINGP (AREF (Vfont_log_deferred, 0)))
4792 {
071132a9 4793 char *str = (char *) SDATA (AREF (Vfont_log_deferred, 0));
d0818984
KH		 4794
4795 ASET (Vfont_log_deferred, 0, Qnil);
4796 font_add_log (str, AREF (Vfont_log_deferred, 1),
4797 AREF (Vfont_log_deferred, 2));
4798 }
4799
d0ab1ebe 4800 if (FONTP (arg))
db716644
KH		 4801 {
4802 Lisp_Object tail, elt;
4803 Lisp_Object equalstr = build_string ("=");
4804
4805 val = Ffont_xlfd_name (arg, Qt);
4806 for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
4807 tail = XCDR (tail))
4808 {
4809 elt = XCAR (tail);
4810 if (EQ (XCAR (elt), QCscript))
4811 val = concat3 (val, SYMBOL_NAME (QCscript),
4812 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
4813 else if (EQ (XCAR (elt), QClang))
4814 val = concat3 (val, SYMBOL_NAME (QClang),
4815 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
4816 else if (EQ (XCAR (elt), QCotf) && CONSP (XCDR (elt)))
4817 val = concat3 (val, SYMBOL_NAME (QCotf),
4818 concat2 (equalstr,
4819 SYMBOL_NAME (XCAR (XCDR (elt)))));
4820 }
4821 arg = val;
4822 }
d0ab1ebe 4823 if (FONTP (result))
d26424c5
KH		 4824 {
4825 val = Ffont_xlfd_name (result, Qt);
4826 if (! FONT_SPEC_P (result))
4827 val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
4828 build_string (":"), val);
4829 result = val;
4830 }
d0ab1ebe
KH		 4831 else if (CONSP (result))
4832 {
4833 result = Fcopy_sequence (result);
4834 for (tail = result; CONSP (tail); tail = XCDR (tail))
4835 {
4836 val = XCAR (tail);
4837 if (FONTP (val))
4838 val = Ffont_xlfd_name (val, Qt);
4839 XSETCAR (tail, val);
4840 }
4841 }
4842 else if (VECTORP (result))
4843 {
4844 result = Fcopy_sequence (result);
4845 for (i = 0; i < ASIZE (result); i++)
4846 {
4847 val = AREF (result, i);
4848 if (FONTP (val))
4849 val = Ffont_xlfd_name (val, Qt);
4850 ASET (result, i, val);
4851 }
4852 }
4853 Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
4854}
4855
d0818984
KH		 4856/* Record a font-related logging data to be added to Vfont_log when
4857 font_add_log is called next time. ACTION, ARG, RESULT are the same
4858 as font_add_log. */
4859
4860void
4861font_deferred_log (action, arg, result)
4862 char *action;
4863 Lisp_Object arg, result;
4864{
4865 ASET (Vfont_log_deferred, 0, build_string (action));
4866 ASET (Vfont_log_deferred, 1, arg);
4867 ASET (Vfont_log_deferred, 2, result);
4868}
4869
c2f5bfd6
KH		 4870extern void syms_of_ftfont P_ (());
4871extern void syms_of_xfont P_ (());
4872extern void syms_of_xftfont P_ (());
4873extern void syms_of_ftxfont P_ (());
4874extern void syms_of_bdffont P_ (());
4875extern void syms_of_w32font P_ (());
4876extern void syms_of_atmfont P_ (());
edfda783 4877extern void syms_of_nsfont P_ (());
c2f5bfd6
KH		 4878
4879void
4880syms_of_font ()
4881{
4007dd1c
KH		 4882 sort_shift_bits[FONT_TYPE_INDEX] = 0;
4883 sort_shift_bits[FONT_SLANT_INDEX] = 2;
4884 sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
4885 sort_shift_bits[FONT_SIZE_INDEX] = 16;
4886 sort_shift_bits[FONT_WIDTH_INDEX] = 23;
4887 /* Note that the other elements in sort_shift_bits are not used. */
c2f5bfd6 4888
1701724c
KH		 4889 staticpro (&font_charset_alist);
4890 font_charset_alist = Qnil;
4891
35027d0c
KH		 4892 DEFSYM (Qfont_spec, "font-spec");
4893 DEFSYM (Qfont_entity, "font-entity");
4894 DEFSYM (Qfont_object, "font-object");
4895
e0708580 4896 DEFSYM (Qopentype, "opentype");
c2f5bfd6 4897
9e1bb909 4898 DEFSYM (Qascii_0, "ascii-0");
1bb1d99b
KH		 4899 DEFSYM (Qiso8859_1, "iso8859-1");
4900 DEFSYM (Qiso10646_1, "iso10646-1");
4901 DEFSYM (Qunicode_bmp, "unicode-bmp");
cf96c5c2 4902 DEFSYM (Qunicode_sip, "unicode-sip");
1bb1d99b 4903
071132a9
KH		 4904 DEFSYM (QCf, "Cf");
4905
c2f5bfd6 4906 DEFSYM (QCotf, ":otf");
35027d0c 4907 DEFSYM (QClang, ":lang");
c2f5bfd6 4908 DEFSYM (QCscript, ":script");
4c496d0d 4909 DEFSYM (QCantialias, ":antialias");
c2f5bfd6
KH		 4910
4911 DEFSYM (QCfoundry, ":foundry");
4912 DEFSYM (QCadstyle, ":adstyle");
4913 DEFSYM (QCregistry, ":registry");
9331887d
KH		 4914 DEFSYM (QCspacing, ":spacing");
4915 DEFSYM (QCdpi, ":dpi");
ec6fe57c 4916 DEFSYM (QCscalable, ":scalable");
35027d0c
KH		 4917 DEFSYM (QCavgwidth, ":avgwidth");
4918 DEFSYM (QCfont_entity, ":font-entity");
4919 DEFSYM (QCfc_unknown_spec, ":fc-unknown-spec");
c2f5bfd6 4920
ec6fe57c
KH		 4921 DEFSYM (Qc, "c");
4922 DEFSYM (Qm, "m");
4923 DEFSYM (Qp, "p");
4924 DEFSYM (Qd, "d");
4925
c2f5bfd6
KH		 4926 staticpro (&null_vector);
4927 null_vector = Fmake_vector (make_number (0), Qnil);
4928
4929 staticpro (&scratch_font_spec);
4930 scratch_font_spec = Ffont_spec (0, NULL);
4931 staticpro (&scratch_font_prefer);
4932 scratch_font_prefer = Ffont_spec (0, NULL);
4933
d0818984
KH		 4934 staticpro (&Vfont_log_deferred);
4935 Vfont_log_deferred = Fmake_vector (make_number (3), Qnil);
4936
6a3dadd2 4937#if 0
733fd013
KH		 4938#ifdef HAVE_LIBOTF
4939 staticpro (&otf_list);
4940 otf_list = Qnil;
6a3dadd2
KH		 4941#endif /* HAVE_LIBOTF */
4942#endif /* 0 */
733fd013 4943
c2f5bfd6
KH		 4944 defsubr (&Sfontp);
4945 defsubr (&Sfont_spec);
4946 defsubr (&Sfont_get);
51cf11be 4947#ifdef HAVE_WINDOW_SYSTEM
b1868a1a 4948 defsubr (&Sfont_face_attributes);
51cf11be 4949#endif
c2f5bfd6
KH		 4950 defsubr (&Sfont_put);
4951 defsubr (&Slist_fonts);
35027d0c 4952 defsubr (&Sfont_family_list);
c2f5bfd6
KH		 4953 defsubr (&Sfind_font);
4954 defsubr (&Sfont_xlfd_name);
4955 defsubr (&Sclear_font_cache);
071132a9 4956 defsubr (&Sfont_shape_gstring);
6a3dadd2 4957#if 0
733fd013 4958 defsubr (&Sfont_drive_otf);
e80e09b4 4959 defsubr (&Sfont_otf_alternates);
6a3dadd2 4960#endif /* 0 */
c2f5bfd6
KH		 4961
4962#ifdef FONT_DEBUG
4963 defsubr (&Sopen_font);
4964 defsubr (&Sclose_font);
4965 defsubr (&Squery_font);
4966 defsubr (&Sget_font_glyphs);
ec6fe57c 4967 defsubr (&Sfont_match_p);
10d16101 4968 defsubr (&Sfont_at);
c2f5bfd6
KH		 4969#if 0
4970 defsubr (&Sdraw_string);
4971#endif
4972#endif /* FONT_DEBUG */
a266686a 4973#ifdef HAVE_WINDOW_SYSTEM
72606e45 4974 defsubr (&Sfont_info);
a266686a 4975#endif
c2f5bfd6 4976
819e81df
KH		 4977 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
4978 doc: /*
4979Alist of fontname patterns vs the corresponding encoding and repertory info.
4980Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4981where ENCODING is a charset or a char-table,
4982and REPERTORY is a charset, a char-table, or nil.
4983
027a33c0 4984If ENCODING and REPERTORY are the same, the element can have the form
819e81df
KH		 4985\(REGEXP . ENCODING).
4986
4987ENCODING is for converting a character to a glyph code of the font.
4988If ENCODING is a charset, encoding a character by the charset gives
4989the corresponding glyph code. If ENCODING is a char-table, looking up
4990the table by a character gives the corresponding glyph code.
4991
4992REPERTORY specifies a repertory of characters supported by the font.
4993If REPERTORY is a charset, all characters beloging to the charset are
4994supported. If REPERTORY is a char-table, all characters who have a
027a33c0 4995non-nil value in the table are supported. If REPERTORY is nil, Emacs
819e81df
KH		 4996gets the repertory information by an opened font and ENCODING. */);
4997 Vfont_encoding_alist = Qnil;
4998
d0ab1ebe
KH		 4999 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table,
5000 doc: /* Vector of valid font weight values.
5001Each element has the form:
5002 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
17ab8f5d 5003NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
d0ab1ebe
KH		 5004 Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
5005
5006 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table,
5007 doc: /* Vector of font slant symbols vs the corresponding numeric values.
17ab8f5d 5008See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5009 Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
5010
5011 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table,
5012 doc: /* Alist of font width symbols vs the corresponding numeric values.
17ab8f5d 5013See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5014 Vfont_width_table = BUILD_STYLE_TABLE (width_table);
5015
5016 staticpro (&font_style_table);
5017 font_style_table = Fmake_vector (make_number (3), Qnil);
5018 ASET (font_style_table, 0, Vfont_weight_table);
5019 ASET (font_style_table, 1, Vfont_slant_table);
5020 ASET (font_style_table, 2, Vfont_width_table);
5021
5022 DEFVAR_LISP ("font-log", &Vfont_log, doc: /*
5023*Logging list of font related actions and results.
5024The value t means to suppress the logging.
5025The initial value is set to nil if the environment variable
5026EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5027 Vfont_log = Qnil;
5028
819e81df 5029#ifdef HAVE_WINDOW_SYSTEM
c2f5bfd6 5030#ifdef HAVE_FREETYPE
35027d0c 5031 syms_of_ftfont ();
c2f5bfd6 5032#ifdef HAVE_X_WINDOWS
35027d0c
KH		 5033 syms_of_xfont ();
5034 syms_of_ftxfont ();
c2f5bfd6 5035#ifdef HAVE_XFT
35027d0c 5036 syms_of_xftfont ();
c2f5bfd6
KH		 5037#endif /* HAVE_XFT */
5038#endif /* HAVE_X_WINDOWS */
5039#else /* not HAVE_FREETYPE */
5040#ifdef HAVE_X_WINDOWS
35027d0c 5041 syms_of_xfont ();
c2f5bfd6
KH		 5042#endif /* HAVE_X_WINDOWS */
5043#endif /* not HAVE_FREETYPE */
5044#ifdef HAVE_BDFFONT
35027d0c 5045 syms_of_bdffont ();
c2f5bfd6
KH		 5046#endif /* HAVE_BDFFONT */
5047#ifdef WINDOWSNT
35027d0c 5048 syms_of_w32font ();
c2f5bfd6 5049#endif /* WINDOWSNT */
edfda783
AR		 5050#ifdef HAVE_NS
5051 syms_of_nsfont ();
5052#endif /* HAVE_NS */
819e81df 5053#endif /* HAVE_WINDOW_SYSTEM */
c2f5bfd6 5054}
885b7d09
MB		 5055
5056/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5057 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.