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