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