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