HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Add 2009 to copyright years.
[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 {
35027d0c 3385 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
733fd013
KH		 3386
3387 pt /= 10;
3388 size = POINT_TO_PIXEL (pt, f->resy);
ed96cde8
AR		 3389#ifdef HAVE_NS
3390 if (size == 0)
3391 {
3392 Lisp_Object ffsize = get_frame_param(f, Qfontsize);
3393 size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
3394 }
3395#endif
733fd013 3396 }
c2f5bfd6
KH		 3397 return font_open_entity (f, entity, size);
3398}
3399
45eb10fb 3400
35027d0c
KH		 3401/* Find a font satisfying SPEC and best matching with face's
3402 attributes in ATTRS on FRAME, and return the opened
3403 font-object. */
45eb10fb 3404
35027d0c
KH		 3405Lisp_Object
3406font_load_for_lface (f, attrs, spec)
c2f5bfd6 3407 FRAME_PTR f;
35027d0c 3408 Lisp_Object *attrs, spec;
c2f5bfd6 3409{
35027d0c 3410 Lisp_Object entity;
ef18374f 3411
35027d0c
KH		 3412 entity = font_find_for_lface (f, attrs, spec, -1);
3413 if (NILP (entity))
ef18374f 3414 {
35027d0c
KH		 3415 /* No font is listed for SPEC, but each font-backend may have
3416 the different criteria about "font matching". So, try
3417 it. */
3418 entity = font_matching_entity (f, attrs, spec);
3419 if (NILP (entity))
3420 return Qnil;
c2f5bfd6 3421 }
35027d0c 3422 return font_open_for_lface (f, entity, attrs, spec);
c2f5bfd6
KH		 3423}
3424
45eb10fb
KH		 3425
3426/* Make FACE on frame F ready to use the font opened for FACE. */
3427
c2f5bfd6
KH		 3428void
3429font_prepare_for_face (f, face)
3430 FRAME_PTR f;
3431 struct face *face;
3432{
35027d0c
KH		 3433 if (face->font->driver->prepare_face)
3434 face->font->driver->prepare_face (f, face);
c2f5bfd6
KH		 3435}
3436
45eb10fb
KH		 3437
3438/* Make FACE on frame F stop using the font opened for FACE. */
3439
c2f5bfd6
KH		 3440void
3441font_done_for_face (f, face)
3442 FRAME_PTR f;
3443 struct face *face;
3444{
35027d0c
KH		 3445 if (face->font->driver->done_face)
3446 face->font->driver->done_face (f, face);
c2f5bfd6
KH		 3447 face->extra = NULL;
3448}
3449
45eb10fb
KH		 3450
3451/* Open a font best matching with NAME on frame F. If no proper font
3452 is found, return Qnil. */
3453
c2f5bfd6
KH		 3454Lisp_Object
3455font_open_by_name (f, name)
3456 FRAME_PTR f;
3457 char *name;
3458{
ef18374f 3459 Lisp_Object args[2];
4007dd1c 3460 Lisp_Object spec, attrs[LFACE_VECTOR_SIZE];
a9262bb8 3461
ef18374f
KH		 3462 args[0] = QCname;
3463 args[1] = make_unibyte_string (name, strlen (name));
3464 spec = Ffont_spec (2, args);
4007dd1c
KH		 3465 /* We set up the default font-related attributes of a face to prefer
3466 a moderate font. */
3467 attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
3468 attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
3469 = attrs[LFACE_SLANT_INDEX] = Qnormal;
ed96cde8 3470#ifndef HAVE_NS
4007dd1c 3471 attrs[LFACE_HEIGHT_INDEX] = make_number (120);
ed96cde8
AR		 3472#else
3473 attrs[LFACE_HEIGHT_INDEX] = make_number (0);
3474#endif
4007dd1c
KH		 3475 attrs[LFACE_FONT_INDEX] = Qnil;
3476
3477 return font_load_for_lface (f, attrs, spec);
c2f5bfd6
KH		 3478}
3479
3480
3481/* Register font-driver DRIVER. This function is used in two ways.
3482
417a1b10
KH		 3483 The first is with frame F non-NULL. In this case, make DRIVER
3484 available (but not yet activated) on F. All frame creaters
3485 (e.g. Fx_create_frame) must call this function at least once with
3486 an available font-driver.
c2f5bfd6
KH		 3487
3488 The second is with frame F NULL. In this case, DRIVER is globally
3489 registered in the variable `font_driver_list'. All font-driver
3490 implementations must call this function in its syms_of_XXXX
3491 (e.g. syms_of_xfont). */
3492
3493void
3494register_font_driver (driver, f)
3495 struct font_driver *driver;
3496 FRAME_PTR f;
3497{
3498 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
3499 struct font_driver_list *prev, *list;
3500
3501 if (f && ! driver->draw)
43a1d19b 3502 error ("Unusable font driver for a frame: %s",
c2f5bfd6
KH		 3503 SDATA (SYMBOL_NAME (driver->type)));
3504
3505 for (prev = NULL, list = root; list; prev = list, list = list->next)
cf23b845 3506 if (EQ (list->driver->type, driver->type))
c2f5bfd6
KH		 3507 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
3508
c115043b 3509 list = xmalloc (sizeof (struct font_driver_list));
417a1b10 3510 list->on = 0;
c2f5bfd6
KH		 3511 list->driver = driver;
3512 list->next = NULL;
3513 if (prev)
3514 prev->next = list;
3515 else if (f)
3516 f->font_driver_list = list;
3517 else
3518 font_driver_list = list;
72606e45
KH		 3519 if (! f)
3520 num_font_drivers++;
c2f5bfd6
KH		 3521}
3522
2ed98482
CY		 3523void
3524free_font_driver_list (f)
3525 FRAME_PTR f;
3526{
3527 struct font_driver_list *list, *next;
3528
3529 for (list = f->font_driver_list; list; list = next)
3530 {
3531 next = list->next;
3532 xfree (list);
3533 }
3534 f->font_driver_list = NULL;
3535}
3536
45eb10fb 3537
f697fff0 3538/* Make the frame F use font backends listed in NEW_DRIVERS (list of
ca4da08a
KH		 3539 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3540 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
417a1b10 3541
ca4da08a
KH		 3542 A caller must free all realized faces if any in advance. The
3543 return value is a list of font backends actually made used on
3544 F. */
e950d6f1
KH		 3545
3546Lisp_Object
3547font_update_drivers (f, new_drivers)
417a1b10
KH		 3548 FRAME_PTR f;
3549 Lisp_Object new_drivers;
417a1b10
KH		 3550{
3551 Lisp_Object active_drivers = Qnil;
4007dd1c 3552 struct font_driver *driver;
417a1b10
KH		 3553 struct font_driver_list *list;
3554
4007dd1c
KH		 3555 /* At first, turn off non-requested drivers, and turn on requested
3556 drivers. */
f697fff0 3557 for (list = f->font_driver_list; list; list = list->next)
4007dd1c
KH		 3558 {
3559 driver = list->driver;
3560 if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers)))
3561 != list->on)
3562 {
3563 if (list->on)
3564 {
3565 if (driver->end_for_frame)
3566 driver->end_for_frame (f);
3567 font_finish_cache (f, driver);
3568 list->on = 0;
3569 }
3570 else
3571 {
3572 if (! driver->start_for_frame
3573 || driver->start_for_frame (f) == 0)
3574 {
3575 font_prepare_cache (f, driver);
3576 list->on = 1;
3577 }
3578 }
3579 }
3580 }
3581
3582 if (NILP (new_drivers))
3583 return Qnil;
3584
3585 if (! EQ (new_drivers, Qt))
3586 {
3587 /* Re-order the driver list according to new_drivers. */
3306c6dc 3588 struct font_driver_list **list_table, **next;
4007dd1c
KH		 3589 Lisp_Object tail;
3590 int i;
3591
3592 list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
3593 for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
3594 {
3595 for (list = f->font_driver_list; list; list = list->next)
3596 if (list->on && EQ (list->driver->type, XCAR (tail)))
3597 break;
3598 if (list)
3599 list_table[i++] = list;
3600 }
3601 for (list = f->font_driver_list; list; list = list->next)
3602 if (! list->on)
6136b72f 3603 list_table[i++] = list;
4007dd1c
KH		 3604 list_table[i] = NULL;
3605
3306c6dc 3606 next = &f->font_driver_list;
4007dd1c
KH		 3607 for (i = 0; list_table[i]; i++)
3608 {
3306c6dc
AS		 3609 *next = list_table[i];
3610 next = &(*next)->next;
4007dd1c 3611 }
3306c6dc 3612 *next = NULL;
4007dd1c 3613 }
417a1b10 3614
4007dd1c
KH		 3615 for (list = f->font_driver_list; list; list = list->next)
3616 if (list->on)
3617 active_drivers = nconc2 (active_drivers,
3618 Fcons (list->driver->type, Qnil));
e950d6f1 3619 return active_drivers;
417a1b10
KH		 3620}
3621
f697fff0
KH		 3622int
3623font_put_frame_data (f, driver, data)
3624 FRAME_PTR f;
3625 struct font_driver *driver;
3626 void *data;
3627{
3628 struct font_data_list *list, *prev;
3629
3630 for (prev = NULL, list = f->font_data_list; list;
3631 prev = list, list = list->next)
3632 if (list->driver == driver)
3633 break;
3634 if (! data)
3635 {
3636 if (list)
3637 {
3638 if (prev)
3639 prev->next = list->next;
3640 else
3641 f->font_data_list = list->next;
3642 free (list);
3643 }
3644 return 0;
3645 }
3646
3647 if (! list)
3648 {
c115043b 3649 list = xmalloc (sizeof (struct font_data_list));
f697fff0
KH		 3650 list->driver = driver;
3651 list->next = f->font_data_list;
3652 f->font_data_list = list;
3653 }
3654 list->data = data;
3655 return 0;
3656}
3657
3658
3659void *
3660font_get_frame_data (f, driver)
3661 FRAME_PTR f;
3662 struct font_driver *driver;
3663{
3664 struct font_data_list *list;
3665
3666 for (list = f->font_data_list; list; list = list->next)
3667 if (list->driver == driver)
3668 break;
3669 if (! list)
3670 return NULL;
3671 return list->data;
3672}
3673
417a1b10 3674
45eb10fb 3675/* Return the font used to draw character C by FACE at buffer position
e3ee0340
KH		 3676 POS in window W. If STRING is non-nil, it is a string containing C
3677 at index POS. If C is negative, get C from the current buffer or
3678 STRING. */
45eb10fb 3679
10d16101 3680Lisp_Object
e3ee0340 3681font_at (c, pos, face, w, string)
10d16101
KH		 3682 int c;
3683 EMACS_INT pos;
3684 struct face *face;
3685 struct window *w;
e3ee0340 3686 Lisp_Object string;
10d16101
KH		 3687{
3688 FRAME_PTR f;
e3ee0340 3689 int multibyte;
35027d0c 3690 Lisp_Object font_object;
e3ee0340 3691
e500c47d
KH		 3692 multibyte = (NILP (string)
3693 ? ! NILP (current_buffer->enable_multibyte_characters)
3694 : STRING_MULTIBYTE (string));
e3ee0340
KH		 3695 if (c < 0)
3696 {
3697 if (NILP (string))
3698 {
e3ee0340
KH		 3699 if (multibyte)
3700 {
3701 EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
3702
3703 c = FETCH_CHAR (pos_byte);
3704 }
3705 else
3706 c = FETCH_BYTE (pos);
3707 }
3708 else
3709 {
3710 unsigned char *str;
3711
3712 multibyte = STRING_MULTIBYTE (string);
3713 if (multibyte)
3714 {
3715 EMACS_INT pos_byte = string_char_to_byte (string, pos);
3716
3717 str = SDATA (string) + pos_byte;
3718 c = STRING_CHAR (str, 0);
3719 }
3720 else
3721 c = SDATA (string)[pos];
3722 }
3723 }
10d16101
KH		 3724
3725 f = XFRAME (w->frame);
1385a806
KH		 3726 if (! FRAME_WINDOW_P (f))
3727 return Qnil;
10d16101
KH		 3728 if (! face)
3729 {
e3ee0340 3730 int face_id;
0f8b27ea 3731 EMACS_INT endptr;
e3ee0340
KH		 3732
3733 if (STRINGP (string))
3734 face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
10d16101
KH		 3735 DEFAULT_FACE_ID, 0);
3736 else
e3ee0340 3737 face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
10d16101
KH		 3738 pos + 100, 0);
3739 face = FACE_FROM_ID (f, face_id);
3740 }
e3ee0340
KH		 3741 if (multibyte)
3742 {
3743 int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
3744 face = FACE_FROM_ID (f, face_id);
3745 }
35027d0c 3746 if (! face->font)
10d16101 3747 return Qnil;
35027d0c 3748
35027d0c
KH		 3749 XSETFONT (font_object, face->font);
3750 return font_object;
3751}
3752
3753
071132a9
KH		 3754#ifdef HAVE_WINDOW_SYSTEM
3755
3756/* Check how many characters after POS (at most to *LIMIT) can be
3757 displayed by the same font on the window W. FACE, if non-NULL, is
3758 the face selected for the character at POS. If STRING is not nil,
3759 it is the string to check instead of the current buffer. In that
3760 case, FACE must be not NULL.
027a33c0 3761
071132a9
KH		 3762 The return value is the font-object for the character at POS.
3763 *LIMIT is set to the position where that font can't be used.
35027d0c 3764
071132a9
KH		 3765 It is assured that the current buffer (or STRING) is multibyte. */
3766
3767Lisp_Object
3768font_range (pos, limit, w, face, string)
3769 EMACS_INT pos, *limit;
3770 struct window *w;
35027d0c 3771 struct face *face;
35027d0c
KH		 3772 Lisp_Object string;
3773{
071132a9 3774 EMACS_INT pos_byte, ignore, start, start_byte;
35027d0c 3775 int c;
071132a9 3776 Lisp_Object font_object = Qnil;
35027d0c
KH		 3777
3778 if (NILP (string))
3779 {
35027d0c 3780 pos_byte = CHAR_TO_BYTE (pos);
071132a9
KH		 3781 if (! face)
3782 {
3783 int face_id;
3784
3785 face_id = face_at_buffer_position (w, pos, 0, 0, &ignore, *limit, 0);
3786 face = FACE_FROM_ID (XFRAME (w->frame), face_id);
3787 }
35027d0c
KH		 3788 }
3789 else
3790 {
071132a9 3791 font_assert (face);
35027d0c
KH		 3792 pos_byte = string_char_to_byte (string, pos);
3793 }
3794
071132a9
KH		 3795 start = pos, start_byte = pos_byte;
3796 while (pos < *limit)
35027d0c 3797 {
071132a9 3798 Lisp_Object category;
35027d0c
KH		 3799
3800 if (NILP (string))
3801 FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
3802 else
3803 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
071132a9 3804 if (NILP (font_object))
35027d0c 3805 {
071132a9
KH		 3806 font_object = font_for_char (face, c, pos - 1, string);
3807 if (NILP (font_object))
3808 return Qnil;
35027d0c
KH		 3809 continue;
3810 }
071132a9
KH		 3811
3812 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3813 if (! EQ (category, QCf)
78a2f9cd 3814 && ! CHAR_VARIATION_SELECTOR_P (c)
071132a9 3815 && font_encode_char (font_object, c) == FONT_INVALID_CODE)
35027d0c 3816 {
071132a9
KH		 3817 Lisp_Object f = font_for_char (face, c, pos - 1, string);
3818 EMACS_INT i, i_byte;
3819
3820
3821 if (NILP (f))
3822 {
3823 *limit = pos - 1;
3824 return font_object;
3825 }
3826 i = start, i_byte = start_byte;
3827 while (i < pos - 1)
3828 {
3829
3830 if (NILP (string))
3831 FETCH_CHAR_ADVANCE_NO_CHECK (c, i, i_byte);
3832 else
3833 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, i, i_byte);
3834 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3835 if (! EQ (category, QCf)
78a2f9cd 3836 && ! CHAR_VARIATION_SELECTOR_P (c)
071132a9
KH		 3837 && font_encode_char (f, c) == FONT_INVALID_CODE)
3838 {
3839 *limit = pos - 1;
3840 return font_object;
3841 }
3842 }
3843 font_object = f;
35027d0c
KH		 3844 }
3845 }
071132a9 3846 return font_object;
10d16101 3847}
071132a9 3848#endif
10d16101 3849
c2f5bfd6
KH		 3850\f
3851/* Lisp API */
3852
35027d0c 3853DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
6c8ec042 3854 doc: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
35027d0c
KH		 3855Return nil otherwise.
3856Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
027a33c0 3857which kind of font it is. It must be one of `font-spec', `font-entity',
35027d0c
KH		 3858`font-object'. */)
3859 (object, extra_type)
3860 Lisp_Object object, extra_type;
c2f5bfd6 3861{
35027d0c
KH		 3862 if (NILP (extra_type))
3863 return (FONTP (object) ? Qt : Qnil);
3864 if (EQ (extra_type, Qfont_spec))
3865 return (FONT_SPEC_P (object) ? Qt : Qnil);
3866 if (EQ (extra_type, Qfont_entity))
3867 return (FONT_ENTITY_P (object) ? Qt : Qnil);
3868 if (EQ (extra_type, Qfont_object))
3869 return (FONT_OBJECT_P (object) ? Qt : Qnil);
3870 wrong_type_argument (intern ("font-extra-type"), extra_type);
c2f5bfd6
KH		 3871}
3872
3873DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
45eb10fb
KH		 3874 doc: /* Return a newly created font-spec with arguments as properties.
3875
3876ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3877valid font property name listed below:
3878
3879`:family', `:weight', `:slant', `:width'
3880
3881They are the same as face attributes of the same name. See
51c01100 3882`set-face-attribute'.
45eb10fb
KH		 3883
3884`:foundry'
3885
3886VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3887
3888`:adstyle'
3889
3890VALUE must be a string or a symbol specifying the additional
35027d0c 3891typographic style information of a font, e.g. ``sans''.
45eb10fb
KH		 3892
3893`:registry'
3894
3895VALUE must be a string or a symbol specifying the charset registry and
3896encoding of a font, e.g. ``iso8859-1''.
3897
3898`:size'
3899
3900VALUE must be a non-negative integer or a floating point number
35027d0c 3901specifying the font size. It specifies the font size in pixels
f697fff0 3902(if VALUE is an integer), or in points (if VALUE is a float).
2babb359
KH		 3903
3904`:name'
3905
7a18a178 3906VALUE must be a string of XLFD-style or fontconfig-style font name.
5bdd4dd2
KH		 3907
3908`:script'
3909
3910VALUE must be a symbol representing a script that the font must
ba3de0e8
JB		 3911support.
3912usage: (font-spec ARGS...) */)
c2f5bfd6
KH		 3913 (nargs, args)
3914 int nargs;
3915 Lisp_Object *args;
3916{
35027d0c 3917 Lisp_Object spec = font_make_spec ();
c2f5bfd6
KH		 3918 int i;
3919
3920 for (i = 0; i < nargs; i += 2)
3921 {
c2f5bfd6
KH		 3922 Lisp_Object key = args[i], val = args[i + 1];
3923
35027d0c
KH		 3924 if (EQ (key, QCname))
3925 {
3926 CHECK_STRING (val);
3927 font_parse_name ((char *) SDATA (val), spec);
3928 font_put_extra (spec, key, val);
3929 }
c2f5bfd6 3930 else
4485a28e 3931 {
35027d0c
KH		 3932 int idx = get_font_prop_index (key);
3933
3934 if (idx >= 0)
ec6fe57c 3935 {
35027d0c
KH		 3936 val = font_prop_validate (idx, Qnil, val);
3937 if (idx < FONT_EXTRA_INDEX)
3938 ASET (spec, idx, val);
3939 else
3940 font_put_extra (spec, key, val);
ec6fe57c 3941 }
35027d0c
KH		 3942 else
3943 font_put_extra (spec, key, font_prop_validate (0, key, val));
4485a28e 3944 }
e950d6f1 3945 }
c2f5bfd6
KH		 3946 return spec;
3947}
3948
35027d0c
KH		 3949DEFUN ("copy-font-spec", Fcopy_font_spec, Scopy_font_spec, 1, 1, 0,
3950 doc: /* Return a copy of FONT as a font-spec. */)
3951 (font)
3952 Lisp_Object font;
3953{
d26424c5 3954 Lisp_Object new_spec, tail, prev, extra;
35027d0c
KH		 3955 int i;
3956
3957 CHECK_FONT (font);
3958 new_spec = font_make_spec ();
3959 for (i = 1; i < FONT_EXTRA_INDEX; i++)
3960 ASET (new_spec, i, AREF (font, i));
d26424c5
KH		 3961 extra = Fcopy_sequence (AREF (font, FONT_EXTRA_INDEX));
3962 /* We must remove :font-entity property. */
3963 for (prev = Qnil, tail = extra; CONSP (tail); prev = tail, tail = XCDR (tail))
3964 if (EQ (XCAR (XCAR (tail)), QCfont_entity))
3965 {
3966 if (NILP (prev))
3967 extra = XCDR (extra);
3968 else
3969 XSETCDR (prev, XCDR (tail));
3970 break;
3971 }
35027d0c
KH		 3972 ASET (new_spec, FONT_EXTRA_INDEX, extra);
3973 return new_spec;
3974}
3975
3976DEFUN ("merge-font-spec", Fmerge_font_spec, Smerge_font_spec, 2, 2, 0,
3977 doc: /* Merge font-specs FROM and TO, and return a new font-spec.
3978Every specified properties in FROM override the corresponding
3979properties in TO. */)
3980 (from, to)
3981 Lisp_Object from, to;
3982{
3983 Lisp_Object extra, tail;
3984 int i;
3985
3986 CHECK_FONT (from);
3987 CHECK_FONT (to);
3988 to = Fcopy_font_spec (to);
3989 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3990 ASET (to, i, AREF (from, i));
3991 extra = AREF (to, FONT_EXTRA_INDEX);
3992 for (tail = AREF (from, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
3993 if (! EQ (XCAR (XCAR (tail)), Qfont_entity))
3994 {
3995 Lisp_Object slot = assq_no_quit (XCAR (XCAR (tail)), extra);
3996
3997 if (! NILP (slot))
3998 XSETCDR (slot, XCDR (XCAR (tail)));
3999 else
4000 extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
4001 }
4002 ASET (to, FONT_EXTRA_INDEX, extra);
4003 return to;
4004}
c2f5bfd6
KH		 4005
4006DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
45eb10fb 4007 doc: /* Return the value of FONT's property KEY.
5bdd4dd2
KH		 4008FONT is a font-spec, a font-entity, or a font-object.
4009KEY must be one of these symbols:
4010 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4011 :size, :name, :script
4012See the documentation of `font-spec' for their meanings.
4013If FONT is a font-entity or font-object, the value of :script may be
4014a list of scripts that are supported by the font. */)
45eb10fb
KH		 4015 (font, key)
4016 Lisp_Object font, key;
c2f5bfd6 4017{
35027d0c 4018 int idx;
c2f5bfd6 4019
35027d0c
KH		 4020 CHECK_FONT (font);
4021 CHECK_SYMBOL (key);
e80e09b4 4022
35027d0c 4023 idx = get_font_prop_index (key);
2babb359
KH		 4024 if (idx >= FONT_WEIGHT_INDEX && idx <= FONT_WIDTH_INDEX)
4025 return font_style_symbolic (font, idx, 0);
35027d0c 4026 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
c2f5bfd6 4027 return AREF (font, idx);
35027d0c 4028 return Fcdr (Fassq (key, AREF (font, FONT_EXTRA_INDEX)));
c2f5bfd6
KH		 4029}
4030
51cf11be
AS		 4031#ifdef HAVE_WINDOW_SYSTEM
4032
b1868a1a
CY		 4033DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1, 2, 0,
4034 doc: /* Return a plist of face attributes generated by FONT.
4035FONT is a font name, a font-spec, a font-entity, or a font-object.
4036The return value is a list of the form
4037
6f568955 4038\(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
b1868a1a 4039
48105a6a 4040where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
5989ba2f
CY		 4041compatible with `set-face-attribute'. Some of these key-attribute pairs
4042may be omitted from the list if they are not specified by FONT.
b1868a1a 4043
48105a6a
JB		 4044The optional argument FRAME specifies the frame that the face attributes
4045are to be displayed on. If omitted, the selected frame is used. */)
b1868a1a 4046 (font, frame)
6f568955 4047 Lisp_Object font, frame;
b1868a1a
CY		 4048{
4049 struct frame *f;
4050 Lisp_Object plist[10];
4051 Lisp_Object val;
5989ba2f 4052 int n = 0;
b1868a1a
CY		 4053
4054 if (NILP (frame))
4055 frame = selected_frame;
4056 CHECK_LIVE_FRAME (frame);
4057 f = XFRAME (frame);
4058
4059 if (STRINGP (font))
4060 {
4061 int fontset = fs_query_fontset (font, 0);
4062 Lisp_Object name = font;
4063 if (fontset >= 0)
4064 font = fontset_ascii (fontset);
4065 font = font_spec_from_name (name);
4066 if (! FONTP (font))
4067 signal_error ("Invalid font name", name);
4068 }
4069 else if (! FONTP (font))
4070 signal_error ("Invalid font object", font);
4071
b1868a1a 4072 val = AREF (font, FONT_FAMILY_INDEX);
5989ba2f
CY		 4073 if (! NILP (val))
4074 {
4075 plist[n++] = QCfamily;
4076 plist[n++] = SYMBOL_NAME (val);
4077 }
b1868a1a 4078
b1868a1a
CY		 4079 val = AREF (font, FONT_SIZE_INDEX);
4080 if (INTEGERP (val))
4081 {
4082 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
4083 int dpi = INTEGERP (font_dpi) ? XINT (font_dpi) : f->resy;
5989ba2f 4084 plist[n++] = QCheight;
c3bb5465 4085 plist[n++] = make_number (PIXEL_TO_POINT (XINT (val) * 10, dpi));
b1868a1a
CY		 4086 }
4087 else if (FLOATP (val))
5989ba2f
CY		 4088 {
4089 plist[n++] = QCheight;
4090 plist[n++] = make_number (10 * (int) XFLOAT_DATA (val));
4091 }
b1868a1a 4092
b1868a1a 4093 val = FONT_WEIGHT_FOR_FACE (font);
5989ba2f
CY		 4094 if (! NILP (val))
4095 {
4096 plist[n++] = QCweight;
4097 plist[n++] = val;
4098 }
b1868a1a 4099
b1868a1a 4100 val = FONT_SLANT_FOR_FACE (font);
5989ba2f
CY		 4101 if (! NILP (val))
4102 {
4103 plist[n++] = QCslant;
4104 plist[n++] = val;
4105 }
b1868a1a 4106
b1868a1a 4107 val = FONT_WIDTH_FOR_FACE (font);
5989ba2f
CY		 4108 if (! NILP (val))
4109 {
4110 plist[n++] = QCwidth;
4111 plist[n++] = val;
4112 }
b1868a1a 4113
5989ba2f 4114 return Flist (n, plist);
b1868a1a 4115}
c2f5bfd6 4116
51cf11be
AS		 4117#endif
4118
c2f5bfd6 4119DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
51c01100 4120 doc: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
c2f5bfd6
KH		 4121 (font_spec, prop, val)
4122 Lisp_Object font_spec, prop, val;
4123{
35027d0c 4124 int idx;
c2f5bfd6
KH		 4125
4126 CHECK_FONT_SPEC (font_spec);
35027d0c
KH		 4127 idx = get_font_prop_index (prop);
4128 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
69eb9e8b 4129 ASET (font_spec, idx, font_prop_validate (idx, Qnil, val));
c2f5bfd6 4130 else
35027d0c 4131 font_put_extra (font_spec, prop, font_prop_validate (0, prop, val));
c2f5bfd6
KH		 4132 return val;
4133}
4134
4135DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
4136 doc: /* List available fonts matching FONT-SPEC on the current frame.
4137Optional 2nd argument FRAME specifies the target frame.
4138Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
45eb10fb
KH		 4139Optional 4th argument PREFER, if non-nil, is a font-spec to
4140control the order of the returned list. Fonts are sorted by
027a33c0 4141how close they are to PREFER. */)
c2f5bfd6
KH		 4142 (font_spec, frame, num, prefer)
4143 Lisp_Object font_spec, frame, num, prefer;
4144{
4145 Lisp_Object vec, list, tail;
4146 int n = 0, i, len;
4147
4148 if (NILP (frame))
4149 frame = selected_frame;
4150 CHECK_LIVE_FRAME (frame);
35027d0c 4151 CHECK_FONT_SPEC (font_spec);
c2f5bfd6
KH		 4152 if (! NILP (num))
4153 {
4154 CHECK_NUMBER (num);
4155 n = XINT (num);
4156 if (n <= 0)
4157 return Qnil;
4158 }
4159 if (! NILP (prefer))
35027d0c 4160 CHECK_FONT_SPEC (prefer);
c2f5bfd6
KH		 4161
4162 vec = font_list_entities (frame, font_spec);
4163 len = ASIZE (vec);
4164 if (len == 0)
4165 return Qnil;
4166 if (len == 1)
4167 return Fcons (AREF (vec, 0), Qnil);
4168
4169 if (! NILP (prefer))
7181ea6a 4170 vec = font_sort_entites (vec, prefer, frame, 0);
c2f5bfd6
KH		 4171
4172 list = tail = Fcons (AREF (vec, 0), Qnil);
4173 if (n == 0 || n > len)
4174 n = len;
4175 for (i = 1; i < n; i++)
4176 {
4177 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
4178
4179 XSETCDR (tail, val);
4180 tail = val;
4181 }
4182 return list;
4183}
4184
35027d0c 4185DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
c2f5bfd6 4186 doc: /* List available font families on the current frame.
027a33c0 4187Optional argument FRAME, if non-nil, specifies the target frame. */)
c2f5bfd6
KH		 4188 (frame)
4189 Lisp_Object frame;
4190{
4191 FRAME_PTR f;
4192 struct font_driver_list *driver_list;
4193 Lisp_Object list;
4194
4195 if (NILP (frame))
4196 frame = selected_frame;
4197 CHECK_LIVE_FRAME (frame);
4198 f = XFRAME (frame);
4199 list = Qnil;
4200 for (driver_list = f->font_driver_list; driver_list;
4201 driver_list = driver_list->next)
4202 if (driver_list->driver->list_family)
4203 {
4204 Lisp_Object val = driver_list->driver->list_family (frame);
4205
4206 if (NILP (list))
4207 list = val;
4208 else
4209 {
4210 Lisp_Object tail = list;
4211
4212 for (; CONSP (val); val = XCDR (val))
4213 if (NILP (Fmemq (XCAR (val), tail)))
4214 list = Fcons (XCAR (val), list);
4215 }
4216 }
4217 return list;
4218}
4219
4220DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
4221 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
4222Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4223 (font_spec, frame)
4224 Lisp_Object font_spec, frame;
4225{
4226 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
4227
4228 if (CONSP (val))
4229 val = XCAR (val);
4230 return val;
4231}
4232
d0ab1ebe 4233DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
c2f5bfd6
KH		 4234 doc: /* Return XLFD name of FONT.
4235FONT is a font-spec, font-entity, or font-object.
d0ab1ebe
KH		 4236If the name is too long for XLFD (maximum 255 chars), return nil.
4237If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4238the consecutive wildcards are folded to one. */)
4239 (font, fold_wildcards)
4240 Lisp_Object font, fold_wildcards;
c2f5bfd6
KH		 4241{
4242 char name[256];
4243 int pixel_size = 0;
4244
35027d0c
KH		 4245 CHECK_FONT (font);
4246
4247 if (FONT_OBJECT_P (font))
c2f5bfd6 4248 {
35027d0c 4249 Lisp_Object font_name = AREF (font, FONT_NAME_INDEX);
c2f5bfd6 4250
35027d0c
KH		 4251 if (STRINGP (font_name)
4252 && SDATA (font_name)[0] == '-')
d0ab1ebe
KH		 4253 {
4254 if (NILP (fold_wildcards))
4255 return font_name;
4256 strcpy (name, (char *) SDATA (font_name));
4257 goto done;
4258 }
35027d0c 4259 pixel_size = XFONT_OBJECT (font)->pixel_size;
c2f5bfd6 4260 }
c2f5bfd6
KH		 4261 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
4262 return Qnil;
d0ab1ebe
KH		 4263 done:
4264 if (! NILP (fold_wildcards))
4265 {
4266 char *p0 = name, *p1;
4267
4268 while ((p1 = strstr (p0, "-*-*")))
4269 {
4270 strcpy (p1, p1 + 2);
4271 p0 = p1;
4272 }
4273 }
4274
c2f5bfd6
KH		 4275 return build_string (name);
4276}
4277
4278DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
4279 doc: /* Clear font cache. */)
4280 ()
4281{
4282 Lisp_Object list, frame;
4283
4284 FOR_EACH_FRAME (list, frame)
4285 {
4286 FRAME_PTR f = XFRAME (frame);
4287 struct font_driver_list *driver_list = f->font_driver_list;
4288
4289 for (; driver_list; driver_list = driver_list->next)
417a1b10
KH		 4290 if (driver_list->on)
4291 {
ca4da08a
KH		 4292 Lisp_Object cache = driver_list->driver->get_cache (f);
4293 Lisp_Object val;
51c01100 4294
ca4da08a 4295 val = XCDR (cache);
43c0454d
KH		 4296 while (! NILP (val)
4297 && ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
ca4da08a 4298 val = XCDR (val);
d0ab1ebe 4299 font_assert (! NILP (val));
ca4da08a
KH		 4300 val = XCDR (XCAR (val));
4301 if (XINT (XCAR (val)) == 0)
417a1b10 4302 {
ca4da08a
KH		 4303 font_clear_cache (f, XCAR (val), driver_list->driver);
4304 XSETCDR (cache, XCDR (val));
417a1b10 4305 }
417a1b10 4306 }
c2f5bfd6
KH		 4307 }
4308
4309 return Qnil;
4310}
4311
071132a9
KH		 4312\f
4313void
4314font_fill_lglyph_metrics (glyph, font_object)
4315 Lisp_Object glyph, font_object;
c2f5bfd6 4316{
071132a9 4317 struct font *font = XFONT_OBJECT (font_object);
f62ab7c5
EZ		 4318 unsigned code;
4319 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4320 EMACS_INT ecode = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
071132a9 4321 struct font_metrics metrics;
c2f5bfd6 4322
f62ab7c5
EZ		 4323 LGLYPH_SET_CODE (glyph, ecode);
4324 code = ecode;
071132a9
KH		 4325 font->driver->text_extents (font, &code, 1, &metrics);
4326 LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
4327 LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
4328 LGLYPH_SET_WIDTH (glyph, metrics.width);
4329 LGLYPH_SET_ASCENT (glyph, metrics.ascent);
4330 LGLYPH_SET_DESCENT (glyph, metrics.descent);
c2f5bfd6
KH		 4331}
4332
c2f5bfd6 4333
071132a9
KH		 4334DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0,
4335 doc: /* Shape the glyph-string GSTRING.
4336Shaping means substituting glyphs and/or adjusting positions of glyphs
4337to get the correct visual image of character sequences set in the
4338header of the glyph-string.
1701724c 4339
071132a9
KH		 4340If the shaping was successful, the value is GSTRING itself or a newly
4341created glyph-string. Otherwise, the value is nil. */)
4342 (gstring)
4343 Lisp_Object gstring;
1701724c
KH		 4344{
4345 struct font *font;
071132a9 4346 Lisp_Object font_object, n, glyph;
fc3a285e 4347 int i, j, from, to;
ba3de0e8 4348
071132a9
KH		 4349 if (! composition_gstring_p (gstring))
4350 signal_error ("Invalid glyph-string: ", gstring);
4351 if (! NILP (LGSTRING_ID (gstring)))
4352 return gstring;
4353 font_object = LGSTRING_FONT (gstring);
4354 CHECK_FONT_OBJECT (font_object);
35027d0c 4355 font = XFONT_OBJECT (font_object);
b876ea91
KH		 4356 if (! font->driver->shape)
4357 return Qnil;
4358
40fb53d6
KH		 4359 /* Try at most three times with larger gstring each time. */
4360 for (i = 0; i < 3; i++)
4361 {
40fb53d6
KH		 4362 n = font->driver->shape (gstring);
4363 if (INTEGERP (n))
4364 break;
071132a9
KH		 4365 gstring = larger_vector (gstring,
4366 ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
4367 Qnil);
40fb53d6 4368 }
071132a9 4369 if (i == 3 || XINT (n) == 0)
1701724c 4370 return Qnil;
ba3de0e8 4371
071132a9 4372 glyph = LGSTRING_GLYPH (gstring, 0);
fc3a285e
KH		 4373 from = LGLYPH_FROM (glyph);
4374 to = LGLYPH_TO (glyph);
4375 for (i = 1, j = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
071132a9
KH		 4376 {
4377 Lisp_Object this = LGSTRING_GLYPH (gstring, i);
10d16101 4378
071132a9
KH		 4379 if (NILP (this))
4380 break;
4381 if (NILP (LGLYPH_ADJUSTMENT (this)))
fc3a285e
KH		 4382 {
4383 if (j < i - 1)
4384 for (; j < i; j++)
4385 {
4386 glyph = LGSTRING_GLYPH (gstring, j);
4387 LGLYPH_SET_FROM (glyph, from);
4388 LGLYPH_SET_TO (glyph, to);
4389 }
4390 from = LGLYPH_FROM (this);
4391 to = LGLYPH_TO (this);
4392 j = i;
4393 }
071132a9 4394 else
b2937119 4395 {
fc3a285e
KH		 4396 if (from > LGLYPH_FROM (this))
4397 from = LGLYPH_FROM (this);
4398 if (to < LGLYPH_TO (this))
4399 to = LGLYPH_TO (this);
b2937119 4400 }
10d16101 4401 }
fc3a285e
KH		 4402 if (j < i - 1)
4403 for (; j < i; j++)
4404 {
4405 glyph = LGSTRING_GLYPH (gstring, j);
4406 LGLYPH_SET_FROM (glyph, from);
4407 LGLYPH_SET_TO (glyph, to);
4408 }
071132a9 4409 return composition_gstring_put_cache (gstring, XINT (n));
c2f5bfd6
KH		 4410}
4411
78a2f9cd
KH		 4412DEFUN ("font-variation-glyphs", Ffont_variation_glyphs, Sfont_variation_glyphs,
4413 2, 2, 0,
4414 doc: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4415Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4416where
4417 VARIATION-SELECTOR is a chracter code of variation selection
4418 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4419 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4420 (font_object, character)
4421 Lisp_Object font_object, character;
4422{
4423 unsigned variations[256];
4424 struct font *font;
4425 int i, n;
4426 Lisp_Object val;
4427
4428 CHECK_FONT_OBJECT (font_object);
4429 CHECK_CHARACTER (character);
4430 font = XFONT_OBJECT (font_object);
4431 if (! font->driver->get_variation_glyphs)
4432 return Qnil;
4433 n = font->driver->get_variation_glyphs (font, XINT (character), variations);
4434 if (! n)
4435 return Qnil;
4436 val = Qnil;
4437 for (i = 0; i < 255; i++)
4438 if (variations[i])
4439 {
4440 Lisp_Object code;
4441 int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
4442
4443 if (variations[i] > MOST_POSITIVE_FIXNUM)
4444 code = Fcons (make_number ((variations[i]) >> 16),
4445 make_number ((variations[i]) & 0xFFFF));
4446 else
4447 code = make_number (variations[i]);
4448 val = Fcons (Fcons (make_number (vs), code), val);
4449 }
4450 return val;
4451}
4452
6a3dadd2
KH		 4453#if 0
4454
733fd013
KH		 4455DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
4456 doc: /* Apply OpenType features on glyph-string GSTRING-IN.
51c01100 4457OTF-FEATURES specifies which features to apply in this format:
733fd013 4458 (SCRIPT LANGSYS GSUB GPOS)
e80e09b4
KH		 4459where
4460 SCRIPT is a symbol specifying a script tag of OpenType,
4461 LANGSYS is a symbol specifying a langsys tag of OpenType,
733fd013 4462 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
e80e09b4
KH		 4463
4464If LANGYS is nil, the default langsys is selected.
4465
51c01100
JB		 4466The features are applied in the order they appear in the list. The
4467symbol `*' means to apply all available features not present in this
733fd013
KH		 4468list, and the remaining features are ignored. For instance, (vatu
4469pstf * haln) is to apply vatu and pstf in this order, then to apply
4470all available features other than vatu, pstf, and haln.
e80e09b4
KH		 4471
4472The features are applied to the glyphs in the range FROM and TO of
733fd013 4473the glyph-string GSTRING-IN.
e80e09b4 4474
51c01100 4475If some feature is actually applicable, the resulting glyphs are
e80e09b4
KH		 4476produced in the glyph-string GSTRING-OUT from the index INDEX. In
4477this case, the value is the number of produced glyphs.
4478
4479If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4480the value is 0.
4481
51c01100 4482If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
e80e09b4
KH		 4483produced in GSTRING-OUT, and the value is nil.
4484
4485See the documentation of `font-make-gstring' for the format of
4486glyph-string. */)
733fd013
KH		 4487 (otf_features, gstring_in, from, to, gstring_out, index)
4488 Lisp_Object otf_features, gstring_in, from, to, gstring_out, index;
e80e09b4
KH		 4489{
4490 Lisp_Object font_object = LGSTRING_FONT (gstring_in);
733fd013
KH		 4491 Lisp_Object val;
4492 struct font *font;
e80e09b4
KH		 4493 int len, num;
4494
733fd013 4495 check_otf_features (otf_features);
35027d0c
KH		 4496 CHECK_FONT_OBJECT (font_object);
4497 font = XFONT_OBJECT (font_object);
733fd013 4498 if (! font->driver->otf_drive)
e80e09b4
KH		 4499 error ("Font backend %s can't drive OpenType GSUB table",
4500 SDATA (SYMBOL_NAME (font->driver->type)));
733fd013
KH		 4501 CHECK_CONS (otf_features);
4502 CHECK_SYMBOL (XCAR (otf_features));
4503 val = XCDR (otf_features);
4504 CHECK_SYMBOL (XCAR (val));
4505 val = XCDR (otf_features);
4506 if (! NILP (val))
4507 CHECK_CONS (val);
e80e09b4
KH		 4508 len = check_gstring (gstring_in);
4509 CHECK_VECTOR (gstring_out);
4510 CHECK_NATNUM (from);
4511 CHECK_NATNUM (to);
4512 CHECK_NATNUM (index);
4513
4514 if (XINT (from) >= XINT (to) || XINT (to) > len)
4515 args_out_of_range_3 (from, to, make_number (len));
4516 if (XINT (index) >= ASIZE (gstring_out))
4517 args_out_of_range (index, make_number (ASIZE (gstring_out)));
733fd013
KH		 4518 num = font->driver->otf_drive (font, otf_features,
4519 gstring_in, XINT (from), XINT (to),
4520 gstring_out, XINT (index), 0);
e80e09b4
KH		 4521 if (num < 0)
4522 return Qnil;
4523 return make_number (num);
4524}
4525
e80e09b4
KH		 4526DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
4527 3, 3, 0,
4528 doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
51c01100 4529OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
e80e09b4
KH		 4530in this format:
4531 (SCRIPT LANGSYS FEATURE ...)
027a33c0 4532See the documentation of `font-drive-otf' for more detail.
e80e09b4
KH		 4533
4534The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4535where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4536character code corresponding to the glyph or nil if there's no
4537corresponding character. */)
733fd013
KH		 4538 (font_object, character, otf_features)
4539 Lisp_Object font_object, character, otf_features;
e80e09b4
KH		 4540{
4541 struct font *font;
4542 Lisp_Object gstring_in, gstring_out, g;
4543 Lisp_Object alternates;
4544 int i, num;
4545
4546 CHECK_FONT_GET_OBJECT (font_object, font);
733fd013 4547 if (! font->driver->otf_drive)
e950d6f1
KH		 4548 error ("Font backend %s can't drive OpenType GSUB table",
4549 SDATA (SYMBOL_NAME (font->driver->type)));
e80e09b4 4550 CHECK_CHARACTER (character);
733fd013 4551 CHECK_CONS (otf_features);
e80e09b4
KH		 4552
4553 gstring_in = Ffont_make_gstring (font_object, make_number (1));
4554 g = LGSTRING_GLYPH (gstring_in, 0);
f9ffa1ea 4555 LGLYPH_SET_CHAR (g, XINT (character));
e80e09b4 4556 gstring_out = Ffont_make_gstring (font_object, make_number (10));
733fd013
KH		 4557 while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
4558 gstring_out, 0, 1)) < 0)
e80e09b4
KH		 4559 gstring_out = Ffont_make_gstring (font_object,
4560 make_number (ASIZE (gstring_out) * 2));
4561 alternates = Qnil;
4562 for (i = 0; i < num; i++)
4563 {
4564 Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
f9ffa1ea
SM		 4565 int c = LGLYPH_CHAR (g);
4566 unsigned code = LGLYPH_CODE (g);
e80e09b4
KH		 4567
4568 alternates = Fcons (Fcons (make_number (code),
4569 c > 0 ? make_number (c) : Qnil),
4570 alternates);
4571 }
4572 return Fnreverse (alternates);
4573}
6a3dadd2 4574#endif /* 0 */
c2f5bfd6
KH		 4575
4576#ifdef FONT_DEBUG
4577
4578DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
4579 doc: /* Open FONT-ENTITY. */)
4580 (font_entity, size, frame)
4581 Lisp_Object font_entity;
4582 Lisp_Object size;
4583 Lisp_Object frame;
4584{
4585 int isize;
4586
4587 CHECK_FONT_ENTITY (font_entity);
c2f5bfd6
KH		 4588 if (NILP (frame))
4589 frame = selected_frame;
4590 CHECK_LIVE_FRAME (frame);
51c01100 4591
35027d0c
KH		 4592 if (NILP (size))
4593 isize = XINT (AREF (font_entity, FONT_SIZE_INDEX));
4594 else
4595 {
4596 CHECK_NUMBER_OR_FLOAT (size);
4597 if (FLOATP (size))
d03b5cdb 4598 isize = POINT_TO_PIXEL (XFLOAT_DATA (size), XFRAME (frame)->resy);
35027d0c
KH		 4599 else
4600 isize = XINT (size);
4601 if (isize == 0)
4602 isize = 120;
4603 }
c2f5bfd6
KH		 4604 return font_open_entity (XFRAME (frame), font_entity, isize);
4605}
4606
4607DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
4608 doc: /* Close FONT-OBJECT. */)
4609 (font_object, frame)
4610 Lisp_Object font_object, frame;
4611{
4612 CHECK_FONT_OBJECT (font_object);
4613 if (NILP (frame))
4614 frame = selected_frame;
4615 CHECK_LIVE_FRAME (frame);
4616 font_close_object (XFRAME (frame), font_object);
4617 return Qnil;
4618}
4619
4620DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
e80e09b4
KH		 4621 doc: /* Return information about FONT-OBJECT.
4622The value is a vector:
4623 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
e0708580 4624 CAPABILITY ]
e80e09b4
KH		 4625
4626NAME is a string of the font name (or nil if the font backend doesn't
4627provide a name).
4628
4629FILENAME is a string of the font file (or nil if the font backend
4630doesn't provide a file name).
4631
4632PIXEL-SIZE is a pixel size by which the font is opened.
4633
027a33c0 4634SIZE is a maximum advance width of the font in pixels.
e80e09b4
KH		 4635
4636ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
027a33c0 4637pixels.
e80e09b4 4638
e0708580
KH		 4639CAPABILITY is a list whose first element is a symbol representing the
4640font format \(x, opentype, truetype, type1, pcf, or bdf) and the
027a33c0 4641remaining elements describe the details of the font capability.
e0708580
KH		 4642
4643If the font is OpenType font, the form of the list is
4644 \(opentype GSUB GPOS)
4645where GSUB shows which "GSUB" features the font supports, and GPOS
4646shows which "GPOS" features the font supports. Both GSUB and GPOS are
4647lists of the format:
4648 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4649
4650If the font is not OpenType font, currently the length of the form is
4651one.
e80e09b4
KH		 4652
4653SCRIPT is a symbol representing OpenType script tag.
4654
4655LANGSYS is a symbol representing OpenType langsys tag, or nil
4656representing the default langsys.
4657
51c01100 4658FEATURE is a symbol representing OpenType feature tag.
e80e09b4 4659
51c01100 4660If the font is not OpenType font, CAPABILITY is nil. */)
c2f5bfd6
KH		 4661 (font_object)
4662 Lisp_Object font_object;
4663{
4664 struct font *font;
4665 Lisp_Object val;
4666
4667 CHECK_FONT_GET_OBJECT (font_object, font);
4668
4669 val = Fmake_vector (make_number (9), Qnil);
35027d0c
KH		 4670 ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
4671 ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
c2f5bfd6 4672 ASET (val, 2, make_number (font->pixel_size));
35027d0c 4673 ASET (val, 3, make_number (font->max_width));
c2f5bfd6
KH		 4674 ASET (val, 4, make_number (font->ascent));
4675 ASET (val, 5, make_number (font->descent));
35027d0c
KH		 4676 ASET (val, 6, make_number (font->space_width));
4677 ASET (val, 7, make_number (font->average_width));
c2f5bfd6 4678 if (font->driver->otf_capability)
e0708580 4679 ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
c2f5bfd6
KH		 4680 return val;
4681}
4682
4683DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
4684 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4685Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4686 (font_object, string)
4687 Lisp_Object font_object, string;
4688{
4689 struct font *font;
4690 int i, len;
4691 Lisp_Object vec;
4692
4693 CHECK_FONT_GET_OBJECT (font_object, font);
4694 CHECK_STRING (string);
4695 len = SCHARS (string);
4696 vec = Fmake_vector (make_number (len), Qnil);
4697 for (i = 0; i < len; i++)
4698 {
4699 Lisp_Object ch = Faref (string, make_number (i));
4700 Lisp_Object val;
4701 int c = XINT (ch);
4702 unsigned code;
2930d117 4703 EMACS_INT cod;
c2f5bfd6
KH		 4704 struct font_metrics metrics;
4705
2930d117 4706 cod = code = font->driver->encode_char (font, c);
c2f5bfd6
KH		 4707 if (code == FONT_INVALID_CODE)
4708 continue;
4709 val = Fmake_vector (make_number (6), Qnil);
2930d117 4710 if (cod <= MOST_POSITIVE_FIXNUM)
c2f5bfd6
KH		 4711 ASET (val, 0, make_number (code));
4712 else
4713 ASET (val, 0, Fcons (make_number (code >> 16),
4714 make_number (code & 0xFFFF)));
51c01100 4715 font->driver->text_extents (font, &code, 1, &metrics);
c2f5bfd6
KH		 4716 ASET (val, 1, make_number (metrics.lbearing));
4717 ASET (val, 2, make_number (metrics.rbearing));
4718 ASET (val, 3, make_number (metrics.width));
4719 ASET (val, 4, make_number (metrics.ascent));
4720 ASET (val, 5, make_number (metrics.descent));
4721 ASET (vec, i, val);
4722 }
4723 return vec;
4724}
4725
ec6fe57c 4726DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
67b5d7de 4727 doc: /* Return t if and only if font-spec SPEC matches with FONT.
ec6fe57c
KH		 4728FONT is a font-spec, font-entity, or font-object. */)
4729 (spec, font)
4730 Lisp_Object spec, font;
4731{
4732 CHECK_FONT_SPEC (spec);
35027d0c 4733 CHECK_FONT (font);
ec6fe57c
KH		 4734
4735 return (font_match_p (spec, font) ? Qt : Qnil);
4736}
4737
1701724c 4738DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
51c01100 4739 doc: /* Return a font-object for displaying a character at POSITION.
10d16101
KH		 4740Optional second arg WINDOW, if non-nil, is a window displaying
4741the current buffer. It defaults to the currently selected window. */)
1701724c
KH		 4742 (position, window, string)
4743 Lisp_Object position, window, string;
10d16101
KH		 4744{
4745 struct window *w;
e3ee0340 4746 EMACS_INT pos;
10d16101 4747
1701724c
KH		 4748 if (NILP (string))
4749 {
4750 CHECK_NUMBER_COERCE_MARKER (position);
4751 pos = XINT (position);
4752 if (pos < BEGV || pos >= ZV)
4753 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1701724c
KH		 4754 }
4755 else
4756 {
1701724c
KH		 4757 CHECK_NUMBER (position);
4758 CHECK_STRING (string);
4759 pos = XINT (position);
4760 if (pos < 0 || pos >= SCHARS (string))
4761 args_out_of_range (string, position);
1701724c 4762 }
10d16101
KH		 4763 if (NILP (window))
4764 window = selected_window;
4765 CHECK_LIVE_WINDOW (window);
40fb53d6 4766 w = XWINDOW (window);
10d16101 4767
40fb53d6 4768 return font_at (-1, pos, NULL, w, string);
10d16101
KH		 4769}
4770
c2f5bfd6
KH		 4771#if 0
4772DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
4773 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4774The value is a number of glyphs drawn.
4775Type C-l to recover what previously shown. */)
4776 (font_object, string)
4777 Lisp_Object font_object, string;
4778{
4779 Lisp_Object frame = selected_frame;
4780 FRAME_PTR f = XFRAME (frame);
4781 struct font *font;
4782 struct face *face;
4783 int i, len, width;
4784 unsigned *code;
4785
4786 CHECK_FONT_GET_OBJECT (font_object, font);
4787 CHECK_STRING (string);
4788 len = SCHARS (string);
4789 code = alloca (sizeof (unsigned) * len);
4790 for (i = 0; i < len; i++)
4791 {
4792 Lisp_Object ch = Faref (string, make_number (i));
4793 Lisp_Object val;
4794 int c = XINT (ch);
4795
4796 code[i] = font->driver->encode_char (font, c);
4797 if (code[i] == FONT_INVALID_CODE)
4798 break;
4799 }
4800 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4801 face->fontp = font;
4802 if (font->driver->prepare_face)
4803 font->driver->prepare_face (f, face);
4804 width = font->driver->text_extents (font, code, i, NULL);
4805 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
4806 if (font->driver->done_face)
4807 font->driver->done_face (f, face);
4808 face->fontp = NULL;
4809 return make_number (len);
4810}
4811#endif
4812
4813#endif /* FONT_DEBUG */
4814
a266686a
KH		 4815#ifdef HAVE_WINDOW_SYSTEM
4816
72606e45
KH		 4817DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
4818 doc: /* Return information about a font named NAME on frame FRAME.
4819If FRAME is omitted or nil, use the selected frame.
4820The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4821 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4822where
4823 OPENED-NAME is the name used for opening the font,
4824 FULL-NAME is the full name of the font,
4825 SIZE is the maximum bound width of the font,
4826 HEIGHT is the height of the font,
4827 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4828 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4829 how to compose characters.
4830If the named font is not yet loaded, return nil. */)
4831 (name, frame)
4832 Lisp_Object name, frame;
4833{
4834 FRAME_PTR f;
4835 struct font *font;
4836 Lisp_Object info;
4837 Lisp_Object font_object;
4838
4839 (*check_window_system_func) ();
4840
4841 if (! FONTP (name))
4842 CHECK_STRING (name);
4843 if (NILP (frame))
4844 frame = selected_frame;
4845 CHECK_LIVE_FRAME (frame);
4846 f = XFRAME (frame);
4847
4848 if (STRINGP (name))
4849 {
4850 int fontset = fs_query_fontset (name, 0);
4851
4852 if (fontset >= 0)
4853 name = fontset_ascii (fontset);
4854 font_object = font_open_by_name (f, (char *) SDATA (name));
4855 }
4856 else if (FONT_OBJECT_P (name))
4857 font_object = name;
4858 else if (FONT_ENTITY_P (name))
4859 font_object = font_open_entity (f, name, 0);
4860 else
4861 {
4862 struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4863 Lisp_Object entity = font_matching_entity (f, face->lface, name);
4864
4865 font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
4866 }
4867 if (NILP (font_object))
4868 return Qnil;
4869 font = XFONT_OBJECT (font_object);
4870
4871 info = Fmake_vector (make_number (7), Qnil);
4872 XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
4873 XVECTOR (info)->contents[1] = AREF (font_object, FONT_NAME_INDEX);
4874 XVECTOR (info)->contents[2] = make_number (font->pixel_size);
4875 XVECTOR (info)->contents[3] = make_number (font->height);
4876 XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
4877 XVECTOR (info)->contents[5] = make_number (font->relative_compose);
4878 XVECTOR (info)->contents[6] = make_number (font->default_ascent);
4879
4880#if 0
4881 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4882 close it now. Perhaps, we should manage font-objects
4883 by `reference-count'. */
4884 font_close_object (f, font_object);
4885#endif
4886 return info;
4887}
a266686a 4888#endif
72606e45 4889
c2f5bfd6 4890\f
d0ab1ebe
KH		 4891#define BUILD_STYLE_TABLE(TBL) \
4892 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4893
4894static Lisp_Object
4895build_style_table (entry, nelement)
4896 struct table_entry *entry;
4897 int nelement;
4898{
4899 int i, j;
4900 Lisp_Object table, elt;
17ab8f5d 4901
d0ab1ebe
KH		 4902 table = Fmake_vector (make_number (nelement), Qnil);
4903 for (i = 0; i < nelement; i++)
4904 {
4905 for (j = 0; entry[i].names[j]; j++);
4906 elt = Fmake_vector (make_number (j + 1), Qnil);
4907 ASET (elt, 0, make_number (entry[i].numeric));
4908 for (j = 0; entry[i].names[j]; j++)
17ab8f5d 4909 ASET (elt, j + 1, intern (entry[i].names[j]));
d0ab1ebe
KH		 4910 ASET (table, i, elt);
4911 }
4912 return table;
4913}
4914
4915static Lisp_Object Vfont_log;
4916static int font_log_env_checked;
4917
d0818984
KH		 4918/* The deferred font-log data of the form [ACTION ARG RESULT].
4919 If ACTION is not nil, that is added to the log when font_add_log is
4920 called next time. At that time, ACTION is set back to nil. */
4921static Lisp_Object Vfont_log_deferred;
4922
4923/* Prepend the font-related logging data in Vfont_log if it is not
4924 `t'. ACTION describes a kind of font-related action (e.g. listing,
4925 opening), ARG is the argument for the action, and RESULT is the
4926 result of the action. */
d0ab1ebe
KH		 4927void
4928font_add_log (action, arg, result)
4929 char *action;
4930 Lisp_Object arg, result;
4931{
4932 Lisp_Object tail, val;
4933 int i;
4934
4935 if (! font_log_env_checked)
4936 {
4937 Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
4938 font_log_env_checked = 1;
4939 }
4940 if (EQ (Vfont_log, Qt))
4941 return;
d0818984
KH		 4942 if (STRINGP (AREF (Vfont_log_deferred, 0)))
4943 {
071132a9 4944 char *str = (char *) SDATA (AREF (Vfont_log_deferred, 0));
d0818984
KH		 4945
4946 ASET (Vfont_log_deferred, 0, Qnil);
4947 font_add_log (str, AREF (Vfont_log_deferred, 1),
4948 AREF (Vfont_log_deferred, 2));
4949 }
4950
d0ab1ebe 4951 if (FONTP (arg))
db716644
KH		 4952 {
4953 Lisp_Object tail, elt;
4954 Lisp_Object equalstr = build_string ("=");
4955
4956 val = Ffont_xlfd_name (arg, Qt);
4957 for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
4958 tail = XCDR (tail))
4959 {
4960 elt = XCAR (tail);
49f9c344
KH		 4961 if (EQ (XCAR (elt), QCscript)
4962 && SYMBOLP (XCDR (elt)))
db716644
KH		 4963 val = concat3 (val, SYMBOL_NAME (QCscript),
4964 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
49f9c344
KH		 4965 else if (EQ (XCAR (elt), QClang)
4966 && SYMBOLP (XCDR (elt)))
db716644
KH		 4967 val = concat3 (val, SYMBOL_NAME (QClang),
4968 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
49f9c344
KH		 4969 else if (EQ (XCAR (elt), QCotf)
4970 && CONSP (XCDR (elt)) && SYMBOLP (XCAR (XCDR (elt))))
db716644
KH		 4971 val = concat3 (val, SYMBOL_NAME (QCotf),
4972 concat2 (equalstr,
4973 SYMBOL_NAME (XCAR (XCDR (elt)))));
4974 }
4975 arg = val;
4976 }
d0ab1ebe 4977 if (FONTP (result))
d26424c5
KH		 4978 {
4979 val = Ffont_xlfd_name (result, Qt);
4980 if (! FONT_SPEC_P (result))
4981 val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
4982 build_string (":"), val);
4983 result = val;
4984 }
d0ab1ebe
KH		 4985 else if (CONSP (result))
4986 {
4987 result = Fcopy_sequence (result);
4988 for (tail = result; CONSP (tail); tail = XCDR (tail))
4989 {
4990 val = XCAR (tail);
4991 if (FONTP (val))
4992 val = Ffont_xlfd_name (val, Qt);
4993 XSETCAR (tail, val);
4994 }
4995 }
4996 else if (VECTORP (result))
4997 {
4998 result = Fcopy_sequence (result);
4999 for (i = 0; i < ASIZE (result); i++)
5000 {
5001 val = AREF (result, i);
5002 if (FONTP (val))
5003 val = Ffont_xlfd_name (val, Qt);
5004 ASET (result, i, val);
5005 }
5006 }
5007 Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
5008}
5009
d0818984
KH		 5010/* Record a font-related logging data to be added to Vfont_log when
5011 font_add_log is called next time. ACTION, ARG, RESULT are the same
5012 as font_add_log. */
5013
5014void
5015font_deferred_log (action, arg, result)
5016 char *action;
5017 Lisp_Object arg, result;
5018{
5019 ASET (Vfont_log_deferred, 0, build_string (action));
5020 ASET (Vfont_log_deferred, 1, arg);
5021 ASET (Vfont_log_deferred, 2, result);
ba3de0e8 5022}
d0818984 5023
c2f5bfd6
KH		 5024extern void syms_of_ftfont P_ (());
5025extern void syms_of_xfont P_ (());
5026extern void syms_of_xftfont P_ (());
5027extern void syms_of_ftxfont P_ (());
5028extern void syms_of_bdffont P_ (());
5029extern void syms_of_w32font P_ (());
5030extern void syms_of_atmfont P_ (());
edfda783 5031extern void syms_of_nsfont P_ (());
c2f5bfd6
KH		 5032
5033void
5034syms_of_font ()
5035{
4007dd1c
KH		 5036 sort_shift_bits[FONT_TYPE_INDEX] = 0;
5037 sort_shift_bits[FONT_SLANT_INDEX] = 2;
5038 sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
5039 sort_shift_bits[FONT_SIZE_INDEX] = 16;
5040 sort_shift_bits[FONT_WIDTH_INDEX] = 23;
5041 /* Note that the other elements in sort_shift_bits are not used. */
c2f5bfd6 5042
1701724c
KH		 5043 staticpro (&font_charset_alist);
5044 font_charset_alist = Qnil;
5045
35027d0c
KH		 5046 DEFSYM (Qfont_spec, "font-spec");
5047 DEFSYM (Qfont_entity, "font-entity");
5048 DEFSYM (Qfont_object, "font-object");
5049
e0708580 5050 DEFSYM (Qopentype, "opentype");
c2f5bfd6 5051
9e1bb909 5052 DEFSYM (Qascii_0, "ascii-0");
1bb1d99b
KH		 5053 DEFSYM (Qiso8859_1, "iso8859-1");
5054 DEFSYM (Qiso10646_1, "iso10646-1");
5055 DEFSYM (Qunicode_bmp, "unicode-bmp");
cf96c5c2 5056 DEFSYM (Qunicode_sip, "unicode-sip");
1bb1d99b 5057
071132a9
KH		 5058 DEFSYM (QCf, "Cf");
5059
c2f5bfd6 5060 DEFSYM (QCotf, ":otf");
35027d0c 5061 DEFSYM (QClang, ":lang");
c2f5bfd6 5062 DEFSYM (QCscript, ":script");
4c496d0d 5063 DEFSYM (QCantialias, ":antialias");
c2f5bfd6
KH		 5064
5065 DEFSYM (QCfoundry, ":foundry");
5066 DEFSYM (QCadstyle, ":adstyle");
5067 DEFSYM (QCregistry, ":registry");
9331887d
KH		 5068 DEFSYM (QCspacing, ":spacing");
5069 DEFSYM (QCdpi, ":dpi");
ec6fe57c 5070 DEFSYM (QCscalable, ":scalable");
35027d0c
KH		 5071 DEFSYM (QCavgwidth, ":avgwidth");
5072 DEFSYM (QCfont_entity, ":font-entity");
5073 DEFSYM (QCfc_unknown_spec, ":fc-unknown-spec");
c2f5bfd6 5074
ec6fe57c
KH		 5075 DEFSYM (Qc, "c");
5076 DEFSYM (Qm, "m");
5077 DEFSYM (Qp, "p");
5078 DEFSYM (Qd, "d");
5079
c2f5bfd6
KH		 5080 staticpro (&null_vector);
5081 null_vector = Fmake_vector (make_number (0), Qnil);
5082
5083 staticpro (&scratch_font_spec);
5084 scratch_font_spec = Ffont_spec (0, NULL);
5085 staticpro (&scratch_font_prefer);
5086 scratch_font_prefer = Ffont_spec (0, NULL);
5087
d0818984
KH		 5088 staticpro (&Vfont_log_deferred);
5089 Vfont_log_deferred = Fmake_vector (make_number (3), Qnil);
5090
6a3dadd2 5091#if 0
733fd013
KH		 5092#ifdef HAVE_LIBOTF
5093 staticpro (&otf_list);
5094 otf_list = Qnil;
6a3dadd2
KH		 5095#endif /* HAVE_LIBOTF */
5096#endif /* 0 */
733fd013 5097
c2f5bfd6
KH		 5098 defsubr (&Sfontp);
5099 defsubr (&Sfont_spec);
5100 defsubr (&Sfont_get);
51cf11be 5101#ifdef HAVE_WINDOW_SYSTEM
b1868a1a 5102 defsubr (&Sfont_face_attributes);
51cf11be 5103#endif
c2f5bfd6
KH		 5104 defsubr (&Sfont_put);
5105 defsubr (&Slist_fonts);
35027d0c 5106 defsubr (&Sfont_family_list);
c2f5bfd6
KH		 5107 defsubr (&Sfind_font);
5108 defsubr (&Sfont_xlfd_name);
5109 defsubr (&Sclear_font_cache);
071132a9 5110 defsubr (&Sfont_shape_gstring);
78a2f9cd 5111 defsubr (&Sfont_variation_glyphs);
6a3dadd2 5112#if 0
733fd013 5113 defsubr (&Sfont_drive_otf);
e80e09b4 5114 defsubr (&Sfont_otf_alternates);
6a3dadd2 5115#endif /* 0 */
c2f5bfd6
KH		 5116
5117#ifdef FONT_DEBUG
5118 defsubr (&Sopen_font);
5119 defsubr (&Sclose_font);
5120 defsubr (&Squery_font);
5121 defsubr (&Sget_font_glyphs);
ec6fe57c 5122 defsubr (&Sfont_match_p);
10d16101 5123 defsubr (&Sfont_at);
c2f5bfd6
KH		 5124#if 0
5125 defsubr (&Sdraw_string);
5126#endif
5127#endif /* FONT_DEBUG */
a266686a 5128#ifdef HAVE_WINDOW_SYSTEM
72606e45 5129 defsubr (&Sfont_info);
a266686a 5130#endif
c2f5bfd6 5131
819e81df
KH		 5132 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
5133 doc: /*
5134Alist of fontname patterns vs the corresponding encoding and repertory info.
5135Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5136where ENCODING is a charset or a char-table,
5137and REPERTORY is a charset, a char-table, or nil.
5138
027a33c0 5139If ENCODING and REPERTORY are the same, the element can have the form
819e81df
KH		 5140\(REGEXP . ENCODING).
5141
5142ENCODING is for converting a character to a glyph code of the font.
5143If ENCODING is a charset, encoding a character by the charset gives
5144the corresponding glyph code. If ENCODING is a char-table, looking up
5145the table by a character gives the corresponding glyph code.
5146
5147REPERTORY specifies a repertory of characters supported by the font.
5148If REPERTORY is a charset, all characters beloging to the charset are
5149supported. If REPERTORY is a char-table, all characters who have a
027a33c0 5150non-nil value in the table are supported. If REPERTORY is nil, Emacs
819e81df
KH		 5151gets the repertory information by an opened font and ENCODING. */);
5152 Vfont_encoding_alist = Qnil;
5153
d0ab1ebe
KH		 5154 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table,
5155 doc: /* Vector of valid font weight values.
5156Each element has the form:
5157 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
17ab8f5d 5158NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
d0ab1ebe
KH		 5159 Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
5160
5161 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table,
5162 doc: /* Vector of font slant symbols vs the corresponding numeric values.
17ab8f5d 5163See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5164 Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
5165
5166 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table,
5167 doc: /* Alist of font width symbols vs the corresponding numeric values.
17ab8f5d 5168See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5169 Vfont_width_table = BUILD_STYLE_TABLE (width_table);
5170
5171 staticpro (&font_style_table);
5172 font_style_table = Fmake_vector (make_number (3), Qnil);
5173 ASET (font_style_table, 0, Vfont_weight_table);
5174 ASET (font_style_table, 1, Vfont_slant_table);
5175 ASET (font_style_table, 2, Vfont_width_table);
5176
5177 DEFVAR_LISP ("font-log", &Vfont_log, doc: /*
5178*Logging list of font related actions and results.
5179The value t means to suppress the logging.
5180The initial value is set to nil if the environment variable
5181EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5182 Vfont_log = Qnil;
5183
819e81df 5184#ifdef HAVE_WINDOW_SYSTEM
c2f5bfd6 5185#ifdef HAVE_FREETYPE
35027d0c 5186 syms_of_ftfont ();
c2f5bfd6 5187#ifdef HAVE_X_WINDOWS
35027d0c
KH		 5188 syms_of_xfont ();
5189 syms_of_ftxfont ();
c2f5bfd6 5190#ifdef HAVE_XFT
35027d0c 5191 syms_of_xftfont ();
c2f5bfd6
KH		 5192#endif /* HAVE_XFT */
5193#endif /* HAVE_X_WINDOWS */
5194#else /* not HAVE_FREETYPE */
5195#ifdef HAVE_X_WINDOWS
35027d0c 5196 syms_of_xfont ();
c2f5bfd6
KH		 5197#endif /* HAVE_X_WINDOWS */
5198#endif /* not HAVE_FREETYPE */
5199#ifdef HAVE_BDFFONT
35027d0c 5200 syms_of_bdffont ();
c2f5bfd6
KH		 5201#endif /* HAVE_BDFFONT */
5202#ifdef WINDOWSNT
35027d0c 5203 syms_of_w32font ();
c2f5bfd6 5204#endif /* WINDOWSNT */
edfda783
AR		 5205#ifdef HAVE_NS
5206 syms_of_nsfont ();
5207#endif /* HAVE_NS */
819e81df 5208#endif /* HAVE_WINDOW_SYSTEM */
c2f5bfd6 5209}
885b7d09
MB		 5210
5211/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5212 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.