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