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