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