HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(make_conversion_work_buffer): Check that Vcode_conversion_reused_workbuf
[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;
ed96cde8
AR		 51
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));
6fe9826d
JR		 403 return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
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;
d0ab1ebe 1601 int dpi;
ec6fe57c 1602 int i, len = 1;
ef18374f 1603 char *p;
a9262bb8 1604 Lisp_Object styles[3];
417a1b10 1605 char *style_names[3] = { "weight", "slant", "width" };
35027d0c 1606 char work[256];
ef18374f 1607
b1868a1a
CY		 1608 family = AREF (font, FONT_FAMILY_INDEX);
1609 if (! NILP (family))
1610 {
1611 if (SYMBOLP (family))
1612 {
1613 family = SYMBOL_NAME (family);
1614 len += SBYTES (family);
1615 }
1616 else
1617 family = Qnil;
1618 }
ec6fe57c
KH		 1619
1620 val = AREF (font, FONT_SIZE_INDEX);
1621 if (INTEGERP (val))
ef18374f 1622 {
ec6fe57c
KH		 1623 if (XINT (val) != 0)
1624 pixel_size = XINT (val);
1625 point_size = -1;
1626 len += 21; /* for ":pixelsize=NUM" */
ef18374f 1627 }
ec6fe57c 1628 else if (FLOATP (val))
ef18374f 1629 {
ec6fe57c
KH		 1630 pixel_size = -1;
1631 point_size = (int) XFLOAT_DATA (val);
1632 len += 11; /* for "-NUM" */
ef18374f 1633 }
ec6fe57c 1634
b1868a1a
CY		 1635 foundry = AREF (font, FONT_FOUNDRY_INDEX);
1636 if (! NILP (foundry))
1637 {
1638 if (SYMBOLP (foundry))
1639 {
1640 foundry = SYMBOL_NAME (foundry);
1641 len += 9 + SBYTES (foundry); /* ":foundry=NAME" */
1642 }
1643 else
1644 foundry = Qnil;
1645 }
ec6fe57c 1646
35027d0c 1647 for (i = 0; i < 3; i++)
a9262bb8 1648 {
35027d0c
KH		 1649 styles[i] = font_style_symbolic (font, FONT_WEIGHT_INDEX + i, 0);
1650 if (! NILP (styles[i]))
1651 len += sprintf (work, ":%s=%s", style_names[i],
1652 SDATA (SYMBOL_NAME (styles[i])));
ec6fe57c 1653 }
35027d0c
KH		 1654
1655 if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
1656 len += sprintf (work, ":dpi=%d", dpi);
1657 if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
1658 len += strlen (":spacing=100");
1659 if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
1660 len += strlen (":scalable=false"); /* or ":scalable=true" */
1661 for (tail = AREF (font, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
ec6fe57c 1662 {
35027d0c
KH		 1663 Lisp_Object key = XCAR (XCAR (tail)), val = XCDR (XCAR (tail));
1664
1665 len += SBYTES (SYMBOL_NAME (key)) + 1; /* for :KEY= */
1666 if (STRINGP (val))
1667 len += SBYTES (val);
1668 else if (INTEGERP (val))
1669 len += sprintf (work, "%d", XINT (val));
1670 else if (SYMBOLP (val))
1671 len += (NILP (val) ? 5 : 4); /* for "false" or "true" */
ec6fe57c
KH		 1672 }
1673
ef18374f
KH		 1674 if (len > nbytes)
1675 return -1;
1676 p = name;
b1868a1a
CY		 1677 if (! NILP (family))
1678 p += sprintf (p, "%s", SDATA (family));
ec6fe57c
KH		 1679 if (point_size > 0)
1680 {
1681 if (p == name)
1682 p += sprintf (p, "%d", point_size);
1683 else
1684 p += sprintf (p, "-%d", point_size);
1685 }
ef18374f
KH		 1686 else if (pixel_size > 0)
1687 p += sprintf (p, ":pixelsize=%d", pixel_size);
35027d0c 1688 if (! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
a9262bb8
KH		 1689 p += sprintf (p, ":foundry=%s",
1690 SDATA (SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX))));
1691 for (i = 0; i < 3; i++)
35027d0c 1692 if (! NILP (styles[i]))
a9262bb8 1693 p += sprintf (p, ":%s=%s", style_names[i],
35027d0c
KH		 1694 SDATA (SYMBOL_NAME (styles[i])));
1695 if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
1696 p += sprintf (p, ":dpi=%d", XINT (AREF (font, FONT_DPI_INDEX)));
1697 if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
1698 p += sprintf (p, ":spacing=%d", XINT (AREF (font, FONT_SPACING_INDEX)));
1699 if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
1700 {
1701 if (XINT (AREF (font, FONT_AVGWIDTH_INDEX)) == 0)
1702 p += sprintf (p, ":scalable=true");
1703 else
1704 p += sprintf (p, ":scalable=false");
1705 }
ef18374f
KH		 1706 return (p - name);
1707}
1708
b1868a1a
CY		 1709/* Store GTK-style font name of FONT (font-spec or font-entity) in
1710 NAME (NBYTES length), and return the name length. F is the frame
1711 on which the font is displayed; it is used to calculate the point
1712 size. */
1713
1714int
1715font_unparse_gtkname (font, f, name, nbytes)
1716 Lisp_Object font;
1717 struct frame *f;
1718 char *name;
1719 int nbytes;
1720{
1721 char *p;
1722 int len = 1;
1723 Lisp_Object family, weight, slant, size;
1724 int point_size = -1;
1725
1726 family = AREF (font, FONT_FAMILY_INDEX);
1727 if (! NILP (family))
1728 {
1729 if (! SYMBOLP (family))
1730 return -1;
1731 family = SYMBOL_NAME (family);
1732 len += SBYTES (family);
1733 }
1734
1735 weight = font_style_symbolic (font, FONT_WEIGHT_INDEX, 0);
93eed26b 1736 if (EQ (weight, Qnormal))
b1868a1a
CY		 1737 weight = Qnil;
1738 else if (! NILP (weight))
1739 {
1740 weight = SYMBOL_NAME (weight);
1741 len += SBYTES (weight);
1742 }
1743
1744 slant = font_style_symbolic (font, FONT_SLANT_INDEX, 0);
93eed26b 1745 if (EQ (slant, Qnormal))
b1868a1a
CY		 1746 slant = Qnil;
1747 else if (! NILP (slant))
1748 {
1749 slant = SYMBOL_NAME (slant);
1750 len += SBYTES (slant);
1751 }
1752
1753 size = AREF (font, FONT_SIZE_INDEX);
1754 /* Convert pixel size to point size. */
1755 if (INTEGERP (size))
1756 {
1757 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
1758 int dpi = 75;
1759 if (INTEGERP (font_dpi))
1760 dpi = XINT (font_dpi);
1761 else if (f)
1762 dpi = f->resy;
1763 point_size = PIXEL_TO_POINT (XINT (size), dpi);
1764 len += 11;
1765 }
1766 else if (FLOATP (size))
1767 {
1768 point_size = (int) XFLOAT_DATA (size);
1769 len += 11;
1770 }
1771
1772 if (len > nbytes)
1773 return -1;
1774
1775 p = name + sprintf (name, "%s", SDATA (family));
1776
1777 if (! NILP (weight))
1778 {
1779 char *q = p;
1780 p += sprintf (p, " %s", SDATA (weight));
1781 q[1] = toupper (q[1]);
1782 }
1783
1784 if (! NILP (slant))
1785 {
1786 char *q = p;
1787 p += sprintf (p, " %s", SDATA (slant));
1788 q[1] = toupper (q[1]);
1789 }
1790
1791 if (point_size > 0)
1792 p += sprintf (p, " %d", point_size);
1793
1794 return (p - name);
1795}
1796
ef18374f
KH		 1797/* Parse NAME (null terminated) and store information in FONT
1798 (font-spec or font-entity). If NAME is successfully parsed, return
35027d0c 1799 0. Otherwise return -1. */
ef18374f
KH		 1800
1801static int
ec6fe57c 1802font_parse_name (name, font)
ef18374f
KH		 1803 char *name;
1804 Lisp_Object font;
ef18374f
KH		 1805{
1806 if (name[0] == '-' || index (name, '*'))
e950d6f1 1807 return font_parse_xlfd (name, font);
ec6fe57c 1808 return font_parse_fcname (name, font);
ef18374f
KH		 1809}
1810
35027d0c
KH		 1811
1812/* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1813 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1814 part. */
45eb10fb 1815
c2f5bfd6 1816void
35027d0c
KH		 1817font_parse_family_registry (family, registry, font_spec)
1818 Lisp_Object family, registry, font_spec;
c2f5bfd6 1819{
35027d0c
KH		 1820 int len;
1821 char *p0, *p1;
1822
d0ab1ebe
KH		 1823 if (! NILP (family)
1824 && NILP (AREF (font_spec, FONT_FAMILY_INDEX)))
c2f5bfd6 1825 {
35027d0c
KH		 1826 CHECK_STRING (family);
1827 len = SBYTES (family);
1828 p0 = (char *) SDATA (family);
1829 p1 = index (p0, '-');
1830 if (p1)
c2f5bfd6 1831 {
d0ab1ebe
KH		 1832 if ((*p0 != '*' || p1 - p0 > 1)
1833 && NILP (AREF (font_spec, FONT_FOUNDRY_INDEX)))
2f286d4f 1834 Ffont_put (font_spec, QCfoundry, font_intern_prop (p0, p1 - p0, 1));
35027d0c
KH		 1835 p1++;
1836 len -= p1 - p0;
2f286d4f 1837 Ffont_put (font_spec, QCfamily, font_intern_prop (p1, len, 1));
c2f5bfd6 1838 }
35027d0c
KH		 1839 else
1840 ASET (font_spec, FONT_FAMILY_INDEX, Fintern (family, Qnil));
c2f5bfd6 1841 }
35027d0c 1842 if (! NILP (registry))
c2f5bfd6 1843 {
35027d0c
KH		 1844 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1845 CHECK_STRING (registry);
1846 len = SBYTES (registry);
1847 p0 = (char *) SDATA (registry);
1848 p1 = index (p0, '-');
1849 if (! p1)
c2f5bfd6 1850 {
35027d0c
KH		 1851 if (SDATA (registry)[len - 1] == '*')
1852 registry = concat2 (registry, build_string ("-*"));
1853 else
1854 registry = concat2 (registry, build_string ("*-*"));
c2f5bfd6 1855 }
35027d0c
KH		 1856 registry = Fdowncase (registry);
1857 ASET (font_spec, FONT_REGISTRY_INDEX, Fintern (registry, Qnil));
c2f5bfd6
KH		 1858 }
1859}
1860
45eb10fb 1861\f
35027d0c
KH		 1862/* This part (through the next ^L) is still experimental and not
1863 tested much. We may drastically change codes. */
10d16101 1864
45eb10fb 1865/* OTF handler */
10d16101 1866
6a3dadd2
KH		 1867#if 0
1868
e950d6f1
KH		 1869#define LGSTRING_HEADER_SIZE 6
1870#define LGSTRING_GLYPH_SIZE 8
1871
1872static int
1873check_gstring (gstring)
1874 Lisp_Object gstring;
1875{
1876 Lisp_Object val;
1877 int i, j;
1878
1879 CHECK_VECTOR (gstring);
1880 val = AREF (gstring, 0);
1881 CHECK_VECTOR (val);
1882 if (ASIZE (val) < LGSTRING_HEADER_SIZE)
1883 goto err;
1884 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
f9ffa1ea
SM		 1885 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
1886 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
1887 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
1888 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
1889 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
1890 CHECK_NATNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
1891 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
1892 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
1893 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
1894 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
e950d6f1 1895
071132a9 1896 for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
e950d6f1
KH		 1897 {
1898 val = LGSTRING_GLYPH (gstring, i);
1899 CHECK_VECTOR (val);
1900 if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
1901 goto err;
f9ffa1ea 1902 if (NILP (AREF (val, LGLYPH_IX_CHAR)))
e950d6f1 1903 break;
f9ffa1ea
SM		 1904 CHECK_NATNUM (AREF (val, LGLYPH_IX_FROM));
1905 CHECK_NATNUM (AREF (val, LGLYPH_IX_TO));
1906 CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
1907 if (!NILP (AREF (val, LGLYPH_IX_CODE)))
1908 CHECK_NATNUM (AREF (val, LGLYPH_IX_CODE));
1909 if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
1910 CHECK_NATNUM (AREF (val, LGLYPH_IX_WIDTH));
1911 if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
e950d6f1 1912 {
f9ffa1ea 1913 val = AREF (val, LGLYPH_IX_ADJUSTMENT);
e950d6f1
KH		 1914 CHECK_VECTOR (val);
1915 if (ASIZE (val) < 3)
1916 goto err;
1917 for (j = 0; j < 3; j++)
1918 CHECK_NUMBER (AREF (val, j));
1919 }
1920 }
1921 return i;
1922 err:
1923 error ("Invalid glyph-string format");
1924 return -1;
1925}
1926
cf385d93
KH		 1927static void
1928check_otf_features (otf_features)
1929 Lisp_Object otf_features;
1930{
35027d0c 1931 Lisp_Object val;
cf385d93
KH		 1932
1933 CHECK_CONS (otf_features);
1934 CHECK_SYMBOL (XCAR (otf_features));
1935 otf_features = XCDR (otf_features);
1936 CHECK_CONS (otf_features);
1937 CHECK_SYMBOL (XCAR (otf_features));
1938 otf_features = XCDR (otf_features);
1939 for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
1940 {
1941 CHECK_SYMBOL (Fcar (val));
1942 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1943 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val)));
1944 }
1945 otf_features = XCDR (otf_features);
1946 for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
1947 {
1948 CHECK_SYMBOL (Fcar (val));
1949 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1950 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val)));
1951 }
1952}
1953
c2f5bfd6
KH		 1954#ifdef HAVE_LIBOTF
1955#include <otf.h>
1956
733fd013 1957Lisp_Object otf_list;
c2f5bfd6
KH		 1958
1959static Lisp_Object
1960otf_tag_symbol (tag)
1961 OTF_Tag tag;
1962{
1963 char name[5];
1964
1965 OTF_tag_name (tag, name);
1966 return Fintern (make_unibyte_string (name, 4), Qnil);
1967}
1968
1969static OTF *
35027d0c
KH		 1970otf_open (file)
1971 Lisp_Object file;
c2f5bfd6 1972{
35027d0c 1973 Lisp_Object val = Fassoc (file, otf_list);
733fd013
KH		 1974 OTF *otf;
1975
1976 if (! NILP (val))
1977 otf = XSAVE_VALUE (XCDR (val))->pointer;
1978 else
c2f5bfd6 1979 {
35027d0c 1980 otf = STRINGP (file) ? OTF_open ((char *) SDATA (file)) : NULL;
733fd013 1981 val = make_save_value (otf, 0);
35027d0c 1982 otf_list = Fcons (Fcons (file, val), otf_list);
c2f5bfd6 1983 }
733fd013 1984 return otf;
c2f5bfd6
KH		 1985}
1986
1987
1988/* Return a list describing which scripts/languages FONT supports by
1989 which GSUB/GPOS features of OpenType tables. See the comment of
51c01100 1990 (struct font_driver).otf_capability. */
c2f5bfd6
KH		 1991
1992Lisp_Object
1993font_otf_capability (font)
1994 struct font *font;
1995{
1996 OTF *otf;
1997 Lisp_Object capability = Fcons (Qnil, Qnil);
1998 int i;
1999
35027d0c 2000 otf = otf_open (font->props[FONT_FILE_INDEX]);
c2f5bfd6
KH		 2001 if (! otf)
2002 return Qnil;
2003 for (i = 0; i < 2; i++)
2004 {
2005 OTF_GSUB_GPOS *gsub_gpos;
2006 Lisp_Object script_list = Qnil;
2007 int j;
2008
2009 if (OTF_get_features (otf, i == 0) < 0)
2010 continue;
2011 gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
2012 for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
2013 {
2014 OTF_Script *script = gsub_gpos->ScriptList.Script + j;
2015 Lisp_Object langsys_list = Qnil;
2016 Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
2017 int k;
2018
2019 for (k = script->LangSysCount; k >= 0; k--)
2020 {
2021 OTF_LangSys *langsys;
2022 Lisp_Object feature_list = Qnil;
2023 Lisp_Object langsys_tag;
2024 int l;
2025
e80e09b4 2026 if (k == script->LangSysCount)
c2f5bfd6
KH		 2027 {
2028 langsys = &script->DefaultLangSys;
2029 langsys_tag = Qnil;
2030 }
2031 else
2032 {
2033 langsys = script->LangSys + k;
2034 langsys_tag
2035 = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
2036 }
e80e09b4 2037 for (l = langsys->FeatureCount - 1; l >= 0; l--)
c2f5bfd6
KH		 2038 {
2039 OTF_Feature *feature
2040 = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
2041 Lisp_Object feature_tag
2042 = otf_tag_symbol (feature->FeatureTag);
2043
2044 feature_list = Fcons (feature_tag, feature_list);
2045 }
2046 langsys_list = Fcons (Fcons (langsys_tag, feature_list),
2047 langsys_list);
2048 }
2049 script_list = Fcons (Fcons (script_tag, langsys_list),
2050 script_list);
2051 }
2052
2053 if (i == 0)
2054 XSETCAR (capability, script_list);
2055 else
2056 XSETCDR (capability, script_list);
2057 }
2058
2059 return capability;
2060}
2061
733fd013
KH		 2062/* Parse OTF features in SPEC and write a proper features spec string
2063 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2064 assured that the sufficient memory has already allocated for
2065 FEATURES. */
2066
e80e09b4 2067static void
733fd013 2068generate_otf_features (spec, features)
c2f5bfd6 2069 Lisp_Object spec;
733fd013 2070 char *features;
c2f5bfd6
KH		 2071{
2072 Lisp_Object val;
35027d0c 2073 char *p;
c2f5bfd6
KH		 2074 int asterisk;
2075
733fd013 2076 p = features;
e80e09b4 2077 *p = '\0';
c2f5bfd6
KH		 2078 for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
2079 {
2080 val = XCAR (spec);
e80e09b4
KH		 2081 CHECK_SYMBOL (val);
2082 if (p > features)
733fd013 2083 *p++ = ',';
c2f5bfd6
KH		 2084 if (SREF (SYMBOL_NAME (val), 0) == '*')
2085 {
2086 asterisk = 1;
e80e09b4 2087 *p++ = '*';
c2f5bfd6
KH		 2088 }
2089 else if (! asterisk)
e80e09b4
KH		 2090 {
2091 val = SYMBOL_NAME (val);
e80e09b4
KH		 2092 p += sprintf (p, "%s", SDATA (val));
2093 }
c2f5bfd6 2094 else
e80e09b4
KH		 2095 {
2096 val = SYMBOL_NAME (val);
e80e09b4
KH		 2097 p += sprintf (p, "~%s", SDATA (val));
2098 }
c2f5bfd6 2099 }
e80e09b4
KH		 2100 if (CONSP (spec))
2101 error ("OTF spec too long");
2102}
2103
733fd013
KH		 2104Lisp_Object
2105font_otf_DeviceTable (device_table)
2106 OTF_DeviceTable *device_table;
2107{
2108 int len = device_table->StartSize - device_table->EndSize + 1;
2109
2110 return Fcons (make_number (len),
2111 make_unibyte_string (device_table->DeltaValue, len));
2112}
2113
2114Lisp_Object
2115font_otf_ValueRecord (value_format, value_record)
2116 int value_format;
2117 OTF_ValueRecord *value_record;
2118{
2119 Lisp_Object val = Fmake_vector (make_number (8), Qnil);
2120
2121 if (value_format & OTF_XPlacement)
43c0454d 2122 ASET (val, 0, make_number (value_record->XPlacement));
733fd013 2123 if (value_format & OTF_YPlacement)
43c0454d 2124 ASET (val, 1, make_number (value_record->YPlacement));
733fd013 2125 if (value_format & OTF_XAdvance)
43c0454d 2126 ASET (val, 2, make_number (value_record->XAdvance));
733fd013 2127 if (value_format & OTF_YAdvance)
43c0454d 2128 ASET (val, 3, make_number (value_record->YAdvance));
733fd013
KH		 2129 if (value_format & OTF_XPlaDevice)
2130 ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
2131 if (value_format & OTF_YPlaDevice)
2132 ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
2133 if (value_format & OTF_XAdvDevice)
2134 ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
2135 if (value_format & OTF_YAdvDevice)
2136 ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
2137 return val;
2138}
2139
2140Lisp_Object
2141font_otf_Anchor (anchor)
2142 OTF_Anchor *anchor;
2143{
2144 Lisp_Object val;
2145
2146 val = Fmake_vector (make_number (anchor->AnchorFormat + 1), Qnil);
2147 ASET (val, 0, make_number (anchor->XCoordinate));
2148 ASET (val, 1, make_number (anchor->YCoordinate));
2149 if (anchor->AnchorFormat == 2)
2150 ASET (val, 2, make_number (anchor->f.f1.AnchorPoint));
2151 else
2152 {
2153 ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
2154 ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
2155 }
2156 return val;
2157}
c2f5bfd6 2158#endif /* HAVE_LIBOTF */
6a3dadd2 2159#endif /* 0 */
c2f5bfd6 2160
c2f5bfd6
KH		 2161\f
2162/* Font sorting */
2163
4007dd1c 2164static unsigned font_score P_ ((Lisp_Object, Lisp_Object *));
c2f5bfd6
KH		 2165static int font_compare P_ ((const void *, const void *));
2166static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object,
7181ea6a 2167 Lisp_Object, int));
c2f5bfd6
KH		 2168
2169/* We sort fonts by scoring each of them against a specified
2170 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2171 the value is, the closer the font is to the font-spec.
2172
4007dd1c
KH		 2173 The lowest 2 bits of the score is used for driver type. The font
2174 available by the most preferred font driver is 0.
35027d0c 2175
4007dd1c 2176 Each 7-bit in the higher 28 bits are used for numeric properties
c2f5bfd6
KH		 2177 WEIGHT, SLANT, WIDTH, and SIZE. */
2178
2179/* How many bits to shift to store the difference value of each font
35027d0c
KH		 2180 property in a score. Note that flots for FONT_TYPE_INDEX and
2181 FONT_REGISTRY_INDEX are not used. */
c2f5bfd6
KH		 2182static int sort_shift_bits[FONT_SIZE_INDEX + 1];
2183
9331887d
KH		 2184/* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2185 The return value indicates how different ENTITY is compared with
51c13510 2186 SPEC_PROP. */
c2f5bfd6
KH		 2187
2188static unsigned
4007dd1c 2189font_score (entity, spec_prop)
9331887d 2190 Lisp_Object entity, *spec_prop;
c2f5bfd6
KH		 2191{
2192 unsigned score = 0;
2193 int i;
c2f5bfd6 2194
35027d0c
KH		 2195 /* Score three style numeric fields. Maximum difference is 127. */
2196 for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
2197 if (! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i]))
2198 {
2199 int diff = (XINT (AREF (entity, i)) >> 8) - (XINT (spec_prop[i]) >> 8);
2200
2201 if (diff < 0)
2202 diff = - diff;
f4cc0153
KH		 2203 if (diff > 0)
2204 score |= min (diff, 127) << sort_shift_bits[i];
35027d0c
KH		 2205 }
2206
2207 /* Score the size. Maximum difference is 127. */
2208 i = FONT_SIZE_INDEX;
2641e213 2209 if (! NILP (spec_prop[i]) && XINT (AREF (entity, i)) > 0)
35027d0c
KH		 2210 {
2211 /* We use the higher 6-bit for the actual size difference. The
2212 lowest bit is set if the DPI is different. */
2213 int diff = XINT (spec_prop[i]) - XINT (AREF (entity, i));
2214
2215 if (diff < 0)
2216 diff = - diff;
d0ab1ebe 2217 diff <<= 1;
35027d0c
KH		 2218 if (! NILP (spec_prop[FONT_DPI_INDEX])
2219 && ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
2220 diff |= 1;
2221 score |= min (diff, 127) << sort_shift_bits[FONT_SIZE_INDEX];
c2f5bfd6
KH		 2222 }
2223
2224 return score;
2225}
2226
2227
2228/* The comparison function for qsort. */
2229
2230static int
2231font_compare (d1, d2)
2232 const void *d1, *d2;
2233{
35027d0c 2234 return (*(unsigned *) d1 - *(unsigned *) d2);
c2f5bfd6
KH		 2235}
2236
2237
2238/* The structure for elements being sorted by qsort. */
2239struct font_sort_data
2240{
2241 unsigned score;
2242 Lisp_Object entity;
2243};
2244
2245
2246/* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2247 If PREFER specifies a point-size, calculate the corresponding
9331887d 2248 pixel-size from QCdpi property of PREFER or from the Y-resolution
7181ea6a 2249 of FRAME before sorting.
35027d0c
KH		 2250
2251 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2252 return the sorted VEC. */
c2f5bfd6
KH		 2253
2254static Lisp_Object
7181ea6a
KH		 2255font_sort_entites (vec, prefer, frame, best_only)
2256 Lisp_Object vec, prefer, frame;
35027d0c 2257 int best_only;
c2f5bfd6 2258{
9331887d 2259 Lisp_Object prefer_prop[FONT_SPEC_MAX];
c2f5bfd6
KH		 2260 int len, i;
2261 struct font_sort_data *data;
35027d0c 2262 unsigned best_score;
4007dd1c
KH		 2263 Lisp_Object best_entity, driver_type;
2264 int driver_order;
2265 struct frame *f = XFRAME (frame);
2266 struct font_driver_list *list;
c2f5bfd6
KH		 2267 USE_SAFE_ALLOCA;
2268
2269 len = ASIZE (vec);
2270 if (len <= 1)
35027d0c 2271 return best_only ? AREF (vec, 0) : vec;
c2f5bfd6 2272
2641e213 2273 for (i = FONT_WEIGHT_INDEX; i <= FONT_DPI_INDEX; i++)
9331887d 2274 prefer_prop[i] = AREF (prefer, i);
9331887d
KH		 2275 if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
2276 prefer_prop[FONT_SIZE_INDEX]
2277 = make_number (font_pixel_size (XFRAME (frame), prefer));
2278
c2f5bfd6
KH		 2279 /* Scoring and sorting. */
2280 SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len);
35027d0c 2281 best_score = 0xFFFFFFFF;
4007dd1c
KH		 2282 /* We are sure that the length of VEC > 1. */
2283 driver_type = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
2284 for (driver_order = 0, list = f->font_driver_list; list;
2285 driver_order++, list = list->next)
2286 if (EQ (driver_type, list->driver->type))
2287 break;
2288 best_entity = data[0].entity = AREF (vec, 0);
2289 best_score = data[0].score
2290 = font_score (data[0].entity, prefer_prop) | driver_order;
c2f5bfd6
KH		 2291 for (i = 0; i < len; i++)
2292 {
4007dd1c
KH		 2293 if (!EQ (driver_type, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
2294 for (driver_order = 0, list = f->font_driver_list; list;
2295 driver_order++, list = list->next)
2296 if (EQ (driver_type, list->driver->type))
2297 break;
c2f5bfd6 2298 data[i].entity = AREF (vec, i);
4007dd1c 2299 data[i].score = font_score (data[i].entity, prefer_prop) | driver_order;
35027d0c
KH		 2300 if (best_only && best_score > data[i].score)
2301 {
2302 best_score = data[i].score;
2303 best_entity = data[i].entity;
2304 if (best_score == 0)
2305 break;
2306 }
c2f5bfd6 2307 }
7181ea6a 2308 if (! best_only)
35027d0c
KH		 2309 {
2310 qsort (data, len, sizeof *data, font_compare);
2311 for (i = 0; i < len; i++)
2312 ASET (vec, i, data[i].entity);
2313 }
2314 else
2315 vec = best_entity;
c2f5bfd6
KH		 2316 SAFE_FREE ();
2317
d0ab1ebe 2318 font_add_log ("sort-by", prefer, vec);
c2f5bfd6
KH		 2319 return vec;
2320}
2321
2322\f
2323/* API of Font Service Layer. */
2324
45eb10fb
KH		 2325/* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2326 sort_shift_bits. Finternal_set_font_selection_order calls this
2327 function with font_sort_order after setting up it. */
2328
c2f5bfd6
KH		 2329void
2330font_update_sort_order (order)
2331 int *order;
2332{
35027d0c 2333 int i, shift_bits;
c2f5bfd6 2334
943b7eea 2335 for (i = 0, shift_bits = 23; i < 4; i++, shift_bits -= 7)
c2f5bfd6
KH		 2336 {
2337 int xlfd_idx = order[i];
2338
2339 if (xlfd_idx == XLFD_WEIGHT_INDEX)
2340 sort_shift_bits[FONT_WEIGHT_INDEX] = shift_bits;
2341 else if (xlfd_idx == XLFD_SLANT_INDEX)
2342 sort_shift_bits[FONT_SLANT_INDEX] = shift_bits;
2343 else if (xlfd_idx == XLFD_SWIDTH_INDEX)
2344 sort_shift_bits[FONT_WIDTH_INDEX] = shift_bits;
2345 else
2346 sort_shift_bits[FONT_SIZE_INDEX] = shift_bits;
2347 }
2348}
2349
51c13510
KH		 2350static int
2351font_check_otf_features (script, langsys, features, table)
2352 Lisp_Object script, langsys, features, table;
2353{
2354 Lisp_Object val;
2355 int negative;
2356
2357 table = assq_no_quit (script, table);
2358 if (NILP (table))
2359 return 0;
2360 table = XCDR (table);
2361 if (! NILP (langsys))
2362 {
2363 table = assq_no_quit (langsys, table);
2364 if (NILP (table))
2365 return 0;
2366 }
2367 else
2368 {
2369 val = assq_no_quit (Qnil, table);
2370 if (NILP (val))
2371 table = XCAR (table);
2372 else
2373 table = val;
2374 }
2375 table = XCDR (table);
2376 for (negative = 0; CONSP (features); features = XCDR (features))
2377 {
2378 if (NILP (XCAR (features)))
2379 negative = 1;
2380 if (NILP (Fmemq (XCAR (features), table)) != negative)
2381 return 0;
2382 }
2383 return 1;
2384}
2385
2386/* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2387
2388static int
3cba9369 2389font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
51c13510
KH		 2390{
2391 Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
2392
2393 script = XCAR (spec);
2394 spec = XCDR (spec);
2395 if (! NILP (spec))
2396 {
2397 langsys = XCAR (spec);
2398 spec = XCDR (spec);
2399 if (! NILP (spec))
2400 {
2401 gsub = XCAR (spec);
2402 spec = XCDR (spec);
2403 if (! NILP (spec))
2404 gpos = XCAR (spec);
2405 }
2406 }
2407
2408 if (! NILP (gsub) && ! font_check_otf_features (script, langsys, gsub,
2409 XCAR (otf_capability)))
2410 return 0;
2411 if (! NILP (gpos) && ! font_check_otf_features (script, langsys, gpos,
2412 XCDR (otf_capability)))
2413 return 0;
2414 return 1;
2415}
2416
45eb10fb 2417
51c13510
KH		 2418
2419/* Check if FONT (font-entity or font-object) matches with the font
2420 specification SPEC. */
45eb10fb 2421
ef18374f 2422int
51c13510
KH		 2423font_match_p (spec, font)
2424 Lisp_Object spec, font;
ef18374f 2425{
51c13510
KH		 2426 Lisp_Object prop[FONT_SPEC_MAX], *props;
2427 Lisp_Object extra, font_extra;
ef18374f
KH		 2428 int i;
2429
51c13510
KH		 2430 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
2431 if (! NILP (AREF (spec, i))
2432 && ! NILP (AREF (font, i))
2433 && ! EQ (AREF (spec, i), AREF (font, i)))
2434 return 0;
2435 props = XFONT_SPEC (spec)->props;
2436 if (FLOATP (props[FONT_SIZE_INDEX]))
2437 {
2438 for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++)
2439 prop[i] = AREF (spec, i);
2440 prop[FONT_SIZE_INDEX]
2441 = make_number (font_pixel_size (XFRAME (selected_frame), spec));
2442 props = prop;
2443 }
2444
2445 if (font_score (font, props) > 0)
2446 return 0;
2447 extra = AREF (spec, FONT_EXTRA_INDEX);
2448 font_extra = AREF (font, FONT_EXTRA_INDEX);
2449 for (; CONSP (extra); extra = XCDR (extra))
35027d0c 2450 {
51c13510
KH		 2451 Lisp_Object key = XCAR (XCAR (extra));
2452 Lisp_Object val = XCDR (XCAR (extra)), val2;
2453
2454 if (EQ (key, QClang))
2455 {
2456 val2 = assq_no_quit (key, font_extra);
2457 if (NILP (val2))
2458 return 0;
2459 val2 = XCDR (val2);
2460 if (CONSP (val))
2461 {
2462 if (! CONSP (val2))
2463 return 0;
2464 while (CONSP (val))
2465 if (NILP (Fmemq (val, val2)))
2466 return 0;
2467 }
2468 else
2469 if (CONSP (val2)
2470 ? NILP (Fmemq (val, XCDR (val2)))
2471 : ! EQ (val, val2))
2472 return 0;
2473 }
2474 else if (EQ (key, QCscript))
2475 {
2476 val2 = assq_no_quit (val, Vscript_representative_chars);
2477 if (! NILP (val2))
2478 for (val2 = XCDR (val2); CONSP (val2); val2 = XCDR (val2))
2479 if (font_encode_char (font, XINT (XCAR (val2)))
2480 == FONT_INVALID_CODE)
2481 return 0;
2482 }
2483 else if (EQ (key, QCotf))
2484 {
2485 struct font *fontp;
2486
2487 if (! FONT_OBJECT_P (font))
2488 return 0;
2489 fontp = XFONT_OBJECT (font);
2490 if (! fontp->driver->otf_capability)
2491 return 0;
2492 val2 = fontp->driver->otf_capability (fontp);
2493 if (NILP (val2) || ! font_check_otf (val, val2))
2494 return 0;
2495 }
35027d0c
KH		 2496 }
2497
51c13510 2498 return 1;
ef18374f 2499}
ca4da08a 2500\f
819e81df 2501
ca4da08a
KH		 2502/* Font cache
2503
2504 Each font backend has the callback function get_cache, and it
2505 returns a cons cell of which cdr part can be freely used for
2506 caching fonts. The cons cell may be shared by multiple frames
2507 and/or multiple font drivers. So, we arrange the cdr part as this:
2508
2509 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2510
2511 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2512 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2513 cons (FONT-SPEC FONT-ENTITY ...). */
2514
2515static void font_prepare_cache P_ ((FRAME_PTR, struct font_driver *));
2516static void font_finish_cache P_ ((FRAME_PTR, struct font_driver *));
2517static Lisp_Object font_get_cache P_ ((FRAME_PTR, struct font_driver *));
2518static void font_clear_cache P_ ((FRAME_PTR, Lisp_Object,
2519 struct font_driver *));
2520
2521static void
2522font_prepare_cache (f, driver)
2523 FRAME_PTR f;
2524 struct font_driver *driver;
2525{
2526 Lisp_Object cache, val;
2527
2528 cache = driver->get_cache (f);
2529 val = XCDR (cache);
2530 while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
2531 val = XCDR (val);
2532 if (NILP (val))
2533 {
2534 val = Fcons (driver->type, Fcons (make_number (1), Qnil));
2535 XSETCDR (cache, Fcons (val, XCDR (cache)));
2536 }
2537 else
2538 {
2539 val = XCDR (XCAR (val));
2540 XSETCAR (val, make_number (XINT (XCAR (val)) + 1));
2541 }
2542}
2543
43c0454d 2544
ca4da08a
KH		 2545static void
2546font_finish_cache (f, driver)
2547 FRAME_PTR f;
2548 struct font_driver *driver;
2549{
2550 Lisp_Object cache, val, tmp;
2551
2552
2553 cache = driver->get_cache (f);
2554 val = XCDR (cache);
2555 while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
2556 cache = val, val = XCDR (val);
d0ab1ebe 2557 font_assert (! NILP (val));
ca4da08a 2558 tmp = XCDR (XCAR (val));
43c0454d 2559 XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1));
ca4da08a
KH		 2560 if (XINT (XCAR (tmp)) == 0)
2561 {
2562 font_clear_cache (f, XCAR (val), driver);
2563 XSETCDR (cache, XCDR (val));
2564 }
ca4da08a
KH		 2565}
2566
43c0454d 2567
ca4da08a
KH		 2568static Lisp_Object
2569font_get_cache (f, driver)
2570 FRAME_PTR f;
2571 struct font_driver *driver;
2572{
2573 Lisp_Object val = driver->get_cache (f);
2574 Lisp_Object type = driver->type;
2575
d0ab1ebe 2576 font_assert (CONSP (val));
ca4da08a 2577 for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val));
d0ab1ebe 2578 font_assert (CONSP (val));
ca4da08a
KH		 2579 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2580 val = XCDR (XCAR (val));
2581 return val;
2582}
2583
43c0454d
KH		 2584static int num_fonts;
2585
ca4da08a
KH		 2586static void
2587font_clear_cache (f, cache, driver)
2588 FRAME_PTR f;
2589 Lisp_Object cache;
2590 struct font_driver *driver;
2591{
2592 Lisp_Object tail, elt;
51c01100 2593
ca4da08a
KH		 2594 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2595 for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
2596 {
2597 elt = XCAR (tail);
be9442ad 2598 if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)) && VECTORP (XCDR (elt)))
ca4da08a
KH		 2599 {
2600 Lisp_Object vec = XCDR (elt);
2601 int i;
2602
2603 for (i = 0; i < ASIZE (vec); i++)
2604 {
2605 Lisp_Object entity = AREF (vec, i);
2606
2607 if (EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
2608 {
2609 Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
2610
2611 for (; CONSP (objlist); objlist = XCDR (objlist))
2612 {
2613 Lisp_Object val = XCAR (objlist);
35027d0c 2614 struct font *font = XFONT_OBJECT (val);
ca4da08a 2615
5e634ec9
KH		 2616 if (! NILP (AREF (val, FONT_TYPE_INDEX)))
2617 {
2618 font_assert (font && driver == font->driver);
2619 driver->close (f, font);
2620 num_fonts--;
2621 }
ca4da08a
KH		 2622 }
2623 if (driver->free_entity)
2624 driver->free_entity (entity);
2625 }
2626 }
2627 }
2628 }
2629 XSETCDR (cache, Qnil);
2630}
2631\f
2632
c2f5bfd6
KH		 2633static Lisp_Object scratch_font_spec, scratch_font_prefer;
2634
35027d0c
KH		 2635Lisp_Object
2636font_delete_unmatched (list, spec, size)
2637 Lisp_Object list, spec;
2638 int size;
2639{
d0ab1ebe 2640 Lisp_Object entity, val;
35027d0c 2641 enum font_property_index prop;
45eb10fb 2642
d0ab1ebe 2643 for (val = Qnil; CONSP (list); list = XCDR (list))
35027d0c 2644 {
d0ab1ebe 2645 entity = XCAR (list);
35027d0c
KH		 2646 for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
2647 if (INTEGERP (AREF (spec, prop))
2648 && ((XINT (AREF (spec, prop)) >> 8)
2649 != (XINT (AREF (entity, prop)) >> 8)))
2650 prop = FONT_SPEC_MAX;
7181ea6a 2651 if (prop < FONT_SPEC_MAX
35027d0c
KH		 2652 && size
2653 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
2654 {
2655 int diff = XINT (AREF (entity, FONT_SIZE_INDEX)) - size;
c2f5bfd6 2656
35027d0c
KH		 2657 if (diff != 0
2658 && (diff < 0 ? -diff > FONT_PIXEL_SIZE_QUANTUM
2659 : diff > FONT_PIXEL_SIZE_QUANTUM))
2660 prop = FONT_SPEC_MAX;
2661 }
7181ea6a
KH		 2662 if (prop < FONT_SPEC_MAX
2663 && INTEGERP (AREF (spec, FONT_DPI_INDEX))
2664 && INTEGERP (AREF (entity, FONT_DPI_INDEX))
c576d6dc 2665 && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
7181ea6a
KH		 2666 && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX)))
2667 prop = FONT_SPEC_MAX;
2668 if (prop < FONT_SPEC_MAX
2669 && INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX))
2670 && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
c576d6dc 2671 && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0
7181ea6a
KH		 2672 && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX),
2673 AREF (entity, FONT_AVGWIDTH_INDEX)))
2674 prop = FONT_SPEC_MAX;
35027d0c 2675 if (prop < FONT_SPEC_MAX)
d0ab1ebe 2676 val = Fcons (entity, val);
35027d0c 2677 }
d0ab1ebe 2678 return val;
35027d0c
KH		 2679}
2680
2681
2682/* Return a vector of font-entities matching with SPEC on FRAME. */
2683
2684Lisp_Object
c2f5bfd6
KH		 2685font_list_entities (frame, spec)
2686 Lisp_Object frame, spec;
2687{
2688 FRAME_PTR f = XFRAME (frame);
2689 struct font_driver_list *driver_list = f->font_driver_list;
4007dd1c 2690 Lisp_Object ftype, val;
35027d0c
KH		 2691 Lisp_Object *vec;
2692 int size;
2693 int need_filtering = 0;
c2f5bfd6
KH		 2694 int i;
2695
d0ab1ebe 2696 font_assert (FONT_SPEC_P (spec));
c2f5bfd6 2697
35027d0c
KH		 2698 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
2699 size = XINT (AREF (spec, FONT_SIZE_INDEX));
2700 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
2701 size = font_pixel_size (f, spec);
2702 else
2703 size = 0;
2704
c2f5bfd6 2705 ftype = AREF (spec, FONT_TYPE_INDEX);
4007dd1c 2706 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
35027d0c 2707 ASET (scratch_font_spec, i, AREF (spec, i));
4007dd1c 2708 for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
35027d0c
KH		 2709 {
2710 ASET (scratch_font_spec, i, Qnil);
2711 if (! NILP (AREF (spec, i)))
2712 need_filtering = 1;
4007dd1c
KH		 2713 if (i == FONT_DPI_INDEX)
2714 /* Skip FONT_SPACING_INDEX */
2715 i++;
35027d0c 2716 }
aa50ca2f 2717 ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
35027d0c
KH		 2718 ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
2719
4007dd1c 2720 vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
35027d0c
KH		 2721 if (! vec)
2722 return null_vector;
51c01100 2723
c2f5bfd6 2724 for (i = 0; driver_list; driver_list = driver_list->next)
417a1b10
KH		 2725 if (driver_list->on
2726 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
c2f5bfd6 2727 {
ca4da08a 2728 Lisp_Object cache = font_get_cache (f, driver_list->driver);
c2f5bfd6 2729
e4c93315 2730 ASET (scratch_font_spec, FONT_TYPE_INDEX, driver_list->driver->type);
4007dd1c
KH		 2731 val = assoc_no_quit (scratch_font_spec, XCDR (cache));
2732 if (CONSP (val))
2733 val = XCDR (val);
2734 else
c2f5bfd6 2735 {
4007dd1c 2736 Lisp_Object copy;
35027d0c 2737
4007dd1c
KH		 2738 val = driver_list->driver->list (frame, scratch_font_spec);
2739 copy = Fcopy_font_spec (scratch_font_spec);
2740 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2741 XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
c2f5bfd6 2742 }
4007dd1c
KH		 2743 if (! NILP (val) && need_filtering)
2744 val = font_delete_unmatched (val, spec, size);
2745 if (! NILP (val))
2746 vec[i++] = val;
c2f5bfd6 2747 }
35027d0c 2748
d0ab1ebe
KH		 2749 val = (i > 0 ? Fvconcat (i, vec) : null_vector);
2750 font_add_log ("list", spec, val);
2751 return (val);
c2f5bfd6
KH		 2752}
2753
45eb10fb 2754
35027d0c
KH		 2755/* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2756 nil, is an array of face's attributes, which specifies preferred
2757 font-related attributes. */
45eb10fb 2758
e950d6f1 2759static Lisp_Object
35027d0c
KH		 2760font_matching_entity (f, attrs, spec)
2761 FRAME_PTR f;
2762 Lisp_Object *attrs, spec;
e950d6f1 2763{
e950d6f1
KH		 2764 struct font_driver_list *driver_list = f->font_driver_list;
2765 Lisp_Object ftype, size, entity;
35027d0c 2766 Lisp_Object frame;
819ab95f 2767 Lisp_Object work = Fcopy_font_spec (spec);
e950d6f1 2768
35027d0c 2769 XSETFRAME (frame, f);
e950d6f1
KH		 2770 ftype = AREF (spec, FONT_TYPE_INDEX);
2771 size = AREF (spec, FONT_SIZE_INDEX);
819ab95f 2772
8d0e382e
AR		 2773 if (FLOATP (size))
2774 ASET (work, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
819ab95f
KH		 2775 FONT_SET_STYLE (work, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
2776 FONT_SET_STYLE (work, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
2777 FONT_SET_STYLE (work, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
2778
e950d6f1
KH		 2779 entity = Qnil;
2780 for (; driver_list; driver_list = driver_list->next)
2781 if (driver_list->on
2782 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
2783 {
ca4da08a 2784 Lisp_Object cache = font_get_cache (f, driver_list->driver);
7cee5d63 2785 Lisp_Object copy;
e950d6f1 2786
819ab95f
KH		 2787 ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
2788 entity = assoc_no_quit (work, XCDR (cache));
7cee5d63 2789 if (CONSP (entity))
e950d6f1
KH		 2790 entity = XCDR (entity);
2791 else
2792 {
819ab95f
KH		 2793 entity = driver_list->driver->match (frame, work);
2794 copy = Fcopy_font_spec (work);
7cee5d63
KH		 2795 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2796 XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache)));
e950d6f1
KH		 2797 }
2798 if (! NILP (entity))
2799 break;
2800 }
819ab95f 2801 font_add_log ("match", work, entity);
e950d6f1
KH		 2802 return entity;
2803}
2804
45eb10fb
KH		 2805
2806/* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2807 opened font object. */
2808
c2f5bfd6
KH		 2809static Lisp_Object
2810font_open_entity (f, entity, pixel_size)
2811 FRAME_PTR f;
2812 Lisp_Object entity;
2813 int pixel_size;
2814{
2815 struct font_driver_list *driver_list;
43c0454d 2816 Lisp_Object objlist, size, val, font_object;
c2f5bfd6 2817 struct font *font;
d26424c5 2818 int min_width, height;
c2f5bfd6 2819
d0ab1ebe 2820 font_assert (FONT_ENTITY_P (entity));
c2f5bfd6 2821 size = AREF (entity, FONT_SIZE_INDEX);
c2f5bfd6
KH		 2822 if (XINT (size) != 0)
2823 pixel_size = XINT (size);
2824
2825 for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
2826 objlist = XCDR (objlist))
5e634ec9
KH		 2827 if (! NILP (AREF (XCAR (objlist), FONT_TYPE_INDEX))
2828 && XFONT_OBJECT (XCAR (objlist))->pixel_size == pixel_size)
35027d0c
KH		 2829 return XCAR (objlist);
2830
2831 val = AREF (entity, FONT_TYPE_INDEX);
2832 for (driver_list = f->font_driver_list;
2833 driver_list && ! EQ (driver_list->driver->type, val);
2834 driver_list = driver_list->next);
2835 if (! driver_list)
2836 return Qnil;
c2f5bfd6 2837
35027d0c 2838 font_object = driver_list->driver->open (f, entity, pixel_size);
d0ab1ebe 2839 font_add_log ("open", entity, font_object);
43c0454d 2840 if (NILP (font_object))
35027d0c
KH		 2841 return Qnil;
2842 ASET (entity, FONT_OBJLIST_INDEX,
2843 Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
5e634ec9 2844 ASET (font_object, FONT_OBJLIST_INDEX, Qnil);
35027d0c
KH		 2845 num_fonts++;
2846
2847 font = XFONT_OBJECT (font_object);
2848 min_width = (font->min_width ? font->min_width
2849 : font->average_width ? font->average_width
2850 : font->space_width ? font->space_width
2851 : 1);
d26424c5 2852 height = (font->height ? font->height : 1);
819e81df 2853#ifdef HAVE_WINDOW_SYSTEM
35027d0c
KH		 2854 FRAME_X_DISPLAY_INFO (f)->n_fonts++;
2855 if (FRAME_X_DISPLAY_INFO (f)->n_fonts == 1)
43c0454d 2856 {
35027d0c 2857 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width;
d26424c5 2858 FRAME_SMALLEST_FONT_HEIGHT (f) = height;
35027d0c
KH		 2859 fonts_changed_p = 1;
2860 }
2861 else
2862 {
2863 if (FRAME_SMALLEST_CHAR_WIDTH (f) > min_width)
2864 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width, fonts_changed_p = 1;
d26424c5
KH		 2865 if (FRAME_SMALLEST_FONT_HEIGHT (f) > height)
2866 FRAME_SMALLEST_FONT_HEIGHT (f) = height, fonts_changed_p = 1;
43c0454d 2867 }
819e81df 2868#endif
43c0454d
KH		 2869
2870 return font_object;
c2f5bfd6
KH		 2871}
2872
45eb10fb
KH		 2873
2874/* Close FONT_OBJECT that is opened on frame F. */
2875
c2f5bfd6
KH		 2876void
2877font_close_object (f, font_object)
2878 FRAME_PTR f;
2879 Lisp_Object font_object;
2880{
35027d0c 2881 struct font *font = XFONT_OBJECT (font_object);
c2f5bfd6 2882
5e634ec9
KH		 2883 if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
2884 /* Already closed. */
2885 return;
2886 font_add_log ("close", font_object, Qnil);
2887 font->driver->close (f, font);
819e81df 2888#ifdef HAVE_WINDOW_SYSTEM
5e634ec9
KH		 2889 font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
2890 FRAME_X_DISPLAY_INFO (f)->n_fonts--;
819e81df 2891#endif
5e634ec9 2892 num_fonts--;
c2f5bfd6
KH		 2893}
2894
45eb10fb 2895
1701724c
KH		 2896/* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2897 FONT is a font-entity and it must be opened to check. */
45eb10fb 2898
c2f5bfd6 2899int
1b834a8d 2900font_has_char (f, font, c)
c2f5bfd6 2901 FRAME_PTR f;
1b834a8d 2902 Lisp_Object font;
c2f5bfd6
KH		 2903 int c;
2904{
1b834a8d 2905 struct font *fontp;
c2f5bfd6 2906
1b834a8d
KH		 2907 if (FONT_ENTITY_P (font))
2908 {
2909 Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
2910 struct font_driver_list *driver_list;
2911
2912 for (driver_list = f->font_driver_list;
2913 driver_list && ! EQ (driver_list->driver->type, type);
2914 driver_list = driver_list->next);
2915 if (! driver_list)
2916 return 0;
2917 if (! driver_list->driver->has_char)
2918 return -1;
2919 return driver_list->driver->has_char (font, c);
2920 }
2921
d0ab1ebe 2922 font_assert (FONT_OBJECT_P (font));
35027d0c 2923 fontp = XFONT_OBJECT (font);
1b834a8d
KH		 2924 if (fontp->driver->has_char)
2925 {
35027d0c 2926 int result = fontp->driver->has_char (font, c);
1b834a8d
KH		 2927
2928 if (result >= 0)
2929 return result;
2930 }
2931 return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
c2f5bfd6
KH		 2932}
2933
45eb10fb
KH		 2934
2935/* Return the glyph ID of FONT_OBJECT for character C. */
2936
c2f5bfd6
KH		 2937unsigned
2938font_encode_char (font_object, c)
2939 Lisp_Object font_object;
2940 int c;
2941{
35027d0c 2942 struct font *font;
c2f5bfd6 2943
d0ab1ebe 2944 font_assert (FONT_OBJECT_P (font_object));
35027d0c 2945 font = XFONT_OBJECT (font_object);
c2f5bfd6
KH		 2946 return font->driver->encode_char (font, c);
2947}
2948
45eb10fb
KH		 2949
2950/* Return the name of FONT_OBJECT. */
2951
ef18374f 2952Lisp_Object
c2f5bfd6
KH		 2953font_get_name (font_object)
2954 Lisp_Object font_object;
2955{
d0ab1ebe 2956 font_assert (FONT_OBJECT_P (font_object));
35027d0c 2957 return AREF (font_object, FONT_NAME_INDEX);
ef18374f
KH		 2958}
2959
45eb10fb
KH		 2960
2961/* Return the specification of FONT_OBJECT. */
2962
ef18374f
KH		 2963Lisp_Object
2964font_get_spec (font_object)
2965 Lisp_Object font_object;
2966{
35027d0c 2967 Lisp_Object spec = font_make_spec ();
ef18374f
KH		 2968 int i;
2969
2970 for (i = 0; i < FONT_SIZE_INDEX; i++)
35027d0c
KH		 2971 ASET (spec, i, AREF (font_object, i));
2972 ASET (spec, FONT_SIZE_INDEX,
2973 make_number (XFONT_OBJECT (font_object)->pixel_size));
ef18374f 2974 return spec;
c2f5bfd6
KH		 2975}
2976
35027d0c
KH		 2977Lisp_Object
2978font_spec_from_name (font_name)
2979 Lisp_Object font_name;
2980{
2981 Lisp_Object args[2];
2982
2983 args[0] = QCname;
2984 args[1] = font_name;
2985 return Ffont_spec (2, args);
2986}
2987
45eb10fb 2988
35027d0c
KH		 2989void
2990font_clear_prop (attrs, prop)
2991 Lisp_Object *attrs;
2992 enum font_property_index prop;
2993{
2994 Lisp_Object font = attrs[LFACE_FONT_INDEX];
45eb10fb 2995
35027d0c
KH		 2996 if (! FONTP (font))
2997 return;
2998 if (NILP (AREF (font, prop))
e234927a
CY		 2999 && prop != FONT_FAMILY_INDEX
3000 && prop != FONT_FOUNDRY_INDEX
3001 && prop != FONT_WIDTH_INDEX
4007dd1c 3002 && prop != FONT_SIZE_INDEX)
35027d0c
KH		 3003 return;
3004 font = Fcopy_font_spec (font);
3005 ASET (font, prop, Qnil);
4007dd1c 3006 if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
35027d0c 3007 {
4007dd1c
KH		 3008 if (prop == FONT_FAMILY_INDEX)
3009 ASET (font, FONT_FOUNDRY_INDEX, Qnil);
35027d0c 3010 ASET (font, FONT_ADSTYLE_INDEX, Qnil);
4007dd1c 3011 ASET (font, FONT_REGISTRY_INDEX, Qnil);
35027d0c
KH		 3012 ASET (font, FONT_SIZE_INDEX, Qnil);
3013 ASET (font, FONT_DPI_INDEX, Qnil);
3014 ASET (font, FONT_SPACING_INDEX, Qnil);
3015 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3016 }
3017 else if (prop == FONT_SIZE_INDEX)
3018 {
3019 ASET (font, FONT_DPI_INDEX, Qnil);
3020 ASET (font, FONT_SPACING_INDEX, Qnil);
3021 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3022 }
e234927a
CY		 3023 else if (prop == FONT_WIDTH_INDEX)
3024 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
35027d0c
KH		 3025 attrs[LFACE_FONT_INDEX] = font;
3026}
3027
3028void
3029font_update_lface (f, attrs)
3030 FRAME_PTR f;
3031 Lisp_Object *attrs;
c2f5bfd6 3032{
d0ab1ebe 3033 Lisp_Object spec;
35027d0c
KH		 3034
3035 spec = attrs[LFACE_FONT_INDEX];
3036 if (! FONT_SPEC_P (spec))
3037 return;
3038
4007dd1c
KH		 3039 if (! NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
3040 attrs[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FOUNDRY_INDEX));
3041 if (! NILP (AREF (spec, FONT_FAMILY_INDEX)))
3042 attrs[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FAMILY_INDEX));
35027d0c
KH		 3043 if (! NILP (AREF (spec, FONT_WEIGHT_INDEX)))
3044 attrs[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (spec);
3045 if (! NILP (AREF (spec, FONT_SLANT_INDEX)))
3046 attrs[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (spec);;
3047 if (! NILP (AREF (spec, FONT_WIDTH_INDEX)))
3048 attrs[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (spec);
3049 if (! NILP (AREF (spec, FONT_SIZE_INDEX)))
3050 {
3051 int point;
3052
3053 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
3054 {
3055 Lisp_Object val;
3056 int dpi = f->resy;
3057
3058 val = Ffont_get (spec, QCdpi);
3059 if (! NILP (val))
3060 dpi = XINT (val);
3061 point = PIXEL_TO_POINT (XINT (AREF (spec, FONT_SIZE_INDEX)) * 10,
3062 dpi);
3063 }
3064 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
3065 point = XFLOAT_DATA (AREF (spec, FONT_SIZE_INDEX)) * 10;
3066 attrs[LFACE_HEIGHT_INDEX] = make_number (point);
3067 }
c2f5bfd6
KH		 3068}
3069
45eb10fb 3070
35027d0c
KH		 3071/* Return a font-entity satisfying SPEC and best matching with face's
3072 font related attributes in ATTRS. C, if not negative, is a
1701724c 3073 character that the entity must support. */
c2f5bfd6
KH		 3074
3075Lisp_Object
35027d0c 3076font_find_for_lface (f, attrs, spec, c)
c2f5bfd6 3077 FRAME_PTR f;
35027d0c 3078 Lisp_Object *attrs;
c2f5bfd6 3079 Lisp_Object spec;
1701724c 3080 int c;
c2f5bfd6 3081{
4007dd1c 3082 Lisp_Object work;
35027d0c 3083 Lisp_Object frame, entities, val, props[FONT_REGISTRY_INDEX + 1] ;
22459668 3084 Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
1d1e1245 3085 int pixel_size;
22459668 3086 int i, j, k, l, result;
d0a47776
KH		 3087
3088 registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
3089 if (NILP (registry[0]))
3090 {
edfda783 3091 registry[0] = DEFAULT_ENCODING;
d0a47776
KH		 3092 registry[1] = Qascii_0;
3093 registry[2] = null_vector;
3094 }
3095 else
3096 registry[1] = null_vector;
c2f5bfd6 3097
4007dd1c 3098 if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
fe5ddfbc 3099 {
35027d0c 3100 struct charset *encoding, *repertory;
1701724c 3101
4007dd1c
KH		 3102 if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
3103 &encoding, &repertory) < 0)
35027d0c
KH		 3104 return Qnil;
3105 if (repertory)
1701724c 3106 {
35027d0c 3107 if (ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
1701724c 3108 return Qnil;
35027d0c
KH		 3109 /* Any font of this registry support C. So, let's
3110 suppress the further checking. */
3111 c = -1;
1701724c 3112 }
35027d0c
KH		 3113 else if (c > encoding->max_char)
3114 return Qnil;
c2f5bfd6
KH		 3115 }
3116
4007dd1c 3117 work = Fcopy_font_spec (spec);
35027d0c
KH		 3118 XSETFRAME (frame, f);
3119 size = AREF (spec, FONT_SIZE_INDEX);
1d1e1245
KH		 3120 pixel_size = font_pixel_size (f, spec);
3121 if (pixel_size == 0)
3122 {
3123 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
3124
3125 pixel_size = POINT_TO_PIXEL (pt / 10, f->resy);
3126 }
4007dd1c
KH		 3127 ASET (work, FONT_SIZE_INDEX, Qnil);
3128 foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
3129 if (! NILP (foundry[0]))
3130 foundry[1] = null_vector;
3131 else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
3132 {
071132a9
KH		 3133 val = attrs[LFACE_FOUNDRY_INDEX];
3134 foundry[0] = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
4007dd1c
KH		 3135 foundry[1] = Qnil;
3136 foundry[2] = null_vector;
3137 }
3138 else
3139 foundry[0] = Qnil, foundry[1] = null_vector;
3140
22459668
KH		 3141 adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
3142 if (! NILP (adstyle[0]))
3143 adstyle[1] = null_vector;
3144 else if (FONTP (attrs[LFACE_FONT_INDEX]))
3145 {
3146 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3147
3148 if (! NILP (AREF (face_font, FONT_ADSTYLE_INDEX)))
3149 {
3150 adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
3151 adstyle[1] = Qnil;
3152 adstyle[2] = null_vector;
3153 }
3154 else
3155 adstyle[0] = Qnil, adstyle[1] = null_vector;
3156 }
3157 else
3158 adstyle[0] = Qnil, adstyle[1] = null_vector;
3159
3160
4007dd1c
KH		 3161 val = AREF (work, FONT_FAMILY_INDEX);
3162 if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
071132a9
KH		 3163 {
3164 val = attrs[LFACE_FAMILY_INDEX];
3165 val = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
3166 }
4007dd1c
KH		 3167 if (NILP (val))
3168 {
3169 family = alloca ((sizeof family[0]) * 2);
3170 family[0] = Qnil;
3171 family[1] = null_vector; /* terminator. */
3172 }
3173 else
3174 {
3175 Lisp_Object alters
819ab95f
KH		 3176 = Fassoc_string (val, Vface_alternative_font_family_alist,
3177#ifndef HAVE_NS
3178 Qt
3179#else
3180 Qnil
3181#endif
3182 );
4007dd1c
KH		 3183
3184 if (! NILP (alters))
3185 {
3186 family = alloca ((sizeof family[0]) * (XINT (Flength (alters)) + 2));
3187 for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
3188 family[i] = XCAR (alters);
3189 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3190 family[i++] = Qnil;
3191 family[i] = null_vector;
3192 }
3193 else
3194 {
3195 family = alloca ((sizeof family[0]) * 3);
3196 i = 0;
3197 family[i++] = val;
3198 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3199 family[i++] = Qnil;
3200 family[i] = null_vector;
3201 }
3202 }
3203
d0a47776 3204 for (i = 0; SYMBOLP (family[i]); i++)
4007dd1c 3205 {
d0a47776
KH		 3206 ASET (work, FONT_FAMILY_INDEX, family[i]);
3207 for (j = 0; SYMBOLP (foundry[j]); j++)
4007dd1c 3208 {
d0a47776
KH		 3209 ASET (work, FONT_FOUNDRY_INDEX, foundry[j]);
3210 for (k = 0; SYMBOLP (registry[k]); k++)
3211 {
904a2e0e 3212 ASET (work, FONT_REGISTRY_INDEX, registry[k]);
22459668
KH		 3213 for (l = 0; SYMBOLP (adstyle[l]); l++)
3214 {
3215 ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
3216 entities = font_list_entities (frame, work);
3217 if (ASIZE (entities) > 0)
3218 goto found;
3219 }
d0a47776 3220 }
4007dd1c 3221 }
4007dd1c 3222 }
d0a47776
KH		 3223 return Qnil;
3224 found:
35027d0c
KH		 3225 if (ASIZE (entities) == 1)
3226 {
3227 if (c < 0)
3228 return AREF (entities, 0);
3229 }
3230 else
c2f5bfd6 3231 {
fe5ddfbc 3232 /* Sort fonts by properties specified in LFACE. */
ec6fe57c 3233 Lisp_Object prefer = scratch_font_prefer;
d0ab1ebe 3234
35027d0c 3235 for (i = 0; i < FONT_EXTRA_INDEX; i++)
4007dd1c 3236 ASET (prefer, i, AREF (work, i));
79f105c9
KH		 3237 if (FONTP (attrs[LFACE_FONT_INDEX]))
3238 {
3239 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3240
3241 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3242 if (NILP (AREF (prefer, i)))
3243 ASET (prefer, i, AREF (face_font, i));
3244 }
35027d0c
KH		 3245 if (NILP (AREF (prefer, FONT_WEIGHT_INDEX)))
3246 FONT_SET_STYLE (prefer, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
3247 if (NILP (AREF (prefer, FONT_SLANT_INDEX)))
3248 FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
3249 if (NILP (AREF (prefer, FONT_WIDTH_INDEX)))
3250 FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
1d1e1245 3251 ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size));
7181ea6a 3252 entities = font_sort_entites (entities, prefer, frame, c < 0);
c2f5bfd6 3253 }
1701724c 3254 if (c < 0)
35027d0c 3255 return entities;
45eb10fb 3256
35027d0c
KH		 3257 for (i = 0; i < ASIZE (entities); i++)
3258 {
3259 int j;
3260
3261 val = AREF (entities, i);
3262 if (i > 0)
3263 {
3264 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3265 if (! EQ (AREF (val, j), props[j]))
3266 break;
3267 if (j > FONT_REGISTRY_INDEX)
3268 continue;
3269 }
3270 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3271 props[j] = AREF (val, j);
3272 result = font_has_char (f, val, c);
3273 if (result > 0)
3274 return val;
3275 if (result == 0)
3276 return Qnil;
3277 val = font_open_for_lface (f, val, attrs, spec);
3278 if (NILP (val))
3279 continue;
3280 result = font_has_char (f, val, c);
3281 font_close_object (f, val);
3282 if (result > 0)
3283 return AREF (entities, i);
3284 }
1701724c
KH		 3285 return Qnil;
3286}
45eb10fb
KH		 3287
3288
c2f5bfd6 3289Lisp_Object
35027d0c 3290font_open_for_lface (f, entity, attrs, spec)
c2f5bfd6 3291 FRAME_PTR f;
c2f5bfd6 3292 Lisp_Object entity;
35027d0c 3293 Lisp_Object *attrs;
733fd013 3294 Lisp_Object spec;
c2f5bfd6 3295{
9331887d 3296 int size;
c2f5bfd6 3297
4007dd1c
KH		 3298 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX))
3299 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
3300 size = XINT (AREF (entity, FONT_SIZE_INDEX));
3301 else if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
1d1e1245 3302 size = font_pixel_size (f, spec);
733fd013
KH		 3303 else
3304 {
35027d0c 3305 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
733fd013
KH		 3306
3307 pt /= 10;
3308 size = POINT_TO_PIXEL (pt, f->resy);
ed96cde8
AR		 3309#ifdef HAVE_NS
3310 if (size == 0)
3311 {
3312 Lisp_Object ffsize = get_frame_param(f, Qfontsize);
3313 size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
3314 }
3315#endif
733fd013 3316 }
c2f5bfd6
KH		 3317 return font_open_entity (f, entity, size);
3318}
3319
45eb10fb 3320
35027d0c
KH		 3321/* Find a font satisfying SPEC and best matching with face's
3322 attributes in ATTRS on FRAME, and return the opened
3323 font-object. */
45eb10fb 3324
35027d0c
KH		 3325Lisp_Object
3326font_load_for_lface (f, attrs, spec)
c2f5bfd6 3327 FRAME_PTR f;
35027d0c 3328 Lisp_Object *attrs, spec;
c2f5bfd6 3329{
35027d0c 3330 Lisp_Object entity;
ef18374f 3331
35027d0c
KH		 3332 entity = font_find_for_lface (f, attrs, spec, -1);
3333 if (NILP (entity))
ef18374f 3334 {
35027d0c
KH		 3335 /* No font is listed for SPEC, but each font-backend may have
3336 the different criteria about "font matching". So, try
3337 it. */
3338 entity = font_matching_entity (f, attrs, spec);
3339 if (NILP (entity))
3340 return Qnil;
c2f5bfd6 3341 }
35027d0c 3342 return font_open_for_lface (f, entity, attrs, spec);
c2f5bfd6
KH		 3343}
3344
45eb10fb
KH		 3345
3346/* Make FACE on frame F ready to use the font opened for FACE. */
3347
c2f5bfd6
KH		 3348void
3349font_prepare_for_face (f, face)
3350 FRAME_PTR f;
3351 struct face *face;
3352{
35027d0c
KH		 3353 if (face->font->driver->prepare_face)
3354 face->font->driver->prepare_face (f, face);
c2f5bfd6
KH		 3355}
3356
45eb10fb
KH		 3357
3358/* Make FACE on frame F stop using the font opened for FACE. */
3359
c2f5bfd6
KH		 3360void
3361font_done_for_face (f, face)
3362 FRAME_PTR f;
3363 struct face *face;
3364{
35027d0c
KH		 3365 if (face->font->driver->done_face)
3366 face->font->driver->done_face (f, face);
c2f5bfd6
KH		 3367 face->extra = NULL;
3368}
3369
45eb10fb
KH		 3370
3371/* Open a font best matching with NAME on frame F. If no proper font
3372 is found, return Qnil. */
3373
c2f5bfd6
KH		 3374Lisp_Object
3375font_open_by_name (f, name)
3376 FRAME_PTR f;
3377 char *name;
3378{
ef18374f 3379 Lisp_Object args[2];
4007dd1c 3380 Lisp_Object spec, attrs[LFACE_VECTOR_SIZE];
a9262bb8 3381
ef18374f
KH		 3382 args[0] = QCname;
3383 args[1] = make_unibyte_string (name, strlen (name));
3384 spec = Ffont_spec (2, args);
4007dd1c
KH		 3385 /* We set up the default font-related attributes of a face to prefer
3386 a moderate font. */
3387 attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
3388 attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
3389 = attrs[LFACE_SLANT_INDEX] = Qnormal;
ed96cde8 3390#ifndef HAVE_NS
4007dd1c 3391 attrs[LFACE_HEIGHT_INDEX] = make_number (120);
ed96cde8
AR		 3392#else
3393 attrs[LFACE_HEIGHT_INDEX] = make_number (0);
3394#endif
4007dd1c
KH		 3395 attrs[LFACE_FONT_INDEX] = Qnil;
3396
3397 return font_load_for_lface (f, attrs, spec);
c2f5bfd6
KH		 3398}
3399
3400
3401/* Register font-driver DRIVER. This function is used in two ways.
3402
417a1b10
KH		 3403 The first is with frame F non-NULL. In this case, make DRIVER
3404 available (but not yet activated) on F. All frame creaters
3405 (e.g. Fx_create_frame) must call this function at least once with
3406 an available font-driver.
c2f5bfd6
KH		 3407
3408 The second is with frame F NULL. In this case, DRIVER is globally
3409 registered in the variable `font_driver_list'. All font-driver
3410 implementations must call this function in its syms_of_XXXX
3411 (e.g. syms_of_xfont). */
3412
3413void
3414register_font_driver (driver, f)
3415 struct font_driver *driver;
3416 FRAME_PTR f;
3417{
3418 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
3419 struct font_driver_list *prev, *list;
3420
3421 if (f && ! driver->draw)
43a1d19b 3422 error ("Unusable font driver for a frame: %s",
c2f5bfd6
KH		 3423 SDATA (SYMBOL_NAME (driver->type)));
3424
3425 for (prev = NULL, list = root; list; prev = list, list = list->next)
cf23b845 3426 if (EQ (list->driver->type, driver->type))
c2f5bfd6
KH		 3427 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
3428
3429 list = malloc (sizeof (struct font_driver_list));
417a1b10 3430 list->on = 0;
c2f5bfd6
KH		 3431 list->driver = driver;
3432 list->next = NULL;
3433 if (prev)
3434 prev->next = list;
3435 else if (f)
3436 f->font_driver_list = list;
3437 else
3438 font_driver_list = list;
72606e45
KH		 3439 if (! f)
3440 num_font_drivers++;
c2f5bfd6
KH		 3441}
3442
45eb10fb 3443
f697fff0 3444/* Make the frame F use font backends listed in NEW_DRIVERS (list of
ca4da08a
KH		 3445 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3446 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
417a1b10 3447
ca4da08a
KH		 3448 A caller must free all realized faces if any in advance. The
3449 return value is a list of font backends actually made used on
3450 F. */
e950d6f1
KH		 3451
3452Lisp_Object
3453font_update_drivers (f, new_drivers)
417a1b10
KH		 3454 FRAME_PTR f;
3455 Lisp_Object new_drivers;
417a1b10
KH		 3456{
3457 Lisp_Object active_drivers = Qnil;
4007dd1c 3458 struct font_driver *driver;
417a1b10
KH		 3459 struct font_driver_list *list;
3460
4007dd1c
KH		 3461 /* At first, turn off non-requested drivers, and turn on requested
3462 drivers. */
f697fff0 3463 for (list = f->font_driver_list; list; list = list->next)
4007dd1c
KH		 3464 {
3465 driver = list->driver;
3466 if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers)))
3467 != list->on)
3468 {
3469 if (list->on)
3470 {
3471 if (driver->end_for_frame)
3472 driver->end_for_frame (f);
3473 font_finish_cache (f, driver);
3474 list->on = 0;
3475 }
3476 else
3477 {
3478 if (! driver->start_for_frame
3479 || driver->start_for_frame (f) == 0)
3480 {
3481 font_prepare_cache (f, driver);
3482 list->on = 1;
3483 }
3484 }
3485 }
3486 }
3487
3488 if (NILP (new_drivers))
3489 return Qnil;
3490
3491 if (! EQ (new_drivers, Qt))
3492 {
3493 /* Re-order the driver list according to new_drivers. */
3306c6dc 3494 struct font_driver_list **list_table, **next;
4007dd1c
KH		 3495 Lisp_Object tail;
3496 int i;
3497
3498 list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
3499 for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
3500 {
3501 for (list = f->font_driver_list; list; list = list->next)
3502 if (list->on && EQ (list->driver->type, XCAR (tail)))
3503 break;
3504 if (list)
3505 list_table[i++] = list;
3506 }
3507 for (list = f->font_driver_list; list; list = list->next)
3508 if (! list->on)
3509 list_table[i] = list;
3510 list_table[i] = NULL;
3511
3306c6dc 3512 next = &f->font_driver_list;
4007dd1c
KH		 3513 for (i = 0; list_table[i]; i++)
3514 {
3306c6dc
AS		 3515 *next = list_table[i];
3516 next = &(*next)->next;
4007dd1c 3517 }
3306c6dc 3518 *next = NULL;
4007dd1c 3519 }
417a1b10 3520
4007dd1c
KH		 3521 for (list = f->font_driver_list; list; list = list->next)
3522 if (list->on)
3523 active_drivers = nconc2 (active_drivers,
3524 Fcons (list->driver->type, Qnil));
e950d6f1 3525 return active_drivers;
417a1b10
KH		 3526}
3527
f697fff0
KH		 3528int
3529font_put_frame_data (f, driver, data)
3530 FRAME_PTR f;
3531 struct font_driver *driver;
3532 void *data;
3533{
3534 struct font_data_list *list, *prev;
3535
3536 for (prev = NULL, list = f->font_data_list; list;
3537 prev = list, list = list->next)
3538 if (list->driver == driver)
3539 break;
3540 if (! data)
3541 {
3542 if (list)
3543 {
3544 if (prev)
3545 prev->next = list->next;
3546 else
3547 f->font_data_list = list->next;
3548 free (list);
3549 }
3550 return 0;
3551 }
3552
3553 if (! list)
3554 {
3555 list = malloc (sizeof (struct font_data_list));
3556 if (! list)
3557 return -1;
3558 list->driver = driver;
3559 list->next = f->font_data_list;
3560 f->font_data_list = list;
3561 }
3562 list->data = data;
3563 return 0;
3564}
3565
3566
3567void *
3568font_get_frame_data (f, driver)
3569 FRAME_PTR f;
3570 struct font_driver *driver;
3571{
3572 struct font_data_list *list;
3573
3574 for (list = f->font_data_list; list; list = list->next)
3575 if (list->driver == driver)
3576 break;
3577 if (! list)
3578 return NULL;
3579 return list->data;
3580}
3581
417a1b10 3582
45eb10fb 3583/* Return the font used to draw character C by FACE at buffer position
e3ee0340
KH		 3584 POS in window W. If STRING is non-nil, it is a string containing C
3585 at index POS. If C is negative, get C from the current buffer or
3586 STRING. */
45eb10fb 3587
10d16101 3588Lisp_Object
e3ee0340 3589font_at (c, pos, face, w, string)
10d16101
KH		 3590 int c;
3591 EMACS_INT pos;
3592 struct face *face;
3593 struct window *w;
e3ee0340 3594 Lisp_Object string;
10d16101
KH		 3595{
3596 FRAME_PTR f;
e3ee0340 3597 int multibyte;
35027d0c 3598 Lisp_Object font_object;
e3ee0340
KH		 3599
3600 if (c < 0)
3601 {
3602 if (NILP (string))
3603 {
3604 multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3605 if (multibyte)
3606 {
3607 EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
3608
3609 c = FETCH_CHAR (pos_byte);
3610 }
3611 else
3612 c = FETCH_BYTE (pos);
3613 }
3614 else
3615 {
3616 unsigned char *str;
3617
3618 multibyte = STRING_MULTIBYTE (string);
3619 if (multibyte)
3620 {
3621 EMACS_INT pos_byte = string_char_to_byte (string, pos);
3622
3623 str = SDATA (string) + pos_byte;
3624 c = STRING_CHAR (str, 0);
3625 }
3626 else
3627 c = SDATA (string)[pos];
3628 }
3629 }
10d16101
KH		 3630
3631 f = XFRAME (w->frame);
1385a806
KH		 3632 if (! FRAME_WINDOW_P (f))
3633 return Qnil;
10d16101
KH		 3634 if (! face)
3635 {
e3ee0340 3636 int face_id;
0f8b27ea 3637 EMACS_INT endptr;
e3ee0340
KH		 3638
3639 if (STRINGP (string))
3640 face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
10d16101
KH		 3641 DEFAULT_FACE_ID, 0);
3642 else
e3ee0340 3643 face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
10d16101
KH		 3644 pos + 100, 0);
3645 face = FACE_FROM_ID (f, face_id);
3646 }
e3ee0340
KH		 3647 if (multibyte)
3648 {
3649 int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
3650 face = FACE_FROM_ID (f, face_id);
3651 }
35027d0c 3652 if (! face->font)
10d16101 3653 return Qnil;
35027d0c 3654
35027d0c
KH		 3655 XSETFONT (font_object, face->font);
3656 return font_object;
3657}
3658
3659
071132a9
KH		 3660#ifdef HAVE_WINDOW_SYSTEM
3661
3662/* Check how many characters after POS (at most to *LIMIT) can be
3663 displayed by the same font on the window W. FACE, if non-NULL, is
3664 the face selected for the character at POS. If STRING is not nil,
3665 it is the string to check instead of the current buffer. In that
3666 case, FACE must be not NULL.
027a33c0 3667
071132a9
KH		 3668 The return value is the font-object for the character at POS.
3669 *LIMIT is set to the position where that font can't be used.
35027d0c 3670
071132a9
KH		 3671 It is assured that the current buffer (or STRING) is multibyte. */
3672
3673Lisp_Object
3674font_range (pos, limit, w, face, string)
3675 EMACS_INT pos, *limit;
3676 struct window *w;
35027d0c 3677 struct face *face;
35027d0c
KH		 3678 Lisp_Object string;
3679{
071132a9 3680 EMACS_INT pos_byte, ignore, start, start_byte;
35027d0c 3681 int c;
071132a9 3682 Lisp_Object font_object = Qnil;
35027d0c
KH		 3683
3684 if (NILP (string))
3685 {
35027d0c 3686 pos_byte = CHAR_TO_BYTE (pos);
071132a9
KH		 3687 if (! face)
3688 {
3689 int face_id;
3690
3691 face_id = face_at_buffer_position (w, pos, 0, 0, &ignore, *limit, 0);
3692 face = FACE_FROM_ID (XFRAME (w->frame), face_id);
3693 }
35027d0c
KH		 3694 }
3695 else
3696 {
071132a9 3697 font_assert (face);
35027d0c
KH		 3698 pos_byte = string_char_to_byte (string, pos);
3699 }
3700
071132a9
KH		 3701 start = pos, start_byte = pos_byte;
3702 while (pos < *limit)
35027d0c 3703 {
071132a9 3704 Lisp_Object category;
35027d0c
KH		 3705
3706 if (NILP (string))
3707 FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
3708 else
3709 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
071132a9 3710 if (NILP (font_object))
35027d0c 3711 {
071132a9
KH		 3712 font_object = font_for_char (face, c, pos - 1, string);
3713 if (NILP (font_object))
3714 return Qnil;
35027d0c
KH		 3715 continue;
3716 }
071132a9
KH		 3717
3718 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3719 if (! EQ (category, QCf)
3720 && font_encode_char (font_object, c) == FONT_INVALID_CODE)
35027d0c 3721 {
071132a9
KH		 3722 Lisp_Object f = font_for_char (face, c, pos - 1, string);
3723 EMACS_INT i, i_byte;
3724
3725
3726 if (NILP (f))
3727 {
3728 *limit = pos - 1;
3729 return font_object;
3730 }
3731 i = start, i_byte = start_byte;
3732 while (i < pos - 1)
3733 {
3734
3735 if (NILP (string))
3736 FETCH_CHAR_ADVANCE_NO_CHECK (c, i, i_byte);
3737 else
3738 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, i, i_byte);
3739 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3740 if (! EQ (category, QCf)
3741 && font_encode_char (f, c) == FONT_INVALID_CODE)
3742 {
3743 *limit = pos - 1;
3744 return font_object;
3745 }
3746 }
3747 font_object = f;
35027d0c
KH		 3748 }
3749 }
071132a9 3750 return font_object;
10d16101 3751}
071132a9 3752#endif
10d16101 3753
c2f5bfd6
KH		 3754\f
3755/* Lisp API */
3756
35027d0c 3757DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
6c8ec042 3758 doc: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
35027d0c
KH		 3759Return nil otherwise.
3760Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
027a33c0 3761which kind of font it is. It must be one of `font-spec', `font-entity',
35027d0c
KH		 3762`font-object'. */)
3763 (object, extra_type)
3764 Lisp_Object object, extra_type;
c2f5bfd6 3765{
35027d0c
KH		 3766 if (NILP (extra_type))
3767 return (FONTP (object) ? Qt : Qnil);
3768 if (EQ (extra_type, Qfont_spec))
3769 return (FONT_SPEC_P (object) ? Qt : Qnil);
3770 if (EQ (extra_type, Qfont_entity))
3771 return (FONT_ENTITY_P (object) ? Qt : Qnil);
3772 if (EQ (extra_type, Qfont_object))
3773 return (FONT_OBJECT_P (object) ? Qt : Qnil);
3774 wrong_type_argument (intern ("font-extra-type"), extra_type);
c2f5bfd6
KH		 3775}
3776
3777DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
45eb10fb
KH		 3778 doc: /* Return a newly created font-spec with arguments as properties.
3779
3780ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3781valid font property name listed below:
3782
3783`:family', `:weight', `:slant', `:width'
3784
3785They are the same as face attributes of the same name. See
51c01100 3786`set-face-attribute'.
45eb10fb
KH		 3787
3788`:foundry'
3789
3790VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3791
3792`:adstyle'
3793
3794VALUE must be a string or a symbol specifying the additional
35027d0c 3795typographic style information of a font, e.g. ``sans''.
45eb10fb
KH		 3796
3797`:registry'
3798
3799VALUE must be a string or a symbol specifying the charset registry and
3800encoding of a font, e.g. ``iso8859-1''.
3801
3802`:size'
3803
3804VALUE must be a non-negative integer or a floating point number
35027d0c 3805specifying the font size. It specifies the font size in pixels
f697fff0 3806(if VALUE is an integer), or in points (if VALUE is a float).
2babb359
KH		 3807
3808`:name'
3809
7a18a178
JB		 3810VALUE must be a string of XLFD-style or fontconfig-style font name.
3811usage: (font-spec ARGS ...) */)
c2f5bfd6
KH		 3812 (nargs, args)
3813 int nargs;
3814 Lisp_Object *args;
3815{
35027d0c 3816 Lisp_Object spec = font_make_spec ();
c2f5bfd6
KH		 3817 int i;
3818
3819 for (i = 0; i < nargs; i += 2)
3820 {
c2f5bfd6
KH		 3821 Lisp_Object key = args[i], val = args[i + 1];
3822
35027d0c
KH		 3823 if (EQ (key, QCname))
3824 {
3825 CHECK_STRING (val);
3826 font_parse_name ((char *) SDATA (val), spec);
3827 font_put_extra (spec, key, val);
3828 }
c2f5bfd6 3829 else
4485a28e 3830 {
35027d0c
KH		 3831 int idx = get_font_prop_index (key);
3832
3833 if (idx >= 0)
ec6fe57c 3834 {
35027d0c
KH		 3835 val = font_prop_validate (idx, Qnil, val);
3836 if (idx < FONT_EXTRA_INDEX)
3837 ASET (spec, idx, val);
3838 else
3839 font_put_extra (spec, key, val);
ec6fe57c 3840 }
35027d0c
KH		 3841 else
3842 font_put_extra (spec, key, font_prop_validate (0, key, val));
4485a28e 3843 }
e950d6f1 3844 }
c2f5bfd6
KH		 3845 return spec;
3846}
3847
35027d0c
KH		 3848DEFUN ("copy-font-spec", Fcopy_font_spec, Scopy_font_spec, 1, 1, 0,
3849 doc: /* Return a copy of FONT as a font-spec. */)
3850 (font)
3851 Lisp_Object font;
3852{
d26424c5 3853 Lisp_Object new_spec, tail, prev, extra;
35027d0c
KH		 3854 int i;
3855
3856 CHECK_FONT (font);
3857 new_spec = font_make_spec ();
3858 for (i = 1; i < FONT_EXTRA_INDEX; i++)
3859 ASET (new_spec, i, AREF (font, i));
d26424c5
KH		 3860 extra = Fcopy_sequence (AREF (font, FONT_EXTRA_INDEX));
3861 /* We must remove :font-entity property. */
3862 for (prev = Qnil, tail = extra; CONSP (tail); prev = tail, tail = XCDR (tail))
3863 if (EQ (XCAR (XCAR (tail)), QCfont_entity))
3864 {
3865 if (NILP (prev))
3866 extra = XCDR (extra);
3867 else
3868 XSETCDR (prev, XCDR (tail));
3869 break;
3870 }
35027d0c
KH		 3871 ASET (new_spec, FONT_EXTRA_INDEX, extra);
3872 return new_spec;
3873}
3874
3875DEFUN ("merge-font-spec", Fmerge_font_spec, Smerge_font_spec, 2, 2, 0,
3876 doc: /* Merge font-specs FROM and TO, and return a new font-spec.
3877Every specified properties in FROM override the corresponding
3878properties in TO. */)
3879 (from, to)
3880 Lisp_Object from, to;
3881{
3882 Lisp_Object extra, tail;
3883 int i;
3884
3885 CHECK_FONT (from);
3886 CHECK_FONT (to);
3887 to = Fcopy_font_spec (to);
3888 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3889 ASET (to, i, AREF (from, i));
3890 extra = AREF (to, FONT_EXTRA_INDEX);
3891 for (tail = AREF (from, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
3892 if (! EQ (XCAR (XCAR (tail)), Qfont_entity))
3893 {
3894 Lisp_Object slot = assq_no_quit (XCAR (XCAR (tail)), extra);
3895
3896 if (! NILP (slot))
3897 XSETCDR (slot, XCDR (XCAR (tail)));
3898 else
3899 extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
3900 }
3901 ASET (to, FONT_EXTRA_INDEX, extra);
3902 return to;
3903}
c2f5bfd6
KH		 3904
3905DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
45eb10fb 3906 doc: /* Return the value of FONT's property KEY.
e950d6f1 3907FONT is a font-spec, a font-entity, or a font-object. */)
45eb10fb
KH		 3908 (font, key)
3909 Lisp_Object font, key;
c2f5bfd6 3910{
35027d0c 3911 int idx;
c2f5bfd6 3912
35027d0c
KH		 3913 CHECK_FONT (font);
3914 CHECK_SYMBOL (key);
e80e09b4 3915
35027d0c 3916 idx = get_font_prop_index (key);
2babb359
KH		 3917 if (idx >= FONT_WEIGHT_INDEX && idx <= FONT_WIDTH_INDEX)
3918 return font_style_symbolic (font, idx, 0);
35027d0c 3919 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
c2f5bfd6 3920 return AREF (font, idx);
35027d0c 3921 return Fcdr (Fassq (key, AREF (font, FONT_EXTRA_INDEX)));
c2f5bfd6
KH		 3922}
3923
51cf11be
AS		 3924#ifdef HAVE_WINDOW_SYSTEM
3925
b1868a1a
CY		 3926DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1, 2, 0,
3927 doc: /* Return a plist of face attributes generated by FONT.
3928FONT is a font name, a font-spec, a font-entity, or a font-object.
3929The return value is a list of the form
3930
6f568955 3931\(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
b1868a1a 3932
48105a6a 3933where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
5989ba2f
CY		 3934compatible with `set-face-attribute'. Some of these key-attribute pairs
3935may be omitted from the list if they are not specified by FONT.
b1868a1a 3936
48105a6a
JB		 3937The optional argument FRAME specifies the frame that the face attributes
3938are to be displayed on. If omitted, the selected frame is used. */)
b1868a1a 3939 (font, frame)
6f568955 3940 Lisp_Object font, frame;
b1868a1a
CY		 3941{
3942 struct frame *f;
3943 Lisp_Object plist[10];
3944 Lisp_Object val;
5989ba2f 3945 int n = 0;
b1868a1a
CY		 3946
3947 if (NILP (frame))
3948 frame = selected_frame;
3949 CHECK_LIVE_FRAME (frame);
3950 f = XFRAME (frame);
3951
3952 if (STRINGP (font))
3953 {
3954 int fontset = fs_query_fontset (font, 0);
3955 Lisp_Object name = font;
3956 if (fontset >= 0)
3957 font = fontset_ascii (fontset);
3958 font = font_spec_from_name (name);
3959 if (! FONTP (font))
3960 signal_error ("Invalid font name", name);
3961 }
3962 else if (! FONTP (font))
3963 signal_error ("Invalid font object", font);
3964
b1868a1a 3965 val = AREF (font, FONT_FAMILY_INDEX);
5989ba2f
CY		 3966 if (! NILP (val))
3967 {
3968 plist[n++] = QCfamily;
3969 plist[n++] = SYMBOL_NAME (val);
3970 }
b1868a1a 3971
b1868a1a
CY		 3972 val = AREF (font, FONT_SIZE_INDEX);
3973 if (INTEGERP (val))
3974 {
3975 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
3976 int dpi = INTEGERP (font_dpi) ? XINT (font_dpi) : f->resy;
5989ba2f 3977 plist[n++] = QCheight;
c3bb5465 3978 plist[n++] = make_number (PIXEL_TO_POINT (XINT (val) * 10, dpi));
b1868a1a
CY		 3979 }
3980 else if (FLOATP (val))
5989ba2f
CY		 3981 {
3982 plist[n++] = QCheight;
3983 plist[n++] = make_number (10 * (int) XFLOAT_DATA (val));
3984 }
b1868a1a 3985
b1868a1a 3986 val = FONT_WEIGHT_FOR_FACE (font);
5989ba2f
CY		 3987 if (! NILP (val))
3988 {
3989 plist[n++] = QCweight;
3990 plist[n++] = val;
3991 }
b1868a1a 3992
b1868a1a 3993 val = FONT_SLANT_FOR_FACE (font);
5989ba2f
CY		 3994 if (! NILP (val))
3995 {
3996 plist[n++] = QCslant;
3997 plist[n++] = val;
3998 }
b1868a1a 3999
b1868a1a 4000 val = FONT_WIDTH_FOR_FACE (font);
5989ba2f
CY		 4001 if (! NILP (val))
4002 {
4003 plist[n++] = QCwidth;
4004 plist[n++] = val;
4005 }
b1868a1a 4006
5989ba2f 4007 return Flist (n, plist);
b1868a1a 4008}
c2f5bfd6 4009
51cf11be
AS		 4010#endif
4011
c2f5bfd6 4012DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
51c01100 4013 doc: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
c2f5bfd6
KH		 4014 (font_spec, prop, val)
4015 Lisp_Object font_spec, prop, val;
4016{
35027d0c 4017 int idx;
c2f5bfd6
KH		 4018
4019 CHECK_FONT_SPEC (font_spec);
35027d0c
KH		 4020 idx = get_font_prop_index (prop);
4021 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
69eb9e8b 4022 ASET (font_spec, idx, font_prop_validate (idx, Qnil, val));
c2f5bfd6 4023 else
35027d0c 4024 font_put_extra (font_spec, prop, font_prop_validate (0, prop, val));
c2f5bfd6
KH		 4025 return val;
4026}
4027
4028DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
4029 doc: /* List available fonts matching FONT-SPEC on the current frame.
4030Optional 2nd argument FRAME specifies the target frame.
4031Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
45eb10fb
KH		 4032Optional 4th argument PREFER, if non-nil, is a font-spec to
4033control the order of the returned list. Fonts are sorted by
027a33c0 4034how close they are to PREFER. */)
c2f5bfd6
KH		 4035 (font_spec, frame, num, prefer)
4036 Lisp_Object font_spec, frame, num, prefer;
4037{
4038 Lisp_Object vec, list, tail;
4039 int n = 0, i, len;
4040
4041 if (NILP (frame))
4042 frame = selected_frame;
4043 CHECK_LIVE_FRAME (frame);
35027d0c 4044 CHECK_FONT_SPEC (font_spec);
c2f5bfd6
KH		 4045 if (! NILP (num))
4046 {
4047 CHECK_NUMBER (num);
4048 n = XINT (num);
4049 if (n <= 0)
4050 return Qnil;
4051 }
4052 if (! NILP (prefer))
35027d0c 4053 CHECK_FONT_SPEC (prefer);
c2f5bfd6
KH		 4054
4055 vec = font_list_entities (frame, font_spec);
4056 len = ASIZE (vec);
4057 if (len == 0)
4058 return Qnil;
4059 if (len == 1)
4060 return Fcons (AREF (vec, 0), Qnil);
4061
4062 if (! NILP (prefer))
7181ea6a 4063 vec = font_sort_entites (vec, prefer, frame, 0);
c2f5bfd6
KH		 4064
4065 list = tail = Fcons (AREF (vec, 0), Qnil);
4066 if (n == 0 || n > len)
4067 n = len;
4068 for (i = 1; i < n; i++)
4069 {
4070 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
4071
4072 XSETCDR (tail, val);
4073 tail = val;
4074 }
4075 return list;
4076}
4077
35027d0c 4078DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
c2f5bfd6 4079 doc: /* List available font families on the current frame.
027a33c0 4080Optional argument FRAME, if non-nil, specifies the target frame. */)
c2f5bfd6
KH		 4081 (frame)
4082 Lisp_Object frame;
4083{
4084 FRAME_PTR f;
4085 struct font_driver_list *driver_list;
4086 Lisp_Object list;
4087
4088 if (NILP (frame))
4089 frame = selected_frame;
4090 CHECK_LIVE_FRAME (frame);
4091 f = XFRAME (frame);
4092 list = Qnil;
4093 for (driver_list = f->font_driver_list; driver_list;
4094 driver_list = driver_list->next)
4095 if (driver_list->driver->list_family)
4096 {
4097 Lisp_Object val = driver_list->driver->list_family (frame);
4098
4099 if (NILP (list))
4100 list = val;
4101 else
4102 {
4103 Lisp_Object tail = list;
4104
4105 for (; CONSP (val); val = XCDR (val))
4106 if (NILP (Fmemq (XCAR (val), tail)))
4107 list = Fcons (XCAR (val), list);
4108 }
4109 }
4110 return list;
4111}
4112
4113DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
4114 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
4115Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4116 (font_spec, frame)
4117 Lisp_Object font_spec, frame;
4118{
4119 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
4120
4121 if (CONSP (val))
4122 val = XCAR (val);
4123 return val;
4124}
4125
d0ab1ebe 4126DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
c2f5bfd6
KH		 4127 doc: /* Return XLFD name of FONT.
4128FONT is a font-spec, font-entity, or font-object.
d0ab1ebe
KH		 4129If the name is too long for XLFD (maximum 255 chars), return nil.
4130If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4131the consecutive wildcards are folded to one. */)
4132 (font, fold_wildcards)
4133 Lisp_Object font, fold_wildcards;
c2f5bfd6
KH		 4134{
4135 char name[256];
4136 int pixel_size = 0;
4137
35027d0c
KH		 4138 CHECK_FONT (font);
4139
4140 if (FONT_OBJECT_P (font))
c2f5bfd6 4141 {
35027d0c 4142 Lisp_Object font_name = AREF (font, FONT_NAME_INDEX);
c2f5bfd6 4143
35027d0c
KH		 4144 if (STRINGP (font_name)
4145 && SDATA (font_name)[0] == '-')
d0ab1ebe
KH		 4146 {
4147 if (NILP (fold_wildcards))
4148 return font_name;
4149 strcpy (name, (char *) SDATA (font_name));
4150 goto done;
4151 }
35027d0c 4152 pixel_size = XFONT_OBJECT (font)->pixel_size;
c2f5bfd6 4153 }
c2f5bfd6
KH		 4154 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
4155 return Qnil;
d0ab1ebe
KH		 4156 done:
4157 if (! NILP (fold_wildcards))
4158 {
4159 char *p0 = name, *p1;
4160
4161 while ((p1 = strstr (p0, "-*-*")))
4162 {
4163 strcpy (p1, p1 + 2);
4164 p0 = p1;
4165 }
4166 }
4167
c2f5bfd6
KH		 4168 return build_string (name);
4169}
4170
4171DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
4172 doc: /* Clear font cache. */)
4173 ()
4174{
4175 Lisp_Object list, frame;
4176
4177 FOR_EACH_FRAME (list, frame)
4178 {
4179 FRAME_PTR f = XFRAME (frame);
4180 struct font_driver_list *driver_list = f->font_driver_list;
4181
4182 for (; driver_list; driver_list = driver_list->next)
417a1b10
KH		 4183 if (driver_list->on)
4184 {
ca4da08a
KH		 4185 Lisp_Object cache = driver_list->driver->get_cache (f);
4186 Lisp_Object val;
51c01100 4187
ca4da08a 4188 val = XCDR (cache);
43c0454d
KH		 4189 while (! NILP (val)
4190 && ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
ca4da08a 4191 val = XCDR (val);
d0ab1ebe 4192 font_assert (! NILP (val));
ca4da08a
KH		 4193 val = XCDR (XCAR (val));
4194 if (XINT (XCAR (val)) == 0)
417a1b10 4195 {
ca4da08a
KH		 4196 font_clear_cache (f, XCAR (val), driver_list->driver);
4197 XSETCDR (cache, XCDR (val));
417a1b10 4198 }
417a1b10 4199 }
c2f5bfd6
KH		 4200 }
4201
4202 return Qnil;
4203}
4204
071132a9
KH		 4205\f
4206void
4207font_fill_lglyph_metrics (glyph, font_object)
4208 Lisp_Object glyph, font_object;
c2f5bfd6 4209{
071132a9 4210 struct font *font = XFONT_OBJECT (font_object);
f62ab7c5
EZ		 4211 unsigned code;
4212 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4213 EMACS_INT ecode = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
071132a9 4214 struct font_metrics metrics;
c2f5bfd6 4215
f62ab7c5
EZ		 4216 LGLYPH_SET_CODE (glyph, ecode);
4217 code = ecode;
071132a9
KH		 4218 font->driver->text_extents (font, &code, 1, &metrics);
4219 LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
4220 LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
4221 LGLYPH_SET_WIDTH (glyph, metrics.width);
4222 LGLYPH_SET_ASCENT (glyph, metrics.ascent);
4223 LGLYPH_SET_DESCENT (glyph, metrics.descent);
c2f5bfd6
KH		 4224}
4225
c2f5bfd6 4226
071132a9
KH		 4227DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0,
4228 doc: /* Shape the glyph-string GSTRING.
4229Shaping means substituting glyphs and/or adjusting positions of glyphs
4230to get the correct visual image of character sequences set in the
4231header of the glyph-string.
1701724c 4232
071132a9
KH		 4233If the shaping was successful, the value is GSTRING itself or a newly
4234created glyph-string. Otherwise, the value is nil. */)
4235 (gstring)
4236 Lisp_Object gstring;
1701724c
KH		 4237{
4238 struct font *font;
071132a9 4239 Lisp_Object font_object, n, glyph;
fc3a285e 4240 int i, j, from, to;
071132a9
KH		 4241
4242 if (! composition_gstring_p (gstring))
4243 signal_error ("Invalid glyph-string: ", gstring);
4244 if (! NILP (LGSTRING_ID (gstring)))
4245 return gstring;
4246 font_object = LGSTRING_FONT (gstring);
4247 CHECK_FONT_OBJECT (font_object);
35027d0c 4248 font = XFONT_OBJECT (font_object);
b876ea91
KH		 4249 if (! font->driver->shape)
4250 return Qnil;
4251
40fb53d6
KH		 4252 /* Try at most three times with larger gstring each time. */
4253 for (i = 0; i < 3; i++)
4254 {
40fb53d6
KH		 4255 n = font->driver->shape (gstring);
4256 if (INTEGERP (n))
4257 break;
071132a9
KH		 4258 gstring = larger_vector (gstring,
4259 ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
4260 Qnil);
40fb53d6 4261 }
071132a9 4262 if (i == 3 || XINT (n) == 0)
1701724c 4263 return Qnil;
071132a9
KH		 4264
4265 glyph = LGSTRING_GLYPH (gstring, 0);
fc3a285e
KH		 4266 from = LGLYPH_FROM (glyph);
4267 to = LGLYPH_TO (glyph);
4268 for (i = 1, j = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
071132a9
KH		 4269 {
4270 Lisp_Object this = LGSTRING_GLYPH (gstring, i);
10d16101 4271
071132a9
KH		 4272 if (NILP (this))
4273 break;
4274 if (NILP (LGLYPH_ADJUSTMENT (this)))
fc3a285e
KH		 4275 {
4276 if (j < i - 1)
4277 for (; j < i; j++)
4278 {
4279 glyph = LGSTRING_GLYPH (gstring, j);
4280 LGLYPH_SET_FROM (glyph, from);
4281 LGLYPH_SET_TO (glyph, to);
4282 }
4283 from = LGLYPH_FROM (this);
4284 to = LGLYPH_TO (this);
4285 j = i;
4286 }
071132a9 4287 else
b2937119 4288 {
fc3a285e
KH		 4289 if (from > LGLYPH_FROM (this))
4290 from = LGLYPH_FROM (this);
4291 if (to < LGLYPH_TO (this))
4292 to = LGLYPH_TO (this);
b2937119 4293 }
10d16101 4294 }
fc3a285e
KH		 4295 if (j < i - 1)
4296 for (; j < i; j++)
4297 {
4298 glyph = LGSTRING_GLYPH (gstring, j);
4299 LGLYPH_SET_FROM (glyph, from);
4300 LGLYPH_SET_TO (glyph, to);
4301 }
071132a9 4302 return composition_gstring_put_cache (gstring, XINT (n));
c2f5bfd6
KH		 4303}
4304
6a3dadd2
KH		 4305#if 0
4306
733fd013
KH		 4307DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
4308 doc: /* Apply OpenType features on glyph-string GSTRING-IN.
51c01100 4309OTF-FEATURES specifies which features to apply in this format:
733fd013 4310 (SCRIPT LANGSYS GSUB GPOS)
e80e09b4
KH		 4311where
4312 SCRIPT is a symbol specifying a script tag of OpenType,
4313 LANGSYS is a symbol specifying a langsys tag of OpenType,
733fd013 4314 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
e80e09b4
KH		 4315
4316If LANGYS is nil, the default langsys is selected.
4317
51c01100
JB		 4318The features are applied in the order they appear in the list. The
4319symbol `*' means to apply all available features not present in this
733fd013
KH		 4320list, and the remaining features are ignored. For instance, (vatu
4321pstf * haln) is to apply vatu and pstf in this order, then to apply
4322all available features other than vatu, pstf, and haln.
e80e09b4
KH		 4323
4324The features are applied to the glyphs in the range FROM and TO of
733fd013 4325the glyph-string GSTRING-IN.
e80e09b4 4326
51c01100 4327If some feature is actually applicable, the resulting glyphs are
e80e09b4
KH		 4328produced in the glyph-string GSTRING-OUT from the index INDEX. In
4329this case, the value is the number of produced glyphs.
4330
4331If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4332the value is 0.
4333
51c01100 4334If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
e80e09b4
KH		 4335produced in GSTRING-OUT, and the value is nil.
4336
4337See the documentation of `font-make-gstring' for the format of
4338glyph-string. */)
733fd013
KH		 4339 (otf_features, gstring_in, from, to, gstring_out, index)
4340 Lisp_Object otf_features, gstring_in, from, to, gstring_out, index;
e80e09b4
KH		 4341{
4342 Lisp_Object font_object = LGSTRING_FONT (gstring_in);
733fd013
KH		 4343 Lisp_Object val;
4344 struct font *font;
e80e09b4
KH		 4345 int len, num;
4346
733fd013 4347 check_otf_features (otf_features);
35027d0c
KH		 4348 CHECK_FONT_OBJECT (font_object);
4349 font = XFONT_OBJECT (font_object);
733fd013 4350 if (! font->driver->otf_drive)
e80e09b4
KH		 4351 error ("Font backend %s can't drive OpenType GSUB table",
4352 SDATA (SYMBOL_NAME (font->driver->type)));
733fd013
KH		 4353 CHECK_CONS (otf_features);
4354 CHECK_SYMBOL (XCAR (otf_features));
4355 val = XCDR (otf_features);
4356 CHECK_SYMBOL (XCAR (val));
4357 val = XCDR (otf_features);
4358 if (! NILP (val))
4359 CHECK_CONS (val);
e80e09b4
KH		 4360 len = check_gstring (gstring_in);
4361 CHECK_VECTOR (gstring_out);
4362 CHECK_NATNUM (from);
4363 CHECK_NATNUM (to);
4364 CHECK_NATNUM (index);
4365
4366 if (XINT (from) >= XINT (to) || XINT (to) > len)
4367 args_out_of_range_3 (from, to, make_number (len));
4368 if (XINT (index) >= ASIZE (gstring_out))
4369 args_out_of_range (index, make_number (ASIZE (gstring_out)));
733fd013
KH		 4370 num = font->driver->otf_drive (font, otf_features,
4371 gstring_in, XINT (from), XINT (to),
4372 gstring_out, XINT (index), 0);
e80e09b4
KH		 4373 if (num < 0)
4374 return Qnil;
4375 return make_number (num);
4376}
4377
e80e09b4
KH		 4378DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
4379 3, 3, 0,
4380 doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
51c01100 4381OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
e80e09b4
KH		 4382in this format:
4383 (SCRIPT LANGSYS FEATURE ...)
027a33c0 4384See the documentation of `font-drive-otf' for more detail.
e80e09b4
KH		 4385
4386The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4387where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4388character code corresponding to the glyph or nil if there's no
4389corresponding character. */)
733fd013
KH		 4390 (font_object, character, otf_features)
4391 Lisp_Object font_object, character, otf_features;
e80e09b4
KH		 4392{
4393 struct font *font;
4394 Lisp_Object gstring_in, gstring_out, g;
4395 Lisp_Object alternates;
4396 int i, num;
4397
4398 CHECK_FONT_GET_OBJECT (font_object, font);
733fd013 4399 if (! font->driver->otf_drive)
e950d6f1
KH		 4400 error ("Font backend %s can't drive OpenType GSUB table",
4401 SDATA (SYMBOL_NAME (font->driver->type)));
e80e09b4 4402 CHECK_CHARACTER (character);
733fd013 4403 CHECK_CONS (otf_features);
e80e09b4
KH		 4404
4405 gstring_in = Ffont_make_gstring (font_object, make_number (1));
4406 g = LGSTRING_GLYPH (gstring_in, 0);
f9ffa1ea 4407 LGLYPH_SET_CHAR (g, XINT (character));
e80e09b4 4408 gstring_out = Ffont_make_gstring (font_object, make_number (10));
733fd013
KH		 4409 while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
4410 gstring_out, 0, 1)) < 0)
e80e09b4
KH		 4411 gstring_out = Ffont_make_gstring (font_object,
4412 make_number (ASIZE (gstring_out) * 2));
4413 alternates = Qnil;
4414 for (i = 0; i < num; i++)
4415 {
4416 Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
f9ffa1ea
SM		 4417 int c = LGLYPH_CHAR (g);
4418 unsigned code = LGLYPH_CODE (g);
e80e09b4
KH		 4419
4420 alternates = Fcons (Fcons (make_number (code),
4421 c > 0 ? make_number (c) : Qnil),
4422 alternates);
4423 }
4424 return Fnreverse (alternates);
4425}
6a3dadd2 4426#endif /* 0 */
c2f5bfd6
KH		 4427
4428#ifdef FONT_DEBUG
4429
4430DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
4431 doc: /* Open FONT-ENTITY. */)
4432 (font_entity, size, frame)
4433 Lisp_Object font_entity;
4434 Lisp_Object size;
4435 Lisp_Object frame;
4436{
4437 int isize;
4438
4439 CHECK_FONT_ENTITY (font_entity);
c2f5bfd6
KH		 4440 if (NILP (frame))
4441 frame = selected_frame;
4442 CHECK_LIVE_FRAME (frame);
51c01100 4443
35027d0c
KH		 4444 if (NILP (size))
4445 isize = XINT (AREF (font_entity, FONT_SIZE_INDEX));
4446 else
4447 {
4448 CHECK_NUMBER_OR_FLOAT (size);
4449 if (FLOATP (size))
4450 isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
4451 else
4452 isize = XINT (size);
4453 if (isize == 0)
4454 isize = 120;
4455 }
c2f5bfd6
KH		 4456 return font_open_entity (XFRAME (frame), font_entity, isize);
4457}
4458
4459DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
4460 doc: /* Close FONT-OBJECT. */)
4461 (font_object, frame)
4462 Lisp_Object font_object, frame;
4463{
4464 CHECK_FONT_OBJECT (font_object);
4465 if (NILP (frame))
4466 frame = selected_frame;
4467 CHECK_LIVE_FRAME (frame);
4468 font_close_object (XFRAME (frame), font_object);
4469 return Qnil;
4470}
4471
4472DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
e80e09b4
KH		 4473 doc: /* Return information about FONT-OBJECT.
4474The value is a vector:
4475 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
e0708580 4476 CAPABILITY ]
e80e09b4
KH		 4477
4478NAME is a string of the font name (or nil if the font backend doesn't
4479provide a name).
4480
4481FILENAME is a string of the font file (or nil if the font backend
4482doesn't provide a file name).
4483
4484PIXEL-SIZE is a pixel size by which the font is opened.
4485
027a33c0 4486SIZE is a maximum advance width of the font in pixels.
e80e09b4
KH		 4487
4488ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
027a33c0 4489pixels.
e80e09b4 4490
e0708580
KH		 4491CAPABILITY is a list whose first element is a symbol representing the
4492font format \(x, opentype, truetype, type1, pcf, or bdf) and the
027a33c0 4493remaining elements describe the details of the font capability.
e0708580
KH		 4494
4495If the font is OpenType font, the form of the list is
4496 \(opentype GSUB GPOS)
4497where GSUB shows which "GSUB" features the font supports, and GPOS
4498shows which "GPOS" features the font supports. Both GSUB and GPOS are
4499lists of the format:
4500 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4501
4502If the font is not OpenType font, currently the length of the form is
4503one.
e80e09b4
KH		 4504
4505SCRIPT is a symbol representing OpenType script tag.
4506
4507LANGSYS is a symbol representing OpenType langsys tag, or nil
4508representing the default langsys.
4509
51c01100 4510FEATURE is a symbol representing OpenType feature tag.
e80e09b4 4511
51c01100 4512If the font is not OpenType font, CAPABILITY is nil. */)
c2f5bfd6
KH		 4513 (font_object)
4514 Lisp_Object font_object;
4515{
4516 struct font *font;
4517 Lisp_Object val;
4518
4519 CHECK_FONT_GET_OBJECT (font_object, font);
4520
4521 val = Fmake_vector (make_number (9), Qnil);
35027d0c
KH		 4522 ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
4523 ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
c2f5bfd6 4524 ASET (val, 2, make_number (font->pixel_size));
35027d0c 4525 ASET (val, 3, make_number (font->max_width));
c2f5bfd6
KH		 4526 ASET (val, 4, make_number (font->ascent));
4527 ASET (val, 5, make_number (font->descent));
35027d0c
KH		 4528 ASET (val, 6, make_number (font->space_width));
4529 ASET (val, 7, make_number (font->average_width));
c2f5bfd6 4530 if (font->driver->otf_capability)
e0708580 4531 ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
c2f5bfd6
KH		 4532 return val;
4533}
4534
4535DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
4536 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4537Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4538 (font_object, string)
4539 Lisp_Object font_object, string;
4540{
4541 struct font *font;
4542 int i, len;
4543 Lisp_Object vec;
4544
4545 CHECK_FONT_GET_OBJECT (font_object, font);
4546 CHECK_STRING (string);
4547 len = SCHARS (string);
4548 vec = Fmake_vector (make_number (len), Qnil);
4549 for (i = 0; i < len; i++)
4550 {
4551 Lisp_Object ch = Faref (string, make_number (i));
4552 Lisp_Object val;
4553 int c = XINT (ch);
4554 unsigned code;
2930d117 4555 EMACS_INT cod;
c2f5bfd6
KH		 4556 struct font_metrics metrics;
4557
2930d117 4558 cod = code = font->driver->encode_char (font, c);
c2f5bfd6
KH		 4559 if (code == FONT_INVALID_CODE)
4560 continue;
4561 val = Fmake_vector (make_number (6), Qnil);
2930d117 4562 if (cod <= MOST_POSITIVE_FIXNUM)
c2f5bfd6
KH		 4563 ASET (val, 0, make_number (code));
4564 else
4565 ASET (val, 0, Fcons (make_number (code >> 16),
4566 make_number (code & 0xFFFF)));
51c01100 4567 font->driver->text_extents (font, &code, 1, &metrics);
c2f5bfd6
KH		 4568 ASET (val, 1, make_number (metrics.lbearing));
4569 ASET (val, 2, make_number (metrics.rbearing));
4570 ASET (val, 3, make_number (metrics.width));
4571 ASET (val, 4, make_number (metrics.ascent));
4572 ASET (val, 5, make_number (metrics.descent));
4573 ASET (vec, i, val);
4574 }
4575 return vec;
4576}
4577
ec6fe57c 4578DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
67b5d7de 4579 doc: /* Return t if and only if font-spec SPEC matches with FONT.
ec6fe57c
KH		 4580FONT is a font-spec, font-entity, or font-object. */)
4581 (spec, font)
4582 Lisp_Object spec, font;
4583{
4584 CHECK_FONT_SPEC (spec);
35027d0c 4585 CHECK_FONT (font);
ec6fe57c
KH		 4586
4587 return (font_match_p (spec, font) ? Qt : Qnil);
4588}
4589
1701724c 4590DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
51c01100 4591 doc: /* Return a font-object for displaying a character at POSITION.
10d16101
KH		 4592Optional second arg WINDOW, if non-nil, is a window displaying
4593the current buffer. It defaults to the currently selected window. */)
1701724c
KH		 4594 (position, window, string)
4595 Lisp_Object position, window, string;
10d16101
KH		 4596{
4597 struct window *w;
e3ee0340 4598 EMACS_INT pos;
10d16101 4599
1701724c
KH		 4600 if (NILP (string))
4601 {
4602 CHECK_NUMBER_COERCE_MARKER (position);
4603 pos = XINT (position);
4604 if (pos < BEGV || pos >= ZV)
4605 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1701724c
KH		 4606 }
4607 else
4608 {
1701724c
KH		 4609 CHECK_NUMBER (position);
4610 CHECK_STRING (string);
4611 pos = XINT (position);
4612 if (pos < 0 || pos >= SCHARS (string))
4613 args_out_of_range (string, position);
1701724c 4614 }
10d16101
KH		 4615 if (NILP (window))
4616 window = selected_window;
4617 CHECK_LIVE_WINDOW (window);
40fb53d6 4618 w = XWINDOW (window);
10d16101 4619
40fb53d6 4620 return font_at (-1, pos, NULL, w, string);
10d16101
KH		 4621}
4622
c2f5bfd6
KH		 4623#if 0
4624DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
4625 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4626The value is a number of glyphs drawn.
4627Type C-l to recover what previously shown. */)
4628 (font_object, string)
4629 Lisp_Object font_object, string;
4630{
4631 Lisp_Object frame = selected_frame;
4632 FRAME_PTR f = XFRAME (frame);
4633 struct font *font;
4634 struct face *face;
4635 int i, len, width;
4636 unsigned *code;
4637
4638 CHECK_FONT_GET_OBJECT (font_object, font);
4639 CHECK_STRING (string);
4640 len = SCHARS (string);
4641 code = alloca (sizeof (unsigned) * len);
4642 for (i = 0; i < len; i++)
4643 {
4644 Lisp_Object ch = Faref (string, make_number (i));
4645 Lisp_Object val;
4646 int c = XINT (ch);
4647
4648 code[i] = font->driver->encode_char (font, c);
4649 if (code[i] == FONT_INVALID_CODE)
4650 break;
4651 }
4652 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4653 face->fontp = font;
4654 if (font->driver->prepare_face)
4655 font->driver->prepare_face (f, face);
4656 width = font->driver->text_extents (font, code, i, NULL);
4657 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
4658 if (font->driver->done_face)
4659 font->driver->done_face (f, face);
4660 face->fontp = NULL;
4661 return make_number (len);
4662}
4663#endif
4664
4665#endif /* FONT_DEBUG */
4666
a266686a
KH		 4667#ifdef HAVE_WINDOW_SYSTEM
4668
72606e45
KH		 4669DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
4670 doc: /* Return information about a font named NAME on frame FRAME.
4671If FRAME is omitted or nil, use the selected frame.
4672The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4673 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4674where
4675 OPENED-NAME is the name used for opening the font,
4676 FULL-NAME is the full name of the font,
4677 SIZE is the maximum bound width of the font,
4678 HEIGHT is the height of the font,
4679 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4680 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4681 how to compose characters.
4682If the named font is not yet loaded, return nil. */)
4683 (name, frame)
4684 Lisp_Object name, frame;
4685{
4686 FRAME_PTR f;
4687 struct font *font;
4688 Lisp_Object info;
4689 Lisp_Object font_object;
4690
4691 (*check_window_system_func) ();
4692
4693 if (! FONTP (name))
4694 CHECK_STRING (name);
4695 if (NILP (frame))
4696 frame = selected_frame;
4697 CHECK_LIVE_FRAME (frame);
4698 f = XFRAME (frame);
4699
4700 if (STRINGP (name))
4701 {
4702 int fontset = fs_query_fontset (name, 0);
4703
4704 if (fontset >= 0)
4705 name = fontset_ascii (fontset);
4706 font_object = font_open_by_name (f, (char *) SDATA (name));
4707 }
4708 else if (FONT_OBJECT_P (name))
4709 font_object = name;
4710 else if (FONT_ENTITY_P (name))
4711 font_object = font_open_entity (f, name, 0);
4712 else
4713 {
4714 struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4715 Lisp_Object entity = font_matching_entity (f, face->lface, name);
4716
4717 font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
4718 }
4719 if (NILP (font_object))
4720 return Qnil;
4721 font = XFONT_OBJECT (font_object);
4722
4723 info = Fmake_vector (make_number (7), Qnil);
4724 XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
4725 XVECTOR (info)->contents[1] = AREF (font_object, FONT_NAME_INDEX);
4726 XVECTOR (info)->contents[2] = make_number (font->pixel_size);
4727 XVECTOR (info)->contents[3] = make_number (font->height);
4728 XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
4729 XVECTOR (info)->contents[5] = make_number (font->relative_compose);
4730 XVECTOR (info)->contents[6] = make_number (font->default_ascent);
4731
4732#if 0
4733 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4734 close it now. Perhaps, we should manage font-objects
4735 by `reference-count'. */
4736 font_close_object (f, font_object);
4737#endif
4738 return info;
4739}
a266686a 4740#endif
72606e45 4741
c2f5bfd6 4742\f
d0ab1ebe
KH		 4743#define BUILD_STYLE_TABLE(TBL) \
4744 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4745
4746static Lisp_Object
4747build_style_table (entry, nelement)
4748 struct table_entry *entry;
4749 int nelement;
4750{
4751 int i, j;
4752 Lisp_Object table, elt;
17ab8f5d 4753
d0ab1ebe
KH		 4754 table = Fmake_vector (make_number (nelement), Qnil);
4755 for (i = 0; i < nelement; i++)
4756 {
4757 for (j = 0; entry[i].names[j]; j++);
4758 elt = Fmake_vector (make_number (j + 1), Qnil);
4759 ASET (elt, 0, make_number (entry[i].numeric));
4760 for (j = 0; entry[i].names[j]; j++)
17ab8f5d 4761 ASET (elt, j + 1, intern (entry[i].names[j]));
d0ab1ebe
KH		 4762 ASET (table, i, elt);
4763 }
4764 return table;
4765}
4766
4767static Lisp_Object Vfont_log;
4768static int font_log_env_checked;
4769
d0818984
KH		 4770/* The deferred font-log data of the form [ACTION ARG RESULT].
4771 If ACTION is not nil, that is added to the log when font_add_log is
4772 called next time. At that time, ACTION is set back to nil. */
4773static Lisp_Object Vfont_log_deferred;
4774
4775/* Prepend the font-related logging data in Vfont_log if it is not
4776 `t'. ACTION describes a kind of font-related action (e.g. listing,
4777 opening), ARG is the argument for the action, and RESULT is the
4778 result of the action. */
d0ab1ebe
KH		 4779void
4780font_add_log (action, arg, result)
4781 char *action;
4782 Lisp_Object arg, result;
4783{
4784 Lisp_Object tail, val;
4785 int i;
4786
4787 if (! font_log_env_checked)
4788 {
4789 Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
4790 font_log_env_checked = 1;
4791 }
4792 if (EQ (Vfont_log, Qt))
4793 return;
d0818984
KH		 4794 if (STRINGP (AREF (Vfont_log_deferred, 0)))
4795 {
071132a9 4796 char *str = (char *) SDATA (AREF (Vfont_log_deferred, 0));
d0818984
KH		 4797
4798 ASET (Vfont_log_deferred, 0, Qnil);
4799 font_add_log (str, AREF (Vfont_log_deferred, 1),
4800 AREF (Vfont_log_deferred, 2));
4801 }
4802
d0ab1ebe 4803 if (FONTP (arg))
db716644
KH		 4804 {
4805 Lisp_Object tail, elt;
4806 Lisp_Object equalstr = build_string ("=");
4807
4808 val = Ffont_xlfd_name (arg, Qt);
4809 for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
4810 tail = XCDR (tail))
4811 {
4812 elt = XCAR (tail);
49f9c344
KH		 4813 if (EQ (XCAR (elt), QCscript)
4814 && SYMBOLP (XCDR (elt)))
db716644
KH		 4815 val = concat3 (val, SYMBOL_NAME (QCscript),
4816 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
49f9c344
KH		 4817 else if (EQ (XCAR (elt), QClang)
4818 && SYMBOLP (XCDR (elt)))
db716644
KH		 4819 val = concat3 (val, SYMBOL_NAME (QClang),
4820 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
49f9c344
KH		 4821 else if (EQ (XCAR (elt), QCotf)
4822 && CONSP (XCDR (elt)) && SYMBOLP (XCAR (XCDR (elt))))
db716644
KH		 4823 val = concat3 (val, SYMBOL_NAME (QCotf),
4824 concat2 (equalstr,
4825 SYMBOL_NAME (XCAR (XCDR (elt)))));
4826 }
4827 arg = val;
4828 }
d0ab1ebe 4829 if (FONTP (result))
d26424c5
KH		 4830 {
4831 val = Ffont_xlfd_name (result, Qt);
4832 if (! FONT_SPEC_P (result))
4833 val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
4834 build_string (":"), val);
4835 result = val;
4836 }
d0ab1ebe
KH		 4837 else if (CONSP (result))
4838 {
4839 result = Fcopy_sequence (result);
4840 for (tail = result; CONSP (tail); tail = XCDR (tail))
4841 {
4842 val = XCAR (tail);
4843 if (FONTP (val))
4844 val = Ffont_xlfd_name (val, Qt);
4845 XSETCAR (tail, val);
4846 }
4847 }
4848 else if (VECTORP (result))
4849 {
4850 result = Fcopy_sequence (result);
4851 for (i = 0; i < ASIZE (result); i++)
4852 {
4853 val = AREF (result, i);
4854 if (FONTP (val))
4855 val = Ffont_xlfd_name (val, Qt);
4856 ASET (result, i, val);
4857 }
4858 }
4859 Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
4860}
4861
d0818984
KH		 4862/* Record a font-related logging data to be added to Vfont_log when
4863 font_add_log is called next time. ACTION, ARG, RESULT are the same
4864 as font_add_log. */
4865
4866void
4867font_deferred_log (action, arg, result)
4868 char *action;
4869 Lisp_Object arg, result;
4870{
4871 ASET (Vfont_log_deferred, 0, build_string (action));
4872 ASET (Vfont_log_deferred, 1, arg);
4873 ASET (Vfont_log_deferred, 2, result);
4874}
4875
c2f5bfd6
KH		 4876extern void syms_of_ftfont P_ (());
4877extern void syms_of_xfont P_ (());
4878extern void syms_of_xftfont P_ (());
4879extern void syms_of_ftxfont P_ (());
4880extern void syms_of_bdffont P_ (());
4881extern void syms_of_w32font P_ (());
4882extern void syms_of_atmfont P_ (());
edfda783 4883extern void syms_of_nsfont P_ (());
c2f5bfd6
KH		 4884
4885void
4886syms_of_font ()
4887{
4007dd1c
KH		 4888 sort_shift_bits[FONT_TYPE_INDEX] = 0;
4889 sort_shift_bits[FONT_SLANT_INDEX] = 2;
4890 sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
4891 sort_shift_bits[FONT_SIZE_INDEX] = 16;
4892 sort_shift_bits[FONT_WIDTH_INDEX] = 23;
4893 /* Note that the other elements in sort_shift_bits are not used. */
c2f5bfd6 4894
1701724c
KH		 4895 staticpro (&font_charset_alist);
4896 font_charset_alist = Qnil;
4897
35027d0c
KH		 4898 DEFSYM (Qfont_spec, "font-spec");
4899 DEFSYM (Qfont_entity, "font-entity");
4900 DEFSYM (Qfont_object, "font-object");
4901
e0708580 4902 DEFSYM (Qopentype, "opentype");
c2f5bfd6 4903
9e1bb909 4904 DEFSYM (Qascii_0, "ascii-0");
1bb1d99b
KH		 4905 DEFSYM (Qiso8859_1, "iso8859-1");
4906 DEFSYM (Qiso10646_1, "iso10646-1");
4907 DEFSYM (Qunicode_bmp, "unicode-bmp");
cf96c5c2 4908 DEFSYM (Qunicode_sip, "unicode-sip");
1bb1d99b 4909
071132a9
KH		 4910 DEFSYM (QCf, "Cf");
4911
c2f5bfd6 4912 DEFSYM (QCotf, ":otf");
35027d0c 4913 DEFSYM (QClang, ":lang");
c2f5bfd6 4914 DEFSYM (QCscript, ":script");
4c496d0d 4915 DEFSYM (QCantialias, ":antialias");
c2f5bfd6
KH		 4916
4917 DEFSYM (QCfoundry, ":foundry");
4918 DEFSYM (QCadstyle, ":adstyle");
4919 DEFSYM (QCregistry, ":registry");
9331887d
KH		 4920 DEFSYM (QCspacing, ":spacing");
4921 DEFSYM (QCdpi, ":dpi");
ec6fe57c 4922 DEFSYM (QCscalable, ":scalable");
35027d0c
KH		 4923 DEFSYM (QCavgwidth, ":avgwidth");
4924 DEFSYM (QCfont_entity, ":font-entity");
4925 DEFSYM (QCfc_unknown_spec, ":fc-unknown-spec");
c2f5bfd6 4926
ec6fe57c
KH		 4927 DEFSYM (Qc, "c");
4928 DEFSYM (Qm, "m");
4929 DEFSYM (Qp, "p");
4930 DEFSYM (Qd, "d");
4931
c2f5bfd6
KH		 4932 staticpro (&null_vector);
4933 null_vector = Fmake_vector (make_number (0), Qnil);
4934
4935 staticpro (&scratch_font_spec);
4936 scratch_font_spec = Ffont_spec (0, NULL);
4937 staticpro (&scratch_font_prefer);
4938 scratch_font_prefer = Ffont_spec (0, NULL);
4939
d0818984
KH		 4940 staticpro (&Vfont_log_deferred);
4941 Vfont_log_deferred = Fmake_vector (make_number (3), Qnil);
4942
6a3dadd2 4943#if 0
733fd013
KH		 4944#ifdef HAVE_LIBOTF
4945 staticpro (&otf_list);
4946 otf_list = Qnil;
6a3dadd2
KH		 4947#endif /* HAVE_LIBOTF */
4948#endif /* 0 */
733fd013 4949
c2f5bfd6
KH		 4950 defsubr (&Sfontp);
4951 defsubr (&Sfont_spec);
4952 defsubr (&Sfont_get);
51cf11be 4953#ifdef HAVE_WINDOW_SYSTEM
b1868a1a 4954 defsubr (&Sfont_face_attributes);
51cf11be 4955#endif
c2f5bfd6
KH		 4956 defsubr (&Sfont_put);
4957 defsubr (&Slist_fonts);
35027d0c 4958 defsubr (&Sfont_family_list);
c2f5bfd6
KH		 4959 defsubr (&Sfind_font);
4960 defsubr (&Sfont_xlfd_name);
4961 defsubr (&Sclear_font_cache);
071132a9 4962 defsubr (&Sfont_shape_gstring);
6a3dadd2 4963#if 0
733fd013 4964 defsubr (&Sfont_drive_otf);
e80e09b4 4965 defsubr (&Sfont_otf_alternates);
6a3dadd2 4966#endif /* 0 */
c2f5bfd6
KH		 4967
4968#ifdef FONT_DEBUG
4969 defsubr (&Sopen_font);
4970 defsubr (&Sclose_font);
4971 defsubr (&Squery_font);
4972 defsubr (&Sget_font_glyphs);
ec6fe57c 4973 defsubr (&Sfont_match_p);
10d16101 4974 defsubr (&Sfont_at);
c2f5bfd6
KH		 4975#if 0
4976 defsubr (&Sdraw_string);
4977#endif
4978#endif /* FONT_DEBUG */
a266686a 4979#ifdef HAVE_WINDOW_SYSTEM
72606e45 4980 defsubr (&Sfont_info);
a266686a 4981#endif
c2f5bfd6 4982
819e81df
KH		 4983 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
4984 doc: /*
4985Alist of fontname patterns vs the corresponding encoding and repertory info.
4986Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4987where ENCODING is a charset or a char-table,
4988and REPERTORY is a charset, a char-table, or nil.
4989
027a33c0 4990If ENCODING and REPERTORY are the same, the element can have the form
819e81df
KH		 4991\(REGEXP . ENCODING).
4992
4993ENCODING is for converting a character to a glyph code of the font.
4994If ENCODING is a charset, encoding a character by the charset gives
4995the corresponding glyph code. If ENCODING is a char-table, looking up
4996the table by a character gives the corresponding glyph code.
4997
4998REPERTORY specifies a repertory of characters supported by the font.
4999If REPERTORY is a charset, all characters beloging to the charset are
5000supported. If REPERTORY is a char-table, all characters who have a
027a33c0 5001non-nil value in the table are supported. If REPERTORY is nil, Emacs
819e81df
KH		 5002gets the repertory information by an opened font and ENCODING. */);
5003 Vfont_encoding_alist = Qnil;
5004
d0ab1ebe
KH		 5005 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table,
5006 doc: /* Vector of valid font weight values.
5007Each element has the form:
5008 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
17ab8f5d 5009NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
d0ab1ebe
KH		 5010 Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
5011
5012 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table,
5013 doc: /* Vector of font slant symbols vs the corresponding numeric values.
17ab8f5d 5014See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5015 Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
5016
5017 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table,
5018 doc: /* Alist of font width symbols vs the corresponding numeric values.
17ab8f5d 5019See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5020 Vfont_width_table = BUILD_STYLE_TABLE (width_table);
5021
5022 staticpro (&font_style_table);
5023 font_style_table = Fmake_vector (make_number (3), Qnil);
5024 ASET (font_style_table, 0, Vfont_weight_table);
5025 ASET (font_style_table, 1, Vfont_slant_table);
5026 ASET (font_style_table, 2, Vfont_width_table);
5027
5028 DEFVAR_LISP ("font-log", &Vfont_log, doc: /*
5029*Logging list of font related actions and results.
5030The value t means to suppress the logging.
5031The initial value is set to nil if the environment variable
5032EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5033 Vfont_log = Qnil;
5034
819e81df 5035#ifdef HAVE_WINDOW_SYSTEM
c2f5bfd6 5036#ifdef HAVE_FREETYPE
35027d0c 5037 syms_of_ftfont ();
c2f5bfd6 5038#ifdef HAVE_X_WINDOWS
35027d0c
KH		 5039 syms_of_xfont ();
5040 syms_of_ftxfont ();
c2f5bfd6 5041#ifdef HAVE_XFT
35027d0c 5042 syms_of_xftfont ();
c2f5bfd6
KH		 5043#endif /* HAVE_XFT */
5044#endif /* HAVE_X_WINDOWS */
5045#else /* not HAVE_FREETYPE */
5046#ifdef HAVE_X_WINDOWS
35027d0c 5047 syms_of_xfont ();
c2f5bfd6
KH		 5048#endif /* HAVE_X_WINDOWS */
5049#endif /* not HAVE_FREETYPE */
5050#ifdef HAVE_BDFFONT
35027d0c 5051 syms_of_bdffont ();
c2f5bfd6
KH		 5052#endif /* HAVE_BDFFONT */
5053#ifdef WINDOWSNT
35027d0c 5054 syms_of_w32font ();
c2f5bfd6 5055#endif /* WINDOWSNT */
edfda783
AR		 5056#ifdef HAVE_NS
5057 syms_of_nsfont ();
5058#endif /* HAVE_NS */
819e81df 5059#endif /* HAVE_WINDOW_SYSTEM */
c2f5bfd6 5060}
885b7d09
MB		 5061
5062/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5063 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.