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