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