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