HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(register_font_driver): Use xmalloc.
[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);
5bdd4dd2
KH		 2477 if (CONSP (val2))
2478 {
2479 val2 = XCDR (val2);
2480 if (CONSP (val2))
2481 {
2482 /* All characters in the list must be supported. */
2483 for (; CONSP (val2); val2 = XCDR (val2))
2484 {
2485 if (! NATNUMP (XCAR (val2)))
2486 continue;
2487 if (font_encode_char (font, XFASTINT (XCAR (val2)))
2488 == FONT_INVALID_CODE)
2489 return 0;
2490 }
2491 }
2492 else if (VECTORP (val2))
2493 {
2494 /* At most one character in the vector must be supported. */
2495 for (i = 0; i < ASIZE (val2); i++)
2496 {
2497 if (! NATNUMP (AREF (val2, i)))
2498 continue;
2499 if (font_encode_char (font, XFASTINT (AREF (val2, i)))
2500 != FONT_INVALID_CODE)
f5485732 2501 break;
5bdd4dd2
KH		 2502 }
2503 if (i == ASIZE (val2))
2504 return 0;
2505 }
2506 }
51c13510
KH		 2507 }
2508 else if (EQ (key, QCotf))
2509 {
2510 struct font *fontp;
2511
2512 if (! FONT_OBJECT_P (font))
2513 return 0;
2514 fontp = XFONT_OBJECT (font);
2515 if (! fontp->driver->otf_capability)
2516 return 0;
2517 val2 = fontp->driver->otf_capability (fontp);
2518 if (NILP (val2) || ! font_check_otf (val, val2))
2519 return 0;
2520 }
35027d0c
KH		 2521 }
2522
51c13510 2523 return 1;
ef18374f 2524}
ca4da08a 2525\f
819e81df 2526
ca4da08a
KH		 2527/* Font cache
2528
2529 Each font backend has the callback function get_cache, and it
2530 returns a cons cell of which cdr part can be freely used for
2531 caching fonts. The cons cell may be shared by multiple frames
2532 and/or multiple font drivers. So, we arrange the cdr part as this:
2533
2534 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2535
2536 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2537 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2538 cons (FONT-SPEC FONT-ENTITY ...). */
2539
2540static void font_prepare_cache P_ ((FRAME_PTR, struct font_driver *));
2541static void font_finish_cache P_ ((FRAME_PTR, struct font_driver *));
2542static Lisp_Object font_get_cache P_ ((FRAME_PTR, struct font_driver *));
2543static void font_clear_cache P_ ((FRAME_PTR, Lisp_Object,
2544 struct font_driver *));
2545
2546static void
2547font_prepare_cache (f, driver)
2548 FRAME_PTR f;
2549 struct font_driver *driver;
2550{
2551 Lisp_Object cache, val;
2552
2553 cache = driver->get_cache (f);
2554 val = XCDR (cache);
2555 while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
2556 val = XCDR (val);
2557 if (NILP (val))
2558 {
2559 val = Fcons (driver->type, Fcons (make_number (1), Qnil));
2560 XSETCDR (cache, Fcons (val, XCDR (cache)));
2561 }
2562 else
2563 {
2564 val = XCDR (XCAR (val));
2565 XSETCAR (val, make_number (XINT (XCAR (val)) + 1));
2566 }
2567}
2568
43c0454d 2569
ca4da08a
KH		 2570static void
2571font_finish_cache (f, driver)
2572 FRAME_PTR f;
2573 struct font_driver *driver;
2574{
2575 Lisp_Object cache, val, tmp;
2576
2577
2578 cache = driver->get_cache (f);
2579 val = XCDR (cache);
2580 while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
2581 cache = val, val = XCDR (val);
d0ab1ebe 2582 font_assert (! NILP (val));
ca4da08a 2583 tmp = XCDR (XCAR (val));
43c0454d 2584 XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1));
ca4da08a
KH		 2585 if (XINT (XCAR (tmp)) == 0)
2586 {
2587 font_clear_cache (f, XCAR (val), driver);
2588 XSETCDR (cache, XCDR (val));
2589 }
ca4da08a
KH		 2590}
2591
43c0454d 2592
ca4da08a
KH		 2593static Lisp_Object
2594font_get_cache (f, driver)
2595 FRAME_PTR f;
2596 struct font_driver *driver;
2597{
2598 Lisp_Object val = driver->get_cache (f);
2599 Lisp_Object type = driver->type;
2600
d0ab1ebe 2601 font_assert (CONSP (val));
ca4da08a 2602 for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val));
d0ab1ebe 2603 font_assert (CONSP (val));
ca4da08a
KH		 2604 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2605 val = XCDR (XCAR (val));
2606 return val;
2607}
2608
43c0454d
KH		 2609static int num_fonts;
2610
ca4da08a
KH		 2611static void
2612font_clear_cache (f, cache, driver)
2613 FRAME_PTR f;
2614 Lisp_Object cache;
2615 struct font_driver *driver;
2616{
2617 Lisp_Object tail, elt;
51c01100 2618
ca4da08a
KH		 2619 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2620 for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
2621 {
2622 elt = XCAR (tail);
be9442ad 2623 if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)) && VECTORP (XCDR (elt)))
ca4da08a
KH		 2624 {
2625 Lisp_Object vec = XCDR (elt);
2626 int i;
2627
2628 for (i = 0; i < ASIZE (vec); i++)
2629 {
2630 Lisp_Object entity = AREF (vec, i);
2631
2632 if (EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
2633 {
2634 Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
2635
2636 for (; CONSP (objlist); objlist = XCDR (objlist))
2637 {
2638 Lisp_Object val = XCAR (objlist);
35027d0c 2639 struct font *font = XFONT_OBJECT (val);
ca4da08a 2640
5e634ec9
KH		 2641 if (! NILP (AREF (val, FONT_TYPE_INDEX)))
2642 {
2643 font_assert (font && driver == font->driver);
2644 driver->close (f, font);
2645 num_fonts--;
2646 }
ca4da08a
KH		 2647 }
2648 if (driver->free_entity)
2649 driver->free_entity (entity);
2650 }
2651 }
2652 }
2653 }
2654 XSETCDR (cache, Qnil);
2655}
2656\f
2657
c2f5bfd6
KH		 2658static Lisp_Object scratch_font_spec, scratch_font_prefer;
2659
35027d0c
KH		 2660Lisp_Object
2661font_delete_unmatched (list, spec, size)
2662 Lisp_Object list, spec;
2663 int size;
2664{
d0ab1ebe 2665 Lisp_Object entity, val;
35027d0c 2666 enum font_property_index prop;
45eb10fb 2667
d0ab1ebe 2668 for (val = Qnil; CONSP (list); list = XCDR (list))
35027d0c 2669 {
d0ab1ebe 2670 entity = XCAR (list);
35027d0c
KH		 2671 for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
2672 if (INTEGERP (AREF (spec, prop))
2673 && ((XINT (AREF (spec, prop)) >> 8)
2674 != (XINT (AREF (entity, prop)) >> 8)))
2675 prop = FONT_SPEC_MAX;
7181ea6a 2676 if (prop < FONT_SPEC_MAX
35027d0c
KH		 2677 && size
2678 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
2679 {
2680 int diff = XINT (AREF (entity, FONT_SIZE_INDEX)) - size;
c2f5bfd6 2681
35027d0c
KH		 2682 if (diff != 0
2683 && (diff < 0 ? -diff > FONT_PIXEL_SIZE_QUANTUM
2684 : diff > FONT_PIXEL_SIZE_QUANTUM))
2685 prop = FONT_SPEC_MAX;
2686 }
7181ea6a
KH		 2687 if (prop < FONT_SPEC_MAX
2688 && INTEGERP (AREF (spec, FONT_DPI_INDEX))
2689 && INTEGERP (AREF (entity, FONT_DPI_INDEX))
c576d6dc 2690 && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
7181ea6a
KH		 2691 && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX)))
2692 prop = FONT_SPEC_MAX;
2693 if (prop < FONT_SPEC_MAX
2694 && INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX))
2695 && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
c576d6dc 2696 && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0
7181ea6a
KH		 2697 && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX),
2698 AREF (entity, FONT_AVGWIDTH_INDEX)))
2699 prop = FONT_SPEC_MAX;
35027d0c 2700 if (prop < FONT_SPEC_MAX)
d0ab1ebe 2701 val = Fcons (entity, val);
35027d0c 2702 }
d0ab1ebe 2703 return val;
35027d0c
KH		 2704}
2705
2706
2707/* Return a vector of font-entities matching with SPEC on FRAME. */
2708
2709Lisp_Object
c2f5bfd6
KH		 2710font_list_entities (frame, spec)
2711 Lisp_Object frame, spec;
2712{
2713 FRAME_PTR f = XFRAME (frame);
2714 struct font_driver_list *driver_list = f->font_driver_list;
4007dd1c 2715 Lisp_Object ftype, val;
35027d0c
KH		 2716 Lisp_Object *vec;
2717 int size;
2718 int need_filtering = 0;
c2f5bfd6
KH		 2719 int i;
2720
d0ab1ebe 2721 font_assert (FONT_SPEC_P (spec));
c2f5bfd6 2722
35027d0c
KH		 2723 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
2724 size = XINT (AREF (spec, FONT_SIZE_INDEX));
2725 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
2726 size = font_pixel_size (f, spec);
2727 else
2728 size = 0;
2729
c2f5bfd6 2730 ftype = AREF (spec, FONT_TYPE_INDEX);
4007dd1c 2731 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
35027d0c 2732 ASET (scratch_font_spec, i, AREF (spec, i));
4007dd1c 2733 for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
35027d0c
KH		 2734 {
2735 ASET (scratch_font_spec, i, Qnil);
2736 if (! NILP (AREF (spec, i)))
2737 need_filtering = 1;
4007dd1c
KH		 2738 if (i == FONT_DPI_INDEX)
2739 /* Skip FONT_SPACING_INDEX */
2740 i++;
35027d0c 2741 }
aa50ca2f 2742 ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
35027d0c
KH		 2743 ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
2744
4007dd1c 2745 vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
35027d0c
KH		 2746 if (! vec)
2747 return null_vector;
51c01100 2748
c2f5bfd6 2749 for (i = 0; driver_list; driver_list = driver_list->next)
417a1b10
KH		 2750 if (driver_list->on
2751 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
c2f5bfd6 2752 {
ca4da08a 2753 Lisp_Object cache = font_get_cache (f, driver_list->driver);
c2f5bfd6 2754
e4c93315 2755 ASET (scratch_font_spec, FONT_TYPE_INDEX, driver_list->driver->type);
4007dd1c
KH		 2756 val = assoc_no_quit (scratch_font_spec, XCDR (cache));
2757 if (CONSP (val))
2758 val = XCDR (val);
2759 else
c2f5bfd6 2760 {
4007dd1c 2761 Lisp_Object copy;
35027d0c 2762
4007dd1c
KH		 2763 val = driver_list->driver->list (frame, scratch_font_spec);
2764 copy = Fcopy_font_spec (scratch_font_spec);
2765 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2766 XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
c2f5bfd6 2767 }
4007dd1c
KH		 2768 if (! NILP (val) && need_filtering)
2769 val = font_delete_unmatched (val, spec, size);
2770 if (! NILP (val))
2771 vec[i++] = val;
c2f5bfd6 2772 }
35027d0c 2773
d0ab1ebe
KH		 2774 val = (i > 0 ? Fvconcat (i, vec) : null_vector);
2775 font_add_log ("list", spec, val);
2776 return (val);
c2f5bfd6
KH		 2777}
2778
45eb10fb 2779
35027d0c
KH		 2780/* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2781 nil, is an array of face's attributes, which specifies preferred
2782 font-related attributes. */
45eb10fb 2783
e950d6f1 2784static Lisp_Object
35027d0c
KH		 2785font_matching_entity (f, attrs, spec)
2786 FRAME_PTR f;
2787 Lisp_Object *attrs, spec;
e950d6f1 2788{
e950d6f1
KH		 2789 struct font_driver_list *driver_list = f->font_driver_list;
2790 Lisp_Object ftype, size, entity;
35027d0c 2791 Lisp_Object frame;
819ab95f 2792 Lisp_Object work = Fcopy_font_spec (spec);
e950d6f1 2793
35027d0c 2794 XSETFRAME (frame, f);
e950d6f1
KH		 2795 ftype = AREF (spec, FONT_TYPE_INDEX);
2796 size = AREF (spec, FONT_SIZE_INDEX);
819ab95f 2797
8d0e382e
AR		 2798 if (FLOATP (size))
2799 ASET (work, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
819ab95f
KH		 2800 FONT_SET_STYLE (work, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
2801 FONT_SET_STYLE (work, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
2802 FONT_SET_STYLE (work, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
2803
e950d6f1
KH		 2804 entity = Qnil;
2805 for (; driver_list; driver_list = driver_list->next)
2806 if (driver_list->on
2807 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
2808 {
ca4da08a 2809 Lisp_Object cache = font_get_cache (f, driver_list->driver);
7cee5d63 2810 Lisp_Object copy;
e950d6f1 2811
819ab95f
KH		 2812 ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
2813 entity = assoc_no_quit (work, XCDR (cache));
7cee5d63 2814 if (CONSP (entity))
e950d6f1
KH		 2815 entity = XCDR (entity);
2816 else
2817 {
819ab95f
KH		 2818 entity = driver_list->driver->match (frame, work);
2819 copy = Fcopy_font_spec (work);
7cee5d63
KH		 2820 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2821 XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache)));
e950d6f1
KH		 2822 }
2823 if (! NILP (entity))
2824 break;
2825 }
819ab95f 2826 font_add_log ("match", work, entity);
e950d6f1
KH		 2827 return entity;
2828}
2829
45eb10fb
KH		 2830
2831/* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2832 opened font object. */
2833
c2f5bfd6
KH		 2834static Lisp_Object
2835font_open_entity (f, entity, pixel_size)
2836 FRAME_PTR f;
2837 Lisp_Object entity;
2838 int pixel_size;
2839{
2840 struct font_driver_list *driver_list;
43c0454d 2841 Lisp_Object objlist, size, val, font_object;
c2f5bfd6 2842 struct font *font;
d26424c5 2843 int min_width, height;
c2f5bfd6 2844
d0ab1ebe 2845 font_assert (FONT_ENTITY_P (entity));
c2f5bfd6 2846 size = AREF (entity, FONT_SIZE_INDEX);
c2f5bfd6
KH		 2847 if (XINT (size) != 0)
2848 pixel_size = XINT (size);
2849
2850 for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
2851 objlist = XCDR (objlist))
5e634ec9
KH		 2852 if (! NILP (AREF (XCAR (objlist), FONT_TYPE_INDEX))
2853 && XFONT_OBJECT (XCAR (objlist))->pixel_size == pixel_size)
35027d0c
KH		 2854 return XCAR (objlist);
2855
2856 val = AREF (entity, FONT_TYPE_INDEX);
2857 for (driver_list = f->font_driver_list;
2858 driver_list && ! EQ (driver_list->driver->type, val);
2859 driver_list = driver_list->next);
2860 if (! driver_list)
2861 return Qnil;
c2f5bfd6 2862
35027d0c 2863 font_object = driver_list->driver->open (f, entity, pixel_size);
d0ab1ebe 2864 font_add_log ("open", entity, font_object);
43c0454d 2865 if (NILP (font_object))
35027d0c
KH		 2866 return Qnil;
2867 ASET (entity, FONT_OBJLIST_INDEX,
2868 Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
5e634ec9 2869 ASET (font_object, FONT_OBJLIST_INDEX, Qnil);
35027d0c
KH		 2870 num_fonts++;
2871
2872 font = XFONT_OBJECT (font_object);
2873 min_width = (font->min_width ? font->min_width
2874 : font->average_width ? font->average_width
2875 : font->space_width ? font->space_width
2876 : 1);
d26424c5 2877 height = (font->height ? font->height : 1);
819e81df 2878#ifdef HAVE_WINDOW_SYSTEM
35027d0c
KH		 2879 FRAME_X_DISPLAY_INFO (f)->n_fonts++;
2880 if (FRAME_X_DISPLAY_INFO (f)->n_fonts == 1)
43c0454d 2881 {
35027d0c 2882 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width;
d26424c5 2883 FRAME_SMALLEST_FONT_HEIGHT (f) = height;
35027d0c
KH		 2884 fonts_changed_p = 1;
2885 }
2886 else
2887 {
2888 if (FRAME_SMALLEST_CHAR_WIDTH (f) > min_width)
2889 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width, fonts_changed_p = 1;
d26424c5
KH		 2890 if (FRAME_SMALLEST_FONT_HEIGHT (f) > height)
2891 FRAME_SMALLEST_FONT_HEIGHT (f) = height, fonts_changed_p = 1;
43c0454d 2892 }
819e81df 2893#endif
43c0454d
KH		 2894
2895 return font_object;
c2f5bfd6
KH		 2896}
2897
45eb10fb
KH		 2898
2899/* Close FONT_OBJECT that is opened on frame F. */
2900
c2f5bfd6
KH		 2901void
2902font_close_object (f, font_object)
2903 FRAME_PTR f;
2904 Lisp_Object font_object;
2905{
35027d0c 2906 struct font *font = XFONT_OBJECT (font_object);
c2f5bfd6 2907
5e634ec9
KH		 2908 if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
2909 /* Already closed. */
2910 return;
2911 font_add_log ("close", font_object, Qnil);
2912 font->driver->close (f, font);
819e81df 2913#ifdef HAVE_WINDOW_SYSTEM
5e634ec9
KH		 2914 font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
2915 FRAME_X_DISPLAY_INFO (f)->n_fonts--;
819e81df 2916#endif
5e634ec9 2917 num_fonts--;
c2f5bfd6
KH		 2918}
2919
45eb10fb 2920
1701724c
KH		 2921/* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2922 FONT is a font-entity and it must be opened to check. */
45eb10fb 2923
c2f5bfd6 2924int
1b834a8d 2925font_has_char (f, font, c)
c2f5bfd6 2926 FRAME_PTR f;
1b834a8d 2927 Lisp_Object font;
c2f5bfd6
KH		 2928 int c;
2929{
1b834a8d 2930 struct font *fontp;
c2f5bfd6 2931
1b834a8d
KH		 2932 if (FONT_ENTITY_P (font))
2933 {
2934 Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
2935 struct font_driver_list *driver_list;
2936
2937 for (driver_list = f->font_driver_list;
2938 driver_list && ! EQ (driver_list->driver->type, type);
2939 driver_list = driver_list->next);
2940 if (! driver_list)
2941 return 0;
2942 if (! driver_list->driver->has_char)
2943 return -1;
2944 return driver_list->driver->has_char (font, c);
2945 }
2946
d0ab1ebe 2947 font_assert (FONT_OBJECT_P (font));
35027d0c 2948 fontp = XFONT_OBJECT (font);
1b834a8d
KH		 2949 if (fontp->driver->has_char)
2950 {
35027d0c 2951 int result = fontp->driver->has_char (font, c);
1b834a8d
KH		 2952
2953 if (result >= 0)
2954 return result;
2955 }
2956 return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
c2f5bfd6
KH		 2957}
2958
45eb10fb
KH		 2959
2960/* Return the glyph ID of FONT_OBJECT for character C. */
2961
c2f5bfd6
KH		 2962unsigned
2963font_encode_char (font_object, c)
2964 Lisp_Object font_object;
2965 int c;
2966{
35027d0c 2967 struct font *font;
c2f5bfd6 2968
d0ab1ebe 2969 font_assert (FONT_OBJECT_P (font_object));
35027d0c 2970 font = XFONT_OBJECT (font_object);
c2f5bfd6
KH		 2971 return font->driver->encode_char (font, c);
2972}
2973
45eb10fb
KH		 2974
2975/* Return the name of FONT_OBJECT. */
2976
ef18374f 2977Lisp_Object
c2f5bfd6
KH		 2978font_get_name (font_object)
2979 Lisp_Object font_object;
2980{
d0ab1ebe 2981 font_assert (FONT_OBJECT_P (font_object));
35027d0c 2982 return AREF (font_object, FONT_NAME_INDEX);
ef18374f
KH		 2983}
2984
45eb10fb
KH		 2985
2986/* Return the specification of FONT_OBJECT. */
2987
ef18374f
KH		 2988Lisp_Object
2989font_get_spec (font_object)
2990 Lisp_Object font_object;
2991{
35027d0c 2992 Lisp_Object spec = font_make_spec ();
ef18374f
KH		 2993 int i;
2994
2995 for (i = 0; i < FONT_SIZE_INDEX; i++)
35027d0c
KH		 2996 ASET (spec, i, AREF (font_object, i));
2997 ASET (spec, FONT_SIZE_INDEX,
2998 make_number (XFONT_OBJECT (font_object)->pixel_size));
ef18374f 2999 return spec;
c2f5bfd6
KH		 3000}
3001
35027d0c
KH		 3002Lisp_Object
3003font_spec_from_name (font_name)
3004 Lisp_Object font_name;
3005{
3006 Lisp_Object args[2];
3007
3008 args[0] = QCname;
3009 args[1] = font_name;
3010 return Ffont_spec (2, args);
3011}
3012
45eb10fb 3013
35027d0c
KH		 3014void
3015font_clear_prop (attrs, prop)
3016 Lisp_Object *attrs;
3017 enum font_property_index prop;
3018{
3019 Lisp_Object font = attrs[LFACE_FONT_INDEX];
45eb10fb 3020
35027d0c
KH		 3021 if (! FONTP (font))
3022 return;
3023 if (NILP (AREF (font, prop))
e234927a
CY		 3024 && prop != FONT_FAMILY_INDEX
3025 && prop != FONT_FOUNDRY_INDEX
3026 && prop != FONT_WIDTH_INDEX
4007dd1c 3027 && prop != FONT_SIZE_INDEX)
35027d0c
KH		 3028 return;
3029 font = Fcopy_font_spec (font);
3030 ASET (font, prop, Qnil);
4007dd1c 3031 if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
35027d0c 3032 {
4007dd1c
KH		 3033 if (prop == FONT_FAMILY_INDEX)
3034 ASET (font, FONT_FOUNDRY_INDEX, Qnil);
35027d0c 3035 ASET (font, FONT_ADSTYLE_INDEX, Qnil);
4007dd1c 3036 ASET (font, FONT_REGISTRY_INDEX, Qnil);
35027d0c
KH		 3037 ASET (font, FONT_SIZE_INDEX, Qnil);
3038 ASET (font, FONT_DPI_INDEX, Qnil);
3039 ASET (font, FONT_SPACING_INDEX, Qnil);
3040 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3041 }
3042 else if (prop == FONT_SIZE_INDEX)
3043 {
3044 ASET (font, FONT_DPI_INDEX, Qnil);
3045 ASET (font, FONT_SPACING_INDEX, Qnil);
3046 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3047 }
e234927a
CY		 3048 else if (prop == FONT_WIDTH_INDEX)
3049 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
35027d0c
KH		 3050 attrs[LFACE_FONT_INDEX] = font;
3051}
3052
3053void
3054font_update_lface (f, attrs)
3055 FRAME_PTR f;
3056 Lisp_Object *attrs;
c2f5bfd6 3057{
d0ab1ebe 3058 Lisp_Object spec;
35027d0c
KH		 3059
3060 spec = attrs[LFACE_FONT_INDEX];
3061 if (! FONT_SPEC_P (spec))
3062 return;
3063
4007dd1c
KH		 3064 if (! NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
3065 attrs[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FOUNDRY_INDEX));
3066 if (! NILP (AREF (spec, FONT_FAMILY_INDEX)))
3067 attrs[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FAMILY_INDEX));
35027d0c
KH		 3068 if (! NILP (AREF (spec, FONT_WEIGHT_INDEX)))
3069 attrs[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (spec);
3070 if (! NILP (AREF (spec, FONT_SLANT_INDEX)))
3071 attrs[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (spec);;
3072 if (! NILP (AREF (spec, FONT_WIDTH_INDEX)))
3073 attrs[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (spec);
3074 if (! NILP (AREF (spec, FONT_SIZE_INDEX)))
3075 {
3076 int point;
3077
3078 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
3079 {
3080 Lisp_Object val;
3081 int dpi = f->resy;
3082
3083 val = Ffont_get (spec, QCdpi);
3084 if (! NILP (val))
3085 dpi = XINT (val);
3086 point = PIXEL_TO_POINT (XINT (AREF (spec, FONT_SIZE_INDEX)) * 10,
3087 dpi);
3088 }
3089 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
3090 point = XFLOAT_DATA (AREF (spec, FONT_SIZE_INDEX)) * 10;
3091 attrs[LFACE_HEIGHT_INDEX] = make_number (point);
3092 }
c2f5bfd6
KH		 3093}
3094
45eb10fb 3095
35027d0c
KH		 3096/* Return a font-entity satisfying SPEC and best matching with face's
3097 font related attributes in ATTRS. C, if not negative, is a
1701724c 3098 character that the entity must support. */
c2f5bfd6
KH		 3099
3100Lisp_Object
35027d0c 3101font_find_for_lface (f, attrs, spec, c)
c2f5bfd6 3102 FRAME_PTR f;
35027d0c 3103 Lisp_Object *attrs;
c2f5bfd6 3104 Lisp_Object spec;
1701724c 3105 int c;
c2f5bfd6 3106{
4007dd1c 3107 Lisp_Object work;
35027d0c 3108 Lisp_Object frame, entities, val, props[FONT_REGISTRY_INDEX + 1] ;
22459668 3109 Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
1d1e1245 3110 int pixel_size;
22459668 3111 int i, j, k, l, result;
d0a47776
KH		 3112
3113 registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
3114 if (NILP (registry[0]))
3115 {
edfda783 3116 registry[0] = DEFAULT_ENCODING;
d0a47776
KH		 3117 registry[1] = Qascii_0;
3118 registry[2] = null_vector;
3119 }
3120 else
3121 registry[1] = null_vector;
c2f5bfd6 3122
4007dd1c 3123 if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
fe5ddfbc 3124 {
35027d0c 3125 struct charset *encoding, *repertory;
1701724c 3126
4007dd1c
KH		 3127 if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
3128 &encoding, &repertory) < 0)
35027d0c
KH		 3129 return Qnil;
3130 if (repertory)
1701724c 3131 {
35027d0c 3132 if (ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
1701724c 3133 return Qnil;
35027d0c
KH		 3134 /* Any font of this registry support C. So, let's
3135 suppress the further checking. */
3136 c = -1;
1701724c 3137 }
35027d0c
KH		 3138 else if (c > encoding->max_char)
3139 return Qnil;
c2f5bfd6
KH		 3140 }
3141
4007dd1c 3142 work = Fcopy_font_spec (spec);
35027d0c
KH		 3143 XSETFRAME (frame, f);
3144 size = AREF (spec, FONT_SIZE_INDEX);
1d1e1245
KH		 3145 pixel_size = font_pixel_size (f, spec);
3146 if (pixel_size == 0)
3147 {
3148 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
3149
3150 pixel_size = POINT_TO_PIXEL (pt / 10, f->resy);
3151 }
4007dd1c
KH		 3152 ASET (work, FONT_SIZE_INDEX, Qnil);
3153 foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
3154 if (! NILP (foundry[0]))
3155 foundry[1] = null_vector;
3156 else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
3157 {
071132a9
KH		 3158 val = attrs[LFACE_FOUNDRY_INDEX];
3159 foundry[0] = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
4007dd1c
KH		 3160 foundry[1] = Qnil;
3161 foundry[2] = null_vector;
3162 }
3163 else
3164 foundry[0] = Qnil, foundry[1] = null_vector;
3165
22459668
KH		 3166 adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
3167 if (! NILP (adstyle[0]))
3168 adstyle[1] = null_vector;
3169 else if (FONTP (attrs[LFACE_FONT_INDEX]))
3170 {
3171 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3172
3173 if (! NILP (AREF (face_font, FONT_ADSTYLE_INDEX)))
3174 {
3175 adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
3176 adstyle[1] = Qnil;
3177 adstyle[2] = null_vector;
3178 }
3179 else
3180 adstyle[0] = Qnil, adstyle[1] = null_vector;
3181 }
3182 else
3183 adstyle[0] = Qnil, adstyle[1] = null_vector;
3184
3185
4007dd1c
KH		 3186 val = AREF (work, FONT_FAMILY_INDEX);
3187 if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
071132a9
KH		 3188 {
3189 val = attrs[LFACE_FAMILY_INDEX];
3190 val = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
3191 }
4007dd1c
KH		 3192 if (NILP (val))
3193 {
3194 family = alloca ((sizeof family[0]) * 2);
3195 family[0] = Qnil;
3196 family[1] = null_vector; /* terminator. */
3197 }
3198 else
3199 {
3200 Lisp_Object alters
819ab95f
KH		 3201 = Fassoc_string (val, Vface_alternative_font_family_alist,
3202#ifndef HAVE_NS
3203 Qt
3204#else
3205 Qnil
3206#endif
3207 );
4007dd1c
KH		 3208
3209 if (! NILP (alters))
3210 {
3211 family = alloca ((sizeof family[0]) * (XINT (Flength (alters)) + 2));
3212 for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
3213 family[i] = XCAR (alters);
3214 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3215 family[i++] = Qnil;
3216 family[i] = null_vector;
3217 }
3218 else
3219 {
3220 family = alloca ((sizeof family[0]) * 3);
3221 i = 0;
3222 family[i++] = val;
3223 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3224 family[i++] = Qnil;
3225 family[i] = null_vector;
3226 }
3227 }
3228
d0a47776 3229 for (i = 0; SYMBOLP (family[i]); i++)
4007dd1c 3230 {
d0a47776
KH		 3231 ASET (work, FONT_FAMILY_INDEX, family[i]);
3232 for (j = 0; SYMBOLP (foundry[j]); j++)
4007dd1c 3233 {
d0a47776
KH		 3234 ASET (work, FONT_FOUNDRY_INDEX, foundry[j]);
3235 for (k = 0; SYMBOLP (registry[k]); k++)
3236 {
904a2e0e 3237 ASET (work, FONT_REGISTRY_INDEX, registry[k]);
22459668
KH		 3238 for (l = 0; SYMBOLP (adstyle[l]); l++)
3239 {
3240 ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
3241 entities = font_list_entities (frame, work);
3242 if (ASIZE (entities) > 0)
3243 goto found;
3244 }
d0a47776 3245 }
4007dd1c 3246 }
4007dd1c 3247 }
d0a47776
KH		 3248 return Qnil;
3249 found:
35027d0c
KH		 3250 if (ASIZE (entities) == 1)
3251 {
3252 if (c < 0)
3253 return AREF (entities, 0);
3254 }
3255 else
c2f5bfd6 3256 {
fe5ddfbc 3257 /* Sort fonts by properties specified in LFACE. */
ec6fe57c 3258 Lisp_Object prefer = scratch_font_prefer;
d0ab1ebe 3259
35027d0c 3260 for (i = 0; i < FONT_EXTRA_INDEX; i++)
4007dd1c 3261 ASET (prefer, i, AREF (work, i));
79f105c9
KH		 3262 if (FONTP (attrs[LFACE_FONT_INDEX]))
3263 {
3264 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3265
3266 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3267 if (NILP (AREF (prefer, i)))
3268 ASET (prefer, i, AREF (face_font, i));
3269 }
35027d0c
KH		 3270 if (NILP (AREF (prefer, FONT_WEIGHT_INDEX)))
3271 FONT_SET_STYLE (prefer, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
3272 if (NILP (AREF (prefer, FONT_SLANT_INDEX)))
3273 FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
3274 if (NILP (AREF (prefer, FONT_WIDTH_INDEX)))
3275 FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
1d1e1245 3276 ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size));
7181ea6a 3277 entities = font_sort_entites (entities, prefer, frame, c < 0);
c2f5bfd6 3278 }
1701724c 3279 if (c < 0)
35027d0c 3280 return entities;
45eb10fb 3281
35027d0c
KH		 3282 for (i = 0; i < ASIZE (entities); i++)
3283 {
3284 int j;
3285
3286 val = AREF (entities, i);
3287 if (i > 0)
3288 {
3289 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3290 if (! EQ (AREF (val, j), props[j]))
3291 break;
3292 if (j > FONT_REGISTRY_INDEX)
3293 continue;
3294 }
3295 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3296 props[j] = AREF (val, j);
3297 result = font_has_char (f, val, c);
3298 if (result > 0)
3299 return val;
3300 if (result == 0)
3301 return Qnil;
3302 val = font_open_for_lface (f, val, attrs, spec);
3303 if (NILP (val))
3304 continue;
3305 result = font_has_char (f, val, c);
3306 font_close_object (f, val);
3307 if (result > 0)
3308 return AREF (entities, i);
3309 }
1701724c
KH		 3310 return Qnil;
3311}
45eb10fb
KH		 3312
3313
c2f5bfd6 3314Lisp_Object
35027d0c 3315font_open_for_lface (f, entity, attrs, spec)
c2f5bfd6 3316 FRAME_PTR f;
c2f5bfd6 3317 Lisp_Object entity;
35027d0c 3318 Lisp_Object *attrs;
733fd013 3319 Lisp_Object spec;
c2f5bfd6 3320{
9331887d 3321 int size;
c2f5bfd6 3322
4007dd1c
KH		 3323 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX))
3324 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
3325 size = XINT (AREF (entity, FONT_SIZE_INDEX));
3326 else if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
1d1e1245 3327 size = font_pixel_size (f, spec);
733fd013
KH		 3328 else
3329 {
35027d0c 3330 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
733fd013
KH		 3331
3332 pt /= 10;
3333 size = POINT_TO_PIXEL (pt, f->resy);
ed96cde8
AR		 3334#ifdef HAVE_NS
3335 if (size == 0)
3336 {
3337 Lisp_Object ffsize = get_frame_param(f, Qfontsize);
3338 size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
3339 }
3340#endif
733fd013 3341 }
c2f5bfd6
KH		 3342 return font_open_entity (f, entity, size);
3343}
3344
45eb10fb 3345
35027d0c
KH		 3346/* Find a font satisfying SPEC and best matching with face's
3347 attributes in ATTRS on FRAME, and return the opened
3348 font-object. */
45eb10fb 3349
35027d0c
KH		 3350Lisp_Object
3351font_load_for_lface (f, attrs, spec)
c2f5bfd6 3352 FRAME_PTR f;
35027d0c 3353 Lisp_Object *attrs, spec;
c2f5bfd6 3354{
35027d0c 3355 Lisp_Object entity;
ef18374f 3356
35027d0c
KH		 3357 entity = font_find_for_lface (f, attrs, spec, -1);
3358 if (NILP (entity))
ef18374f 3359 {
35027d0c
KH		 3360 /* No font is listed for SPEC, but each font-backend may have
3361 the different criteria about "font matching". So, try
3362 it. */
3363 entity = font_matching_entity (f, attrs, spec);
3364 if (NILP (entity))
3365 return Qnil;
c2f5bfd6 3366 }
35027d0c 3367 return font_open_for_lface (f, entity, attrs, spec);
c2f5bfd6
KH		 3368}
3369
45eb10fb
KH		 3370
3371/* Make FACE on frame F ready to use the font opened for FACE. */
3372
c2f5bfd6
KH		 3373void
3374font_prepare_for_face (f, face)
3375 FRAME_PTR f;
3376 struct face *face;
3377{
35027d0c
KH		 3378 if (face->font->driver->prepare_face)
3379 face->font->driver->prepare_face (f, face);
c2f5bfd6
KH		 3380}
3381
45eb10fb
KH		 3382
3383/* Make FACE on frame F stop using the font opened for FACE. */
3384
c2f5bfd6
KH		 3385void
3386font_done_for_face (f, face)
3387 FRAME_PTR f;
3388 struct face *face;
3389{
35027d0c
KH		 3390 if (face->font->driver->done_face)
3391 face->font->driver->done_face (f, face);
c2f5bfd6
KH		 3392 face->extra = NULL;
3393}
3394
45eb10fb
KH		 3395
3396/* Open a font best matching with NAME on frame F. If no proper font
3397 is found, return Qnil. */
3398
c2f5bfd6
KH		 3399Lisp_Object
3400font_open_by_name (f, name)
3401 FRAME_PTR f;
3402 char *name;
3403{
ef18374f 3404 Lisp_Object args[2];
4007dd1c 3405 Lisp_Object spec, attrs[LFACE_VECTOR_SIZE];
a9262bb8 3406
ef18374f
KH		 3407 args[0] = QCname;
3408 args[1] = make_unibyte_string (name, strlen (name));
3409 spec = Ffont_spec (2, args);
4007dd1c
KH		 3410 /* We set up the default font-related attributes of a face to prefer
3411 a moderate font. */
3412 attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
3413 attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
3414 = attrs[LFACE_SLANT_INDEX] = Qnormal;
ed96cde8 3415#ifndef HAVE_NS
4007dd1c 3416 attrs[LFACE_HEIGHT_INDEX] = make_number (120);
ed96cde8
AR		 3417#else
3418 attrs[LFACE_HEIGHT_INDEX] = make_number (0);
3419#endif
4007dd1c
KH		 3420 attrs[LFACE_FONT_INDEX] = Qnil;
3421
3422 return font_load_for_lface (f, attrs, spec);
c2f5bfd6
KH		 3423}
3424
3425
3426/* Register font-driver DRIVER. This function is used in two ways.
3427
417a1b10
KH		 3428 The first is with frame F non-NULL. In this case, make DRIVER
3429 available (but not yet activated) on F. All frame creaters
3430 (e.g. Fx_create_frame) must call this function at least once with
3431 an available font-driver.
c2f5bfd6
KH		 3432
3433 The second is with frame F NULL. In this case, DRIVER is globally
3434 registered in the variable `font_driver_list'. All font-driver
3435 implementations must call this function in its syms_of_XXXX
3436 (e.g. syms_of_xfont). */
3437
3438void
3439register_font_driver (driver, f)
3440 struct font_driver *driver;
3441 FRAME_PTR f;
3442{
3443 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
3444 struct font_driver_list *prev, *list;
3445
3446 if (f && ! driver->draw)
43a1d19b 3447 error ("Unusable font driver for a frame: %s",
c2f5bfd6
KH		 3448 SDATA (SYMBOL_NAME (driver->type)));
3449
3450 for (prev = NULL, list = root; list; prev = list, list = list->next)
cf23b845 3451 if (EQ (list->driver->type, driver->type))
c2f5bfd6
KH		 3452 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
3453
c115043b 3454 list = xmalloc (sizeof (struct font_driver_list));
417a1b10 3455 list->on = 0;
c2f5bfd6
KH		 3456 list->driver = driver;
3457 list->next = NULL;
3458 if (prev)
3459 prev->next = list;
3460 else if (f)
3461 f->font_driver_list = list;
3462 else
3463 font_driver_list = list;
72606e45
KH		 3464 if (! f)
3465 num_font_drivers++;
c2f5bfd6
KH		 3466}
3467
45eb10fb 3468
f697fff0 3469/* Make the frame F use font backends listed in NEW_DRIVERS (list of
ca4da08a
KH		 3470 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3471 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
417a1b10 3472
ca4da08a
KH		 3473 A caller must free all realized faces if any in advance. The
3474 return value is a list of font backends actually made used on
3475 F. */
e950d6f1
KH		 3476
3477Lisp_Object
3478font_update_drivers (f, new_drivers)
417a1b10
KH		 3479 FRAME_PTR f;
3480 Lisp_Object new_drivers;
417a1b10
KH		 3481{
3482 Lisp_Object active_drivers = Qnil;
4007dd1c 3483 struct font_driver *driver;
417a1b10
KH		 3484 struct font_driver_list *list;
3485
4007dd1c
KH		 3486 /* At first, turn off non-requested drivers, and turn on requested
3487 drivers. */
f697fff0 3488 for (list = f->font_driver_list; list; list = list->next)
4007dd1c
KH		 3489 {
3490 driver = list->driver;
3491 if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers)))
3492 != list->on)
3493 {
3494 if (list->on)
3495 {
3496 if (driver->end_for_frame)
3497 driver->end_for_frame (f);
3498 font_finish_cache (f, driver);
3499 list->on = 0;
3500 }
3501 else
3502 {
3503 if (! driver->start_for_frame
3504 || driver->start_for_frame (f) == 0)
3505 {
3506 font_prepare_cache (f, driver);
3507 list->on = 1;
3508 }
3509 }
3510 }
3511 }
3512
3513 if (NILP (new_drivers))
3514 return Qnil;
3515
3516 if (! EQ (new_drivers, Qt))
3517 {
3518 /* Re-order the driver list according to new_drivers. */
3306c6dc 3519 struct font_driver_list **list_table, **next;
4007dd1c
KH		 3520 Lisp_Object tail;
3521 int i;
3522
3523 list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
3524 for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
3525 {
3526 for (list = f->font_driver_list; list; list = list->next)
3527 if (list->on && EQ (list->driver->type, XCAR (tail)))
3528 break;
3529 if (list)
3530 list_table[i++] = list;
3531 }
3532 for (list = f->font_driver_list; list; list = list->next)
3533 if (! list->on)
3534 list_table[i] = list;
3535 list_table[i] = NULL;
3536
3306c6dc 3537 next = &f->font_driver_list;
4007dd1c
KH		 3538 for (i = 0; list_table[i]; i++)
3539 {
3306c6dc
AS		 3540 *next = list_table[i];
3541 next = &(*next)->next;
4007dd1c 3542 }
3306c6dc 3543 *next = NULL;
4007dd1c 3544 }
417a1b10 3545
4007dd1c
KH		 3546 for (list = f->font_driver_list; list; list = list->next)
3547 if (list->on)
3548 active_drivers = nconc2 (active_drivers,
3549 Fcons (list->driver->type, Qnil));
e950d6f1 3550 return active_drivers;
417a1b10
KH		 3551}
3552
f697fff0
KH		 3553int
3554font_put_frame_data (f, driver, data)
3555 FRAME_PTR f;
3556 struct font_driver *driver;
3557 void *data;
3558{
3559 struct font_data_list *list, *prev;
3560
3561 for (prev = NULL, list = f->font_data_list; list;
3562 prev = list, list = list->next)
3563 if (list->driver == driver)
3564 break;
3565 if (! data)
3566 {
3567 if (list)
3568 {
3569 if (prev)
3570 prev->next = list->next;
3571 else
3572 f->font_data_list = list->next;
3573 free (list);
3574 }
3575 return 0;
3576 }
3577
3578 if (! list)
3579 {
c115043b 3580 list = xmalloc (sizeof (struct font_data_list));
f697fff0
KH		 3581 list->driver = driver;
3582 list->next = f->font_data_list;
3583 f->font_data_list = list;
3584 }
3585 list->data = data;
3586 return 0;
3587}
3588
3589
3590void *
3591font_get_frame_data (f, driver)
3592 FRAME_PTR f;
3593 struct font_driver *driver;
3594{
3595 struct font_data_list *list;
3596
3597 for (list = f->font_data_list; list; list = list->next)
3598 if (list->driver == driver)
3599 break;
3600 if (! list)
3601 return NULL;
3602 return list->data;
3603}
3604
417a1b10 3605
45eb10fb 3606/* Return the font used to draw character C by FACE at buffer position
e3ee0340
KH		 3607 POS in window W. If STRING is non-nil, it is a string containing C
3608 at index POS. If C is negative, get C from the current buffer or
3609 STRING. */
45eb10fb 3610
10d16101 3611Lisp_Object
e3ee0340 3612font_at (c, pos, face, w, string)
10d16101
KH		 3613 int c;
3614 EMACS_INT pos;
3615 struct face *face;
3616 struct window *w;
e3ee0340 3617 Lisp_Object string;
10d16101
KH		 3618{
3619 FRAME_PTR f;
e3ee0340 3620 int multibyte;
35027d0c 3621 Lisp_Object font_object;
e3ee0340
KH		 3622
3623 if (c < 0)
3624 {
3625 if (NILP (string))
3626 {
3627 multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3628 if (multibyte)
3629 {
3630 EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
3631
3632 c = FETCH_CHAR (pos_byte);
3633 }
3634 else
3635 c = FETCH_BYTE (pos);
3636 }
3637 else
3638 {
3639 unsigned char *str;
3640
3641 multibyte = STRING_MULTIBYTE (string);
3642 if (multibyte)
3643 {
3644 EMACS_INT pos_byte = string_char_to_byte (string, pos);
3645
3646 str = SDATA (string) + pos_byte;
3647 c = STRING_CHAR (str, 0);
3648 }
3649 else
3650 c = SDATA (string)[pos];
3651 }
3652 }
10d16101
KH		 3653
3654 f = XFRAME (w->frame);
1385a806
KH		 3655 if (! FRAME_WINDOW_P (f))
3656 return Qnil;
10d16101
KH		 3657 if (! face)
3658 {
e3ee0340 3659 int face_id;
0f8b27ea 3660 EMACS_INT endptr;
e3ee0340
KH		 3661
3662 if (STRINGP (string))
3663 face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
10d16101
KH		 3664 DEFAULT_FACE_ID, 0);
3665 else
e3ee0340 3666 face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
10d16101
KH		 3667 pos + 100, 0);
3668 face = FACE_FROM_ID (f, face_id);
3669 }
e3ee0340
KH		 3670 if (multibyte)
3671 {
3672 int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
3673 face = FACE_FROM_ID (f, face_id);
3674 }
35027d0c 3675 if (! face->font)
10d16101 3676 return Qnil;
35027d0c 3677
35027d0c
KH		 3678 XSETFONT (font_object, face->font);
3679 return font_object;
3680}
3681
3682
071132a9
KH		 3683#ifdef HAVE_WINDOW_SYSTEM
3684
3685/* Check how many characters after POS (at most to *LIMIT) can be
3686 displayed by the same font on the window W. FACE, if non-NULL, is
3687 the face selected for the character at POS. If STRING is not nil,
3688 it is the string to check instead of the current buffer. In that
3689 case, FACE must be not NULL.
027a33c0 3690
071132a9
KH		 3691 The return value is the font-object for the character at POS.
3692 *LIMIT is set to the position where that font can't be used.
35027d0c 3693
071132a9
KH		 3694 It is assured that the current buffer (or STRING) is multibyte. */
3695
3696Lisp_Object
3697font_range (pos, limit, w, face, string)
3698 EMACS_INT pos, *limit;
3699 struct window *w;
35027d0c 3700 struct face *face;
35027d0c
KH		 3701 Lisp_Object string;
3702{
071132a9 3703 EMACS_INT pos_byte, ignore, start, start_byte;
35027d0c 3704 int c;
071132a9 3705 Lisp_Object font_object = Qnil;
35027d0c
KH		 3706
3707 if (NILP (string))
3708 {
35027d0c 3709 pos_byte = CHAR_TO_BYTE (pos);
071132a9
KH		 3710 if (! face)
3711 {
3712 int face_id;
3713
3714 face_id = face_at_buffer_position (w, pos, 0, 0, &ignore, *limit, 0);
3715 face = FACE_FROM_ID (XFRAME (w->frame), face_id);
3716 }
35027d0c
KH		 3717 }
3718 else
3719 {
071132a9 3720 font_assert (face);
35027d0c
KH		 3721 pos_byte = string_char_to_byte (string, pos);
3722 }
3723
071132a9
KH		 3724 start = pos, start_byte = pos_byte;
3725 while (pos < *limit)
35027d0c 3726 {
071132a9 3727 Lisp_Object category;
35027d0c
KH		 3728
3729 if (NILP (string))
3730 FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
3731 else
3732 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
071132a9 3733 if (NILP (font_object))
35027d0c 3734 {
071132a9
KH		 3735 font_object = font_for_char (face, c, pos - 1, string);
3736 if (NILP (font_object))
3737 return Qnil;
35027d0c
KH		 3738 continue;
3739 }
071132a9
KH		 3740
3741 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3742 if (! EQ (category, QCf)
3743 && font_encode_char (font_object, c) == FONT_INVALID_CODE)
35027d0c 3744 {
071132a9
KH		 3745 Lisp_Object f = font_for_char (face, c, pos - 1, string);
3746 EMACS_INT i, i_byte;
3747
3748
3749 if (NILP (f))
3750 {
3751 *limit = pos - 1;
3752 return font_object;
3753 }
3754 i = start, i_byte = start_byte;
3755 while (i < pos - 1)
3756 {
3757
3758 if (NILP (string))
3759 FETCH_CHAR_ADVANCE_NO_CHECK (c, i, i_byte);
3760 else
3761 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, i, i_byte);
3762 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3763 if (! EQ (category, QCf)
3764 && font_encode_char (f, c) == FONT_INVALID_CODE)
3765 {
3766 *limit = pos - 1;
3767 return font_object;
3768 }
3769 }
3770 font_object = f;
35027d0c
KH		 3771 }
3772 }
071132a9 3773 return font_object;
10d16101 3774}
071132a9 3775#endif
10d16101 3776
c2f5bfd6
KH		 3777\f
3778/* Lisp API */
3779
35027d0c 3780DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
6c8ec042 3781 doc: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
35027d0c
KH		 3782Return nil otherwise.
3783Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
027a33c0 3784which kind of font it is. It must be one of `font-spec', `font-entity',
35027d0c
KH		 3785`font-object'. */)
3786 (object, extra_type)
3787 Lisp_Object object, extra_type;
c2f5bfd6 3788{
35027d0c
KH		 3789 if (NILP (extra_type))
3790 return (FONTP (object) ? Qt : Qnil);
3791 if (EQ (extra_type, Qfont_spec))
3792 return (FONT_SPEC_P (object) ? Qt : Qnil);
3793 if (EQ (extra_type, Qfont_entity))
3794 return (FONT_ENTITY_P (object) ? Qt : Qnil);
3795 if (EQ (extra_type, Qfont_object))
3796 return (FONT_OBJECT_P (object) ? Qt : Qnil);
3797 wrong_type_argument (intern ("font-extra-type"), extra_type);
c2f5bfd6
KH		 3798}
3799
3800DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
45eb10fb
KH		 3801 doc: /* Return a newly created font-spec with arguments as properties.
3802
3803ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3804valid font property name listed below:
3805
3806`:family', `:weight', `:slant', `:width'
3807
3808They are the same as face attributes of the same name. See
51c01100 3809`set-face-attribute'.
45eb10fb
KH		 3810
3811`:foundry'
3812
3813VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3814
3815`:adstyle'
3816
3817VALUE must be a string or a symbol specifying the additional
35027d0c 3818typographic style information of a font, e.g. ``sans''.
45eb10fb
KH		 3819
3820`:registry'
3821
3822VALUE must be a string or a symbol specifying the charset registry and
3823encoding of a font, e.g. ``iso8859-1''.
3824
3825`:size'
3826
3827VALUE must be a non-negative integer or a floating point number
35027d0c 3828specifying the font size. It specifies the font size in pixels
f697fff0 3829(if VALUE is an integer), or in points (if VALUE is a float).
2babb359
KH		 3830
3831`:name'
3832
7a18a178 3833VALUE must be a string of XLFD-style or fontconfig-style font name.
5bdd4dd2
KH		 3834usage: (font-spec ARGS ...)
3835
3836`:script'
3837
3838VALUE must be a symbol representing a script that the font must
3839support. */)
c2f5bfd6
KH		 3840 (nargs, args)
3841 int nargs;
3842 Lisp_Object *args;
3843{
35027d0c 3844 Lisp_Object spec = font_make_spec ();
c2f5bfd6
KH		 3845 int i;
3846
3847 for (i = 0; i < nargs; i += 2)
3848 {
c2f5bfd6
KH		 3849 Lisp_Object key = args[i], val = args[i + 1];
3850
35027d0c
KH		 3851 if (EQ (key, QCname))
3852 {
3853 CHECK_STRING (val);
3854 font_parse_name ((char *) SDATA (val), spec);
3855 font_put_extra (spec, key, val);
3856 }
c2f5bfd6 3857 else
4485a28e 3858 {
35027d0c
KH		 3859 int idx = get_font_prop_index (key);
3860
3861 if (idx >= 0)
ec6fe57c 3862 {
35027d0c
KH		 3863 val = font_prop_validate (idx, Qnil, val);
3864 if (idx < FONT_EXTRA_INDEX)
3865 ASET (spec, idx, val);
3866 else
3867 font_put_extra (spec, key, val);
ec6fe57c 3868 }
35027d0c
KH		 3869 else
3870 font_put_extra (spec, key, font_prop_validate (0, key, val));
4485a28e 3871 }
e950d6f1 3872 }
c2f5bfd6
KH		 3873 return spec;
3874}
3875
35027d0c
KH		 3876DEFUN ("copy-font-spec", Fcopy_font_spec, Scopy_font_spec, 1, 1, 0,
3877 doc: /* Return a copy of FONT as a font-spec. */)
3878 (font)
3879 Lisp_Object font;
3880{
d26424c5 3881 Lisp_Object new_spec, tail, prev, extra;
35027d0c
KH		 3882 int i;
3883
3884 CHECK_FONT (font);
3885 new_spec = font_make_spec ();
3886 for (i = 1; i < FONT_EXTRA_INDEX; i++)
3887 ASET (new_spec, i, AREF (font, i));
d26424c5
KH		 3888 extra = Fcopy_sequence (AREF (font, FONT_EXTRA_INDEX));
3889 /* We must remove :font-entity property. */
3890 for (prev = Qnil, tail = extra; CONSP (tail); prev = tail, tail = XCDR (tail))
3891 if (EQ (XCAR (XCAR (tail)), QCfont_entity))
3892 {
3893 if (NILP (prev))
3894 extra = XCDR (extra);
3895 else
3896 XSETCDR (prev, XCDR (tail));
3897 break;
3898 }
35027d0c
KH		 3899 ASET (new_spec, FONT_EXTRA_INDEX, extra);
3900 return new_spec;
3901}
3902
3903DEFUN ("merge-font-spec", Fmerge_font_spec, Smerge_font_spec, 2, 2, 0,
3904 doc: /* Merge font-specs FROM and TO, and return a new font-spec.
3905Every specified properties in FROM override the corresponding
3906properties in TO. */)
3907 (from, to)
3908 Lisp_Object from, to;
3909{
3910 Lisp_Object extra, tail;
3911 int i;
3912
3913 CHECK_FONT (from);
3914 CHECK_FONT (to);
3915 to = Fcopy_font_spec (to);
3916 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3917 ASET (to, i, AREF (from, i));
3918 extra = AREF (to, FONT_EXTRA_INDEX);
3919 for (tail = AREF (from, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
3920 if (! EQ (XCAR (XCAR (tail)), Qfont_entity))
3921 {
3922 Lisp_Object slot = assq_no_quit (XCAR (XCAR (tail)), extra);
3923
3924 if (! NILP (slot))
3925 XSETCDR (slot, XCDR (XCAR (tail)));
3926 else
3927 extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
3928 }
3929 ASET (to, FONT_EXTRA_INDEX, extra);
3930 return to;
3931}
c2f5bfd6
KH		 3932
3933DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
45eb10fb 3934 doc: /* Return the value of FONT's property KEY.
5bdd4dd2
KH		 3935FONT is a font-spec, a font-entity, or a font-object.
3936KEY must be one of these symbols:
3937 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3938 :size, :name, :script
3939See the documentation of `font-spec' for their meanings.
3940If FONT is a font-entity or font-object, the value of :script may be
3941a list of scripts that are supported by the font. */)
45eb10fb
KH		 3942 (font, key)
3943 Lisp_Object font, key;
c2f5bfd6 3944{
35027d0c 3945 int idx;
c2f5bfd6 3946
35027d0c
KH		 3947 CHECK_FONT (font);
3948 CHECK_SYMBOL (key);
e80e09b4 3949
35027d0c 3950 idx = get_font_prop_index (key);
2babb359
KH		 3951 if (idx >= FONT_WEIGHT_INDEX && idx <= FONT_WIDTH_INDEX)
3952 return font_style_symbolic (font, idx, 0);
35027d0c 3953 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
c2f5bfd6 3954 return AREF (font, idx);
35027d0c 3955 return Fcdr (Fassq (key, AREF (font, FONT_EXTRA_INDEX)));
c2f5bfd6
KH		 3956}
3957
51cf11be
AS		 3958#ifdef HAVE_WINDOW_SYSTEM
3959
b1868a1a
CY		 3960DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1, 2, 0,
3961 doc: /* Return a plist of face attributes generated by FONT.
3962FONT is a font name, a font-spec, a font-entity, or a font-object.
3963The return value is a list of the form
3964
6f568955 3965\(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
b1868a1a 3966
48105a6a 3967where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
5989ba2f
CY		 3968compatible with `set-face-attribute'. Some of these key-attribute pairs
3969may be omitted from the list if they are not specified by FONT.
b1868a1a 3970
48105a6a
JB		 3971The optional argument FRAME specifies the frame that the face attributes
3972are to be displayed on. If omitted, the selected frame is used. */)
b1868a1a 3973 (font, frame)
6f568955 3974 Lisp_Object font, frame;
b1868a1a
CY		 3975{
3976 struct frame *f;
3977 Lisp_Object plist[10];
3978 Lisp_Object val;
5989ba2f 3979 int n = 0;
b1868a1a
CY		 3980
3981 if (NILP (frame))
3982 frame = selected_frame;
3983 CHECK_LIVE_FRAME (frame);
3984 f = XFRAME (frame);
3985
3986 if (STRINGP (font))
3987 {
3988 int fontset = fs_query_fontset (font, 0);
3989 Lisp_Object name = font;
3990 if (fontset >= 0)
3991 font = fontset_ascii (fontset);
3992 font = font_spec_from_name (name);
3993 if (! FONTP (font))
3994 signal_error ("Invalid font name", name);
3995 }
3996 else if (! FONTP (font))
3997 signal_error ("Invalid font object", font);
3998
b1868a1a 3999 val = AREF (font, FONT_FAMILY_INDEX);
5989ba2f
CY		 4000 if (! NILP (val))
4001 {
4002 plist[n++] = QCfamily;
4003 plist[n++] = SYMBOL_NAME (val);
4004 }
b1868a1a 4005
b1868a1a
CY		 4006 val = AREF (font, FONT_SIZE_INDEX);
4007 if (INTEGERP (val))
4008 {
4009 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
4010 int dpi = INTEGERP (font_dpi) ? XINT (font_dpi) : f->resy;
5989ba2f 4011 plist[n++] = QCheight;
c3bb5465 4012 plist[n++] = make_number (PIXEL_TO_POINT (XINT (val) * 10, dpi));
b1868a1a
CY		 4013 }
4014 else if (FLOATP (val))
5989ba2f
CY		 4015 {
4016 plist[n++] = QCheight;
4017 plist[n++] = make_number (10 * (int) XFLOAT_DATA (val));
4018 }
b1868a1a 4019
b1868a1a 4020 val = FONT_WEIGHT_FOR_FACE (font);
5989ba2f
CY		 4021 if (! NILP (val))
4022 {
4023 plist[n++] = QCweight;
4024 plist[n++] = val;
4025 }
b1868a1a 4026
b1868a1a 4027 val = FONT_SLANT_FOR_FACE (font);
5989ba2f
CY		 4028 if (! NILP (val))
4029 {
4030 plist[n++] = QCslant;
4031 plist[n++] = val;
4032 }
b1868a1a 4033
b1868a1a 4034 val = FONT_WIDTH_FOR_FACE (font);
5989ba2f
CY		 4035 if (! NILP (val))
4036 {
4037 plist[n++] = QCwidth;
4038 plist[n++] = val;
4039 }
b1868a1a 4040
5989ba2f 4041 return Flist (n, plist);
b1868a1a 4042}
c2f5bfd6 4043
51cf11be
AS		 4044#endif
4045
c2f5bfd6 4046DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
51c01100 4047 doc: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
c2f5bfd6
KH		 4048 (font_spec, prop, val)
4049 Lisp_Object font_spec, prop, val;
4050{
35027d0c 4051 int idx;
c2f5bfd6
KH		 4052
4053 CHECK_FONT_SPEC (font_spec);
35027d0c
KH		 4054 idx = get_font_prop_index (prop);
4055 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
69eb9e8b 4056 ASET (font_spec, idx, font_prop_validate (idx, Qnil, val));
c2f5bfd6 4057 else
35027d0c 4058 font_put_extra (font_spec, prop, font_prop_validate (0, prop, val));
c2f5bfd6
KH		 4059 return val;
4060}
4061
4062DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
4063 doc: /* List available fonts matching FONT-SPEC on the current frame.
4064Optional 2nd argument FRAME specifies the target frame.
4065Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
45eb10fb
KH		 4066Optional 4th argument PREFER, if non-nil, is a font-spec to
4067control the order of the returned list. Fonts are sorted by
027a33c0 4068how close they are to PREFER. */)
c2f5bfd6
KH		 4069 (font_spec, frame, num, prefer)
4070 Lisp_Object font_spec, frame, num, prefer;
4071{
4072 Lisp_Object vec, list, tail;
4073 int n = 0, i, len;
4074
4075 if (NILP (frame))
4076 frame = selected_frame;
4077 CHECK_LIVE_FRAME (frame);
35027d0c 4078 CHECK_FONT_SPEC (font_spec);
c2f5bfd6
KH		 4079 if (! NILP (num))
4080 {
4081 CHECK_NUMBER (num);
4082 n = XINT (num);
4083 if (n <= 0)
4084 return Qnil;
4085 }
4086 if (! NILP (prefer))
35027d0c 4087 CHECK_FONT_SPEC (prefer);
c2f5bfd6
KH		 4088
4089 vec = font_list_entities (frame, font_spec);
4090 len = ASIZE (vec);
4091 if (len == 0)
4092 return Qnil;
4093 if (len == 1)
4094 return Fcons (AREF (vec, 0), Qnil);
4095
4096 if (! NILP (prefer))
7181ea6a 4097 vec = font_sort_entites (vec, prefer, frame, 0);
c2f5bfd6
KH		 4098
4099 list = tail = Fcons (AREF (vec, 0), Qnil);
4100 if (n == 0 || n > len)
4101 n = len;
4102 for (i = 1; i < n; i++)
4103 {
4104 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
4105
4106 XSETCDR (tail, val);
4107 tail = val;
4108 }
4109 return list;
4110}
4111
35027d0c 4112DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
c2f5bfd6 4113 doc: /* List available font families on the current frame.
027a33c0 4114Optional argument FRAME, if non-nil, specifies the target frame. */)
c2f5bfd6
KH		 4115 (frame)
4116 Lisp_Object frame;
4117{
4118 FRAME_PTR f;
4119 struct font_driver_list *driver_list;
4120 Lisp_Object list;
4121
4122 if (NILP (frame))
4123 frame = selected_frame;
4124 CHECK_LIVE_FRAME (frame);
4125 f = XFRAME (frame);
4126 list = Qnil;
4127 for (driver_list = f->font_driver_list; driver_list;
4128 driver_list = driver_list->next)
4129 if (driver_list->driver->list_family)
4130 {
4131 Lisp_Object val = driver_list->driver->list_family (frame);
4132
4133 if (NILP (list))
4134 list = val;
4135 else
4136 {
4137 Lisp_Object tail = list;
4138
4139 for (; CONSP (val); val = XCDR (val))
4140 if (NILP (Fmemq (XCAR (val), tail)))
4141 list = Fcons (XCAR (val), list);
4142 }
4143 }
4144 return list;
4145}
4146
4147DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
4148 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
4149Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4150 (font_spec, frame)
4151 Lisp_Object font_spec, frame;
4152{
4153 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
4154
4155 if (CONSP (val))
4156 val = XCAR (val);
4157 return val;
4158}
4159
d0ab1ebe 4160DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
c2f5bfd6
KH		 4161 doc: /* Return XLFD name of FONT.
4162FONT is a font-spec, font-entity, or font-object.
d0ab1ebe
KH		 4163If the name is too long for XLFD (maximum 255 chars), return nil.
4164If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4165the consecutive wildcards are folded to one. */)
4166 (font, fold_wildcards)
4167 Lisp_Object font, fold_wildcards;
c2f5bfd6
KH		 4168{
4169 char name[256];
4170 int pixel_size = 0;
4171
35027d0c
KH		 4172 CHECK_FONT (font);
4173
4174 if (FONT_OBJECT_P (font))
c2f5bfd6 4175 {
35027d0c 4176 Lisp_Object font_name = AREF (font, FONT_NAME_INDEX);
c2f5bfd6 4177
35027d0c
KH		 4178 if (STRINGP (font_name)
4179 && SDATA (font_name)[0] == '-')
d0ab1ebe
KH		 4180 {
4181 if (NILP (fold_wildcards))
4182 return font_name;
4183 strcpy (name, (char *) SDATA (font_name));
4184 goto done;
4185 }
35027d0c 4186 pixel_size = XFONT_OBJECT (font)->pixel_size;
c2f5bfd6 4187 }
c2f5bfd6
KH		 4188 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
4189 return Qnil;
d0ab1ebe
KH		 4190 done:
4191 if (! NILP (fold_wildcards))
4192 {
4193 char *p0 = name, *p1;
4194
4195 while ((p1 = strstr (p0, "-*-*")))
4196 {
4197 strcpy (p1, p1 + 2);
4198 p0 = p1;
4199 }
4200 }
4201
c2f5bfd6
KH		 4202 return build_string (name);
4203}
4204
4205DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
4206 doc: /* Clear font cache. */)
4207 ()
4208{
4209 Lisp_Object list, frame;
4210
4211 FOR_EACH_FRAME (list, frame)
4212 {
4213 FRAME_PTR f = XFRAME (frame);
4214 struct font_driver_list *driver_list = f->font_driver_list;
4215
4216 for (; driver_list; driver_list = driver_list->next)
417a1b10
KH		 4217 if (driver_list->on)
4218 {
ca4da08a
KH		 4219 Lisp_Object cache = driver_list->driver->get_cache (f);
4220 Lisp_Object val;
51c01100 4221
ca4da08a 4222 val = XCDR (cache);
43c0454d
KH		 4223 while (! NILP (val)
4224 && ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
ca4da08a 4225 val = XCDR (val);
d0ab1ebe 4226 font_assert (! NILP (val));
ca4da08a
KH		 4227 val = XCDR (XCAR (val));
4228 if (XINT (XCAR (val)) == 0)
417a1b10 4229 {
ca4da08a
KH		 4230 font_clear_cache (f, XCAR (val), driver_list->driver);
4231 XSETCDR (cache, XCDR (val));
417a1b10 4232 }
417a1b10 4233 }
c2f5bfd6
KH		 4234 }
4235
4236 return Qnil;
4237}
4238
071132a9
KH		 4239\f
4240void
4241font_fill_lglyph_metrics (glyph, font_object)
4242 Lisp_Object glyph, font_object;
c2f5bfd6 4243{
071132a9 4244 struct font *font = XFONT_OBJECT (font_object);
f62ab7c5
EZ		 4245 unsigned code;
4246 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4247 EMACS_INT ecode = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
071132a9 4248 struct font_metrics metrics;
c2f5bfd6 4249
f62ab7c5
EZ		 4250 LGLYPH_SET_CODE (glyph, ecode);
4251 code = ecode;
071132a9
KH		 4252 font->driver->text_extents (font, &code, 1, &metrics);
4253 LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
4254 LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
4255 LGLYPH_SET_WIDTH (glyph, metrics.width);
4256 LGLYPH_SET_ASCENT (glyph, metrics.ascent);
4257 LGLYPH_SET_DESCENT (glyph, metrics.descent);
c2f5bfd6
KH		 4258}
4259
c2f5bfd6 4260
071132a9
KH		 4261DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0,
4262 doc: /* Shape the glyph-string GSTRING.
4263Shaping means substituting glyphs and/or adjusting positions of glyphs
4264to get the correct visual image of character sequences set in the
4265header of the glyph-string.
1701724c 4266
071132a9
KH		 4267If the shaping was successful, the value is GSTRING itself or a newly
4268created glyph-string. Otherwise, the value is nil. */)
4269 (gstring)
4270 Lisp_Object gstring;
1701724c
KH		 4271{
4272 struct font *font;
071132a9 4273 Lisp_Object font_object, n, glyph;
fc3a285e 4274 int i, j, from, to;
071132a9
KH		 4275
4276 if (! composition_gstring_p (gstring))
4277 signal_error ("Invalid glyph-string: ", gstring);
4278 if (! NILP (LGSTRING_ID (gstring)))
4279 return gstring;
4280 font_object = LGSTRING_FONT (gstring);
4281 CHECK_FONT_OBJECT (font_object);
35027d0c 4282 font = XFONT_OBJECT (font_object);
b876ea91
KH		 4283 if (! font->driver->shape)
4284 return Qnil;
4285
40fb53d6
KH		 4286 /* Try at most three times with larger gstring each time. */
4287 for (i = 0; i < 3; i++)
4288 {
40fb53d6
KH		 4289 n = font->driver->shape (gstring);
4290 if (INTEGERP (n))
4291 break;
071132a9
KH		 4292 gstring = larger_vector (gstring,
4293 ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
4294 Qnil);
40fb53d6 4295 }
071132a9 4296 if (i == 3 || XINT (n) == 0)
1701724c 4297 return Qnil;
071132a9
KH		 4298
4299 glyph = LGSTRING_GLYPH (gstring, 0);
fc3a285e
KH		 4300 from = LGLYPH_FROM (glyph);
4301 to = LGLYPH_TO (glyph);
4302 for (i = 1, j = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
071132a9
KH		 4303 {
4304 Lisp_Object this = LGSTRING_GLYPH (gstring, i);
10d16101 4305
071132a9
KH		 4306 if (NILP (this))
4307 break;
4308 if (NILP (LGLYPH_ADJUSTMENT (this)))
fc3a285e
KH		 4309 {
4310 if (j < i - 1)
4311 for (; j < i; j++)
4312 {
4313 glyph = LGSTRING_GLYPH (gstring, j);
4314 LGLYPH_SET_FROM (glyph, from);
4315 LGLYPH_SET_TO (glyph, to);
4316 }
4317 from = LGLYPH_FROM (this);
4318 to = LGLYPH_TO (this);
4319 j = i;
4320 }
071132a9 4321 else
b2937119 4322 {
fc3a285e
KH		 4323 if (from > LGLYPH_FROM (this))
4324 from = LGLYPH_FROM (this);
4325 if (to < LGLYPH_TO (this))
4326 to = LGLYPH_TO (this);
b2937119 4327 }
10d16101 4328 }
fc3a285e
KH		 4329 if (j < i - 1)
4330 for (; j < i; j++)
4331 {
4332 glyph = LGSTRING_GLYPH (gstring, j);
4333 LGLYPH_SET_FROM (glyph, from);
4334 LGLYPH_SET_TO (glyph, to);
4335 }
071132a9 4336 return composition_gstring_put_cache (gstring, XINT (n));
c2f5bfd6
KH		 4337}
4338
6a3dadd2
KH		 4339#if 0
4340
733fd013
KH		 4341DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
4342 doc: /* Apply OpenType features on glyph-string GSTRING-IN.
51c01100 4343OTF-FEATURES specifies which features to apply in this format:
733fd013 4344 (SCRIPT LANGSYS GSUB GPOS)
e80e09b4
KH		 4345where
4346 SCRIPT is a symbol specifying a script tag of OpenType,
4347 LANGSYS is a symbol specifying a langsys tag of OpenType,
733fd013 4348 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
e80e09b4
KH		 4349
4350If LANGYS is nil, the default langsys is selected.
4351
51c01100
JB		 4352The features are applied in the order they appear in the list. The
4353symbol `*' means to apply all available features not present in this
733fd013
KH		 4354list, and the remaining features are ignored. For instance, (vatu
4355pstf * haln) is to apply vatu and pstf in this order, then to apply
4356all available features other than vatu, pstf, and haln.
e80e09b4
KH		 4357
4358The features are applied to the glyphs in the range FROM and TO of
733fd013 4359the glyph-string GSTRING-IN.
e80e09b4 4360
51c01100 4361If some feature is actually applicable, the resulting glyphs are
e80e09b4
KH		 4362produced in the glyph-string GSTRING-OUT from the index INDEX. In
4363this case, the value is the number of produced glyphs.
4364
4365If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4366the value is 0.
4367
51c01100 4368If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
e80e09b4
KH		 4369produced in GSTRING-OUT, and the value is nil.
4370
4371See the documentation of `font-make-gstring' for the format of
4372glyph-string. */)
733fd013
KH		 4373 (otf_features, gstring_in, from, to, gstring_out, index)
4374 Lisp_Object otf_features, gstring_in, from, to, gstring_out, index;
e80e09b4
KH		 4375{
4376 Lisp_Object font_object = LGSTRING_FONT (gstring_in);
733fd013
KH		 4377 Lisp_Object val;
4378 struct font *font;
e80e09b4
KH		 4379 int len, num;
4380
733fd013 4381 check_otf_features (otf_features);
35027d0c
KH		 4382 CHECK_FONT_OBJECT (font_object);
4383 font = XFONT_OBJECT (font_object);
733fd013 4384 if (! font->driver->otf_drive)
e80e09b4
KH		 4385 error ("Font backend %s can't drive OpenType GSUB table",
4386 SDATA (SYMBOL_NAME (font->driver->type)));
733fd013
KH		 4387 CHECK_CONS (otf_features);
4388 CHECK_SYMBOL (XCAR (otf_features));
4389 val = XCDR (otf_features);
4390 CHECK_SYMBOL (XCAR (val));
4391 val = XCDR (otf_features);
4392 if (! NILP (val))
4393 CHECK_CONS (val);
e80e09b4
KH		 4394 len = check_gstring (gstring_in);
4395 CHECK_VECTOR (gstring_out);
4396 CHECK_NATNUM (from);
4397 CHECK_NATNUM (to);
4398 CHECK_NATNUM (index);
4399
4400 if (XINT (from) >= XINT (to) || XINT (to) > len)
4401 args_out_of_range_3 (from, to, make_number (len));
4402 if (XINT (index) >= ASIZE (gstring_out))
4403 args_out_of_range (index, make_number (ASIZE (gstring_out)));
733fd013
KH		 4404 num = font->driver->otf_drive (font, otf_features,
4405 gstring_in, XINT (from), XINT (to),
4406 gstring_out, XINT (index), 0);
e80e09b4
KH		 4407 if (num < 0)
4408 return Qnil;
4409 return make_number (num);
4410}
4411
e80e09b4
KH		 4412DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
4413 3, 3, 0,
4414 doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
51c01100 4415OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
e80e09b4
KH		 4416in this format:
4417 (SCRIPT LANGSYS FEATURE ...)
027a33c0 4418See the documentation of `font-drive-otf' for more detail.
e80e09b4
KH		 4419
4420The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4421where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4422character code corresponding to the glyph or nil if there's no
4423corresponding character. */)
733fd013
KH		 4424 (font_object, character, otf_features)
4425 Lisp_Object font_object, character, otf_features;
e80e09b4
KH		 4426{
4427 struct font *font;
4428 Lisp_Object gstring_in, gstring_out, g;
4429 Lisp_Object alternates;
4430 int i, num;
4431
4432 CHECK_FONT_GET_OBJECT (font_object, font);
733fd013 4433 if (! font->driver->otf_drive)
e950d6f1
KH		 4434 error ("Font backend %s can't drive OpenType GSUB table",
4435 SDATA (SYMBOL_NAME (font->driver->type)));
e80e09b4 4436 CHECK_CHARACTER (character);
733fd013 4437 CHECK_CONS (otf_features);
e80e09b4
KH		 4438
4439 gstring_in = Ffont_make_gstring (font_object, make_number (1));
4440 g = LGSTRING_GLYPH (gstring_in, 0);
f9ffa1ea 4441 LGLYPH_SET_CHAR (g, XINT (character));
e80e09b4 4442 gstring_out = Ffont_make_gstring (font_object, make_number (10));
733fd013
KH		 4443 while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
4444 gstring_out, 0, 1)) < 0)
e80e09b4
KH		 4445 gstring_out = Ffont_make_gstring (font_object,
4446 make_number (ASIZE (gstring_out) * 2));
4447 alternates = Qnil;
4448 for (i = 0; i < num; i++)
4449 {
4450 Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
f9ffa1ea
SM		 4451 int c = LGLYPH_CHAR (g);
4452 unsigned code = LGLYPH_CODE (g);
e80e09b4
KH		 4453
4454 alternates = Fcons (Fcons (make_number (code),
4455 c > 0 ? make_number (c) : Qnil),
4456 alternates);
4457 }
4458 return Fnreverse (alternates);
4459}
6a3dadd2 4460#endif /* 0 */
c2f5bfd6
KH		 4461
4462#ifdef FONT_DEBUG
4463
4464DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
4465 doc: /* Open FONT-ENTITY. */)
4466 (font_entity, size, frame)
4467 Lisp_Object font_entity;
4468 Lisp_Object size;
4469 Lisp_Object frame;
4470{
4471 int isize;
4472
4473 CHECK_FONT_ENTITY (font_entity);
c2f5bfd6
KH		 4474 if (NILP (frame))
4475 frame = selected_frame;
4476 CHECK_LIVE_FRAME (frame);
51c01100 4477
35027d0c
KH		 4478 if (NILP (size))
4479 isize = XINT (AREF (font_entity, FONT_SIZE_INDEX));
4480 else
4481 {
4482 CHECK_NUMBER_OR_FLOAT (size);
4483 if (FLOATP (size))
4484 isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
4485 else
4486 isize = XINT (size);
4487 if (isize == 0)
4488 isize = 120;
4489 }
c2f5bfd6
KH		 4490 return font_open_entity (XFRAME (frame), font_entity, isize);
4491}
4492
4493DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
4494 doc: /* Close FONT-OBJECT. */)
4495 (font_object, frame)
4496 Lisp_Object font_object, frame;
4497{
4498 CHECK_FONT_OBJECT (font_object);
4499 if (NILP (frame))
4500 frame = selected_frame;
4501 CHECK_LIVE_FRAME (frame);
4502 font_close_object (XFRAME (frame), font_object);
4503 return Qnil;
4504}
4505
4506DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
e80e09b4
KH		 4507 doc: /* Return information about FONT-OBJECT.
4508The value is a vector:
4509 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
e0708580 4510 CAPABILITY ]
e80e09b4
KH		 4511
4512NAME is a string of the font name (or nil if the font backend doesn't
4513provide a name).
4514
4515FILENAME is a string of the font file (or nil if the font backend
4516doesn't provide a file name).
4517
4518PIXEL-SIZE is a pixel size by which the font is opened.
4519
027a33c0 4520SIZE is a maximum advance width of the font in pixels.
e80e09b4
KH		 4521
4522ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
027a33c0 4523pixels.
e80e09b4 4524
e0708580
KH		 4525CAPABILITY is a list whose first element is a symbol representing the
4526font format \(x, opentype, truetype, type1, pcf, or bdf) and the
027a33c0 4527remaining elements describe the details of the font capability.
e0708580
KH		 4528
4529If the font is OpenType font, the form of the list is
4530 \(opentype GSUB GPOS)
4531where GSUB shows which "GSUB" features the font supports, and GPOS
4532shows which "GPOS" features the font supports. Both GSUB and GPOS are
4533lists of the format:
4534 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4535
4536If the font is not OpenType font, currently the length of the form is
4537one.
e80e09b4
KH		 4538
4539SCRIPT is a symbol representing OpenType script tag.
4540
4541LANGSYS is a symbol representing OpenType langsys tag, or nil
4542representing the default langsys.
4543
51c01100 4544FEATURE is a symbol representing OpenType feature tag.
e80e09b4 4545
51c01100 4546If the font is not OpenType font, CAPABILITY is nil. */)
c2f5bfd6
KH		 4547 (font_object)
4548 Lisp_Object font_object;
4549{
4550 struct font *font;
4551 Lisp_Object val;
4552
4553 CHECK_FONT_GET_OBJECT (font_object, font);
4554
4555 val = Fmake_vector (make_number (9), Qnil);
35027d0c
KH		 4556 ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
4557 ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
c2f5bfd6 4558 ASET (val, 2, make_number (font->pixel_size));
35027d0c 4559 ASET (val, 3, make_number (font->max_width));
c2f5bfd6
KH		 4560 ASET (val, 4, make_number (font->ascent));
4561 ASET (val, 5, make_number (font->descent));
35027d0c
KH		 4562 ASET (val, 6, make_number (font->space_width));
4563 ASET (val, 7, make_number (font->average_width));
c2f5bfd6 4564 if (font->driver->otf_capability)
e0708580 4565 ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
c2f5bfd6
KH		 4566 return val;
4567}
4568
4569DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
4570 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4571Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4572 (font_object, string)
4573 Lisp_Object font_object, string;
4574{
4575 struct font *font;
4576 int i, len;
4577 Lisp_Object vec;
4578
4579 CHECK_FONT_GET_OBJECT (font_object, font);
4580 CHECK_STRING (string);
4581 len = SCHARS (string);
4582 vec = Fmake_vector (make_number (len), Qnil);
4583 for (i = 0; i < len; i++)
4584 {
4585 Lisp_Object ch = Faref (string, make_number (i));
4586 Lisp_Object val;
4587 int c = XINT (ch);
4588 unsigned code;
2930d117 4589 EMACS_INT cod;
c2f5bfd6
KH		 4590 struct font_metrics metrics;
4591
2930d117 4592 cod = code = font->driver->encode_char (font, c);
c2f5bfd6
KH		 4593 if (code == FONT_INVALID_CODE)
4594 continue;
4595 val = Fmake_vector (make_number (6), Qnil);
2930d117 4596 if (cod <= MOST_POSITIVE_FIXNUM)
c2f5bfd6
KH		 4597 ASET (val, 0, make_number (code));
4598 else
4599 ASET (val, 0, Fcons (make_number (code >> 16),
4600 make_number (code & 0xFFFF)));
51c01100 4601 font->driver->text_extents (font, &code, 1, &metrics);
c2f5bfd6
KH		 4602 ASET (val, 1, make_number (metrics.lbearing));
4603 ASET (val, 2, make_number (metrics.rbearing));
4604 ASET (val, 3, make_number (metrics.width));
4605 ASET (val, 4, make_number (metrics.ascent));
4606 ASET (val, 5, make_number (metrics.descent));
4607 ASET (vec, i, val);
4608 }
4609 return vec;
4610}
4611
ec6fe57c 4612DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
67b5d7de 4613 doc: /* Return t if and only if font-spec SPEC matches with FONT.
ec6fe57c
KH		 4614FONT is a font-spec, font-entity, or font-object. */)
4615 (spec, font)
4616 Lisp_Object spec, font;
4617{
4618 CHECK_FONT_SPEC (spec);
35027d0c 4619 CHECK_FONT (font);
ec6fe57c
KH		 4620
4621 return (font_match_p (spec, font) ? Qt : Qnil);
4622}
4623
1701724c 4624DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
51c01100 4625 doc: /* Return a font-object for displaying a character at POSITION.
10d16101
KH		 4626Optional second arg WINDOW, if non-nil, is a window displaying
4627the current buffer. It defaults to the currently selected window. */)
1701724c
KH		 4628 (position, window, string)
4629 Lisp_Object position, window, string;
10d16101
KH		 4630{
4631 struct window *w;
e3ee0340 4632 EMACS_INT pos;
10d16101 4633
1701724c
KH		 4634 if (NILP (string))
4635 {
4636 CHECK_NUMBER_COERCE_MARKER (position);
4637 pos = XINT (position);
4638 if (pos < BEGV || pos >= ZV)
4639 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1701724c
KH		 4640 }
4641 else
4642 {
1701724c
KH		 4643 CHECK_NUMBER (position);
4644 CHECK_STRING (string);
4645 pos = XINT (position);
4646 if (pos < 0 || pos >= SCHARS (string))
4647 args_out_of_range (string, position);
1701724c 4648 }
10d16101
KH		 4649 if (NILP (window))
4650 window = selected_window;
4651 CHECK_LIVE_WINDOW (window);
40fb53d6 4652 w = XWINDOW (window);
10d16101 4653
40fb53d6 4654 return font_at (-1, pos, NULL, w, string);
10d16101
KH		 4655}
4656
c2f5bfd6
KH		 4657#if 0
4658DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
4659 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4660The value is a number of glyphs drawn.
4661Type C-l to recover what previously shown. */)
4662 (font_object, string)
4663 Lisp_Object font_object, string;
4664{
4665 Lisp_Object frame = selected_frame;
4666 FRAME_PTR f = XFRAME (frame);
4667 struct font *font;
4668 struct face *face;
4669 int i, len, width;
4670 unsigned *code;
4671
4672 CHECK_FONT_GET_OBJECT (font_object, font);
4673 CHECK_STRING (string);
4674 len = SCHARS (string);
4675 code = alloca (sizeof (unsigned) * len);
4676 for (i = 0; i < len; i++)
4677 {
4678 Lisp_Object ch = Faref (string, make_number (i));
4679 Lisp_Object val;
4680 int c = XINT (ch);
4681
4682 code[i] = font->driver->encode_char (font, c);
4683 if (code[i] == FONT_INVALID_CODE)
4684 break;
4685 }
4686 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4687 face->fontp = font;
4688 if (font->driver->prepare_face)
4689 font->driver->prepare_face (f, face);
4690 width = font->driver->text_extents (font, code, i, NULL);
4691 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
4692 if (font->driver->done_face)
4693 font->driver->done_face (f, face);
4694 face->fontp = NULL;
4695 return make_number (len);
4696}
4697#endif
4698
4699#endif /* FONT_DEBUG */
4700
a266686a
KH		 4701#ifdef HAVE_WINDOW_SYSTEM
4702
72606e45
KH		 4703DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
4704 doc: /* Return information about a font named NAME on frame FRAME.
4705If FRAME is omitted or nil, use the selected frame.
4706The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4707 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4708where
4709 OPENED-NAME is the name used for opening the font,
4710 FULL-NAME is the full name of the font,
4711 SIZE is the maximum bound width of the font,
4712 HEIGHT is the height of the font,
4713 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4714 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4715 how to compose characters.
4716If the named font is not yet loaded, return nil. */)
4717 (name, frame)
4718 Lisp_Object name, frame;
4719{
4720 FRAME_PTR f;
4721 struct font *font;
4722 Lisp_Object info;
4723 Lisp_Object font_object;
4724
4725 (*check_window_system_func) ();
4726
4727 if (! FONTP (name))
4728 CHECK_STRING (name);
4729 if (NILP (frame))
4730 frame = selected_frame;
4731 CHECK_LIVE_FRAME (frame);
4732 f = XFRAME (frame);
4733
4734 if (STRINGP (name))
4735 {
4736 int fontset = fs_query_fontset (name, 0);
4737
4738 if (fontset >= 0)
4739 name = fontset_ascii (fontset);
4740 font_object = font_open_by_name (f, (char *) SDATA (name));
4741 }
4742 else if (FONT_OBJECT_P (name))
4743 font_object = name;
4744 else if (FONT_ENTITY_P (name))
4745 font_object = font_open_entity (f, name, 0);
4746 else
4747 {
4748 struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4749 Lisp_Object entity = font_matching_entity (f, face->lface, name);
4750
4751 font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
4752 }
4753 if (NILP (font_object))
4754 return Qnil;
4755 font = XFONT_OBJECT (font_object);
4756
4757 info = Fmake_vector (make_number (7), Qnil);
4758 XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
4759 XVECTOR (info)->contents[1] = AREF (font_object, FONT_NAME_INDEX);
4760 XVECTOR (info)->contents[2] = make_number (font->pixel_size);
4761 XVECTOR (info)->contents[3] = make_number (font->height);
4762 XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
4763 XVECTOR (info)->contents[5] = make_number (font->relative_compose);
4764 XVECTOR (info)->contents[6] = make_number (font->default_ascent);
4765
4766#if 0
4767 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4768 close it now. Perhaps, we should manage font-objects
4769 by `reference-count'. */
4770 font_close_object (f, font_object);
4771#endif
4772 return info;
4773}
a266686a 4774#endif
72606e45 4775
c2f5bfd6 4776\f
d0ab1ebe
KH		 4777#define BUILD_STYLE_TABLE(TBL) \
4778 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4779
4780static Lisp_Object
4781build_style_table (entry, nelement)
4782 struct table_entry *entry;
4783 int nelement;
4784{
4785 int i, j;
4786 Lisp_Object table, elt;
17ab8f5d 4787
d0ab1ebe
KH		 4788 table = Fmake_vector (make_number (nelement), Qnil);
4789 for (i = 0; i < nelement; i++)
4790 {
4791 for (j = 0; entry[i].names[j]; j++);
4792 elt = Fmake_vector (make_number (j + 1), Qnil);
4793 ASET (elt, 0, make_number (entry[i].numeric));
4794 for (j = 0; entry[i].names[j]; j++)
17ab8f5d 4795 ASET (elt, j + 1, intern (entry[i].names[j]));
d0ab1ebe
KH		 4796 ASET (table, i, elt);
4797 }
4798 return table;
4799}
4800
4801static Lisp_Object Vfont_log;
4802static int font_log_env_checked;
4803
d0818984
KH		 4804/* The deferred font-log data of the form [ACTION ARG RESULT].
4805 If ACTION is not nil, that is added to the log when font_add_log is
4806 called next time. At that time, ACTION is set back to nil. */
4807static Lisp_Object Vfont_log_deferred;
4808
4809/* Prepend the font-related logging data in Vfont_log if it is not
4810 `t'. ACTION describes a kind of font-related action (e.g. listing,
4811 opening), ARG is the argument for the action, and RESULT is the
4812 result of the action. */
d0ab1ebe
KH		 4813void
4814font_add_log (action, arg, result)
4815 char *action;
4816 Lisp_Object arg, result;
4817{
4818 Lisp_Object tail, val;
4819 int i;
4820
4821 if (! font_log_env_checked)
4822 {
4823 Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
4824 font_log_env_checked = 1;
4825 }
4826 if (EQ (Vfont_log, Qt))
4827 return;
d0818984
KH		 4828 if (STRINGP (AREF (Vfont_log_deferred, 0)))
4829 {
071132a9 4830 char *str = (char *) SDATA (AREF (Vfont_log_deferred, 0));
d0818984
KH		 4831
4832 ASET (Vfont_log_deferred, 0, Qnil);
4833 font_add_log (str, AREF (Vfont_log_deferred, 1),
4834 AREF (Vfont_log_deferred, 2));
4835 }
4836
d0ab1ebe 4837 if (FONTP (arg))
db716644
KH		 4838 {
4839 Lisp_Object tail, elt;
4840 Lisp_Object equalstr = build_string ("=");
4841
4842 val = Ffont_xlfd_name (arg, Qt);
4843 for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
4844 tail = XCDR (tail))
4845 {
4846 elt = XCAR (tail);
49f9c344
KH		 4847 if (EQ (XCAR (elt), QCscript)
4848 && SYMBOLP (XCDR (elt)))
db716644
KH		 4849 val = concat3 (val, SYMBOL_NAME (QCscript),
4850 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
49f9c344
KH		 4851 else if (EQ (XCAR (elt), QClang)
4852 && SYMBOLP (XCDR (elt)))
db716644
KH		 4853 val = concat3 (val, SYMBOL_NAME (QClang),
4854 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
49f9c344
KH		 4855 else if (EQ (XCAR (elt), QCotf)
4856 && CONSP (XCDR (elt)) && SYMBOLP (XCAR (XCDR (elt))))
db716644
KH		 4857 val = concat3 (val, SYMBOL_NAME (QCotf),
4858 concat2 (equalstr,
4859 SYMBOL_NAME (XCAR (XCDR (elt)))));
4860 }
4861 arg = val;
4862 }
d0ab1ebe 4863 if (FONTP (result))
d26424c5
KH		 4864 {
4865 val = Ffont_xlfd_name (result, Qt);
4866 if (! FONT_SPEC_P (result))
4867 val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
4868 build_string (":"), val);
4869 result = val;
4870 }
d0ab1ebe
KH		 4871 else if (CONSP (result))
4872 {
4873 result = Fcopy_sequence (result);
4874 for (tail = result; CONSP (tail); tail = XCDR (tail))
4875 {
4876 val = XCAR (tail);
4877 if (FONTP (val))
4878 val = Ffont_xlfd_name (val, Qt);
4879 XSETCAR (tail, val);
4880 }
4881 }
4882 else if (VECTORP (result))
4883 {
4884 result = Fcopy_sequence (result);
4885 for (i = 0; i < ASIZE (result); i++)
4886 {
4887 val = AREF (result, i);
4888 if (FONTP (val))
4889 val = Ffont_xlfd_name (val, Qt);
4890 ASET (result, i, val);
4891 }
4892 }
4893 Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
4894}
4895
d0818984
KH		 4896/* Record a font-related logging data to be added to Vfont_log when
4897 font_add_log is called next time. ACTION, ARG, RESULT are the same
4898 as font_add_log. */
4899
4900void
4901font_deferred_log (action, arg, result)
4902 char *action;
4903 Lisp_Object arg, result;
4904{
4905 ASET (Vfont_log_deferred, 0, build_string (action));
4906 ASET (Vfont_log_deferred, 1, arg);
4907 ASET (Vfont_log_deferred, 2, result);
4908}
4909
c2f5bfd6
KH		 4910extern void syms_of_ftfont P_ (());
4911extern void syms_of_xfont P_ (());
4912extern void syms_of_xftfont P_ (());
4913extern void syms_of_ftxfont P_ (());
4914extern void syms_of_bdffont P_ (());
4915extern void syms_of_w32font P_ (());
4916extern void syms_of_atmfont P_ (());
edfda783 4917extern void syms_of_nsfont P_ (());
c2f5bfd6
KH		 4918
4919void
4920syms_of_font ()
4921{
4007dd1c
KH		 4922 sort_shift_bits[FONT_TYPE_INDEX] = 0;
4923 sort_shift_bits[FONT_SLANT_INDEX] = 2;
4924 sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
4925 sort_shift_bits[FONT_SIZE_INDEX] = 16;
4926 sort_shift_bits[FONT_WIDTH_INDEX] = 23;
4927 /* Note that the other elements in sort_shift_bits are not used. */
c2f5bfd6 4928
1701724c
KH		 4929 staticpro (&font_charset_alist);
4930 font_charset_alist = Qnil;
4931
35027d0c
KH		 4932 DEFSYM (Qfont_spec, "font-spec");
4933 DEFSYM (Qfont_entity, "font-entity");
4934 DEFSYM (Qfont_object, "font-object");
4935
e0708580 4936 DEFSYM (Qopentype, "opentype");
c2f5bfd6 4937
9e1bb909 4938 DEFSYM (Qascii_0, "ascii-0");
1bb1d99b
KH		 4939 DEFSYM (Qiso8859_1, "iso8859-1");
4940 DEFSYM (Qiso10646_1, "iso10646-1");
4941 DEFSYM (Qunicode_bmp, "unicode-bmp");
cf96c5c2 4942 DEFSYM (Qunicode_sip, "unicode-sip");
1bb1d99b 4943
071132a9
KH		 4944 DEFSYM (QCf, "Cf");
4945
c2f5bfd6 4946 DEFSYM (QCotf, ":otf");
35027d0c 4947 DEFSYM (QClang, ":lang");
c2f5bfd6 4948 DEFSYM (QCscript, ":script");
4c496d0d 4949 DEFSYM (QCantialias, ":antialias");
c2f5bfd6
KH		 4950
4951 DEFSYM (QCfoundry, ":foundry");
4952 DEFSYM (QCadstyle, ":adstyle");
4953 DEFSYM (QCregistry, ":registry");
9331887d
KH		 4954 DEFSYM (QCspacing, ":spacing");
4955 DEFSYM (QCdpi, ":dpi");
ec6fe57c 4956 DEFSYM (QCscalable, ":scalable");
35027d0c
KH		 4957 DEFSYM (QCavgwidth, ":avgwidth");
4958 DEFSYM (QCfont_entity, ":font-entity");
4959 DEFSYM (QCfc_unknown_spec, ":fc-unknown-spec");
c2f5bfd6 4960
ec6fe57c
KH		 4961 DEFSYM (Qc, "c");
4962 DEFSYM (Qm, "m");
4963 DEFSYM (Qp, "p");
4964 DEFSYM (Qd, "d");
4965
c2f5bfd6
KH		 4966 staticpro (&null_vector);
4967 null_vector = Fmake_vector (make_number (0), Qnil);
4968
4969 staticpro (&scratch_font_spec);
4970 scratch_font_spec = Ffont_spec (0, NULL);
4971 staticpro (&scratch_font_prefer);
4972 scratch_font_prefer = Ffont_spec (0, NULL);
4973
d0818984
KH		 4974 staticpro (&Vfont_log_deferred);
4975 Vfont_log_deferred = Fmake_vector (make_number (3), Qnil);
4976
6a3dadd2 4977#if 0
733fd013
KH		 4978#ifdef HAVE_LIBOTF
4979 staticpro (&otf_list);
4980 otf_list = Qnil;
6a3dadd2
KH		 4981#endif /* HAVE_LIBOTF */
4982#endif /* 0 */
733fd013 4983
c2f5bfd6
KH		 4984 defsubr (&Sfontp);
4985 defsubr (&Sfont_spec);
4986 defsubr (&Sfont_get);
51cf11be 4987#ifdef HAVE_WINDOW_SYSTEM
b1868a1a 4988 defsubr (&Sfont_face_attributes);
51cf11be 4989#endif
c2f5bfd6
KH		 4990 defsubr (&Sfont_put);
4991 defsubr (&Slist_fonts);
35027d0c 4992 defsubr (&Sfont_family_list);
c2f5bfd6
KH		 4993 defsubr (&Sfind_font);
4994 defsubr (&Sfont_xlfd_name);
4995 defsubr (&Sclear_font_cache);
071132a9 4996 defsubr (&Sfont_shape_gstring);
6a3dadd2 4997#if 0
733fd013 4998 defsubr (&Sfont_drive_otf);
e80e09b4 4999 defsubr (&Sfont_otf_alternates);
6a3dadd2 5000#endif /* 0 */
c2f5bfd6
KH		 5001
5002#ifdef FONT_DEBUG
5003 defsubr (&Sopen_font);
5004 defsubr (&Sclose_font);
5005 defsubr (&Squery_font);
5006 defsubr (&Sget_font_glyphs);
ec6fe57c 5007 defsubr (&Sfont_match_p);
10d16101 5008 defsubr (&Sfont_at);
c2f5bfd6
KH		 5009#if 0
5010 defsubr (&Sdraw_string);
5011#endif
5012#endif /* FONT_DEBUG */
a266686a 5013#ifdef HAVE_WINDOW_SYSTEM
72606e45 5014 defsubr (&Sfont_info);
a266686a 5015#endif
c2f5bfd6 5016
819e81df
KH		 5017 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
5018 doc: /*
5019Alist of fontname patterns vs the corresponding encoding and repertory info.
5020Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5021where ENCODING is a charset or a char-table,
5022and REPERTORY is a charset, a char-table, or nil.
5023
027a33c0 5024If ENCODING and REPERTORY are the same, the element can have the form
819e81df
KH		 5025\(REGEXP . ENCODING).
5026
5027ENCODING is for converting a character to a glyph code of the font.
5028If ENCODING is a charset, encoding a character by the charset gives
5029the corresponding glyph code. If ENCODING is a char-table, looking up
5030the table by a character gives the corresponding glyph code.
5031
5032REPERTORY specifies a repertory of characters supported by the font.
5033If REPERTORY is a charset, all characters beloging to the charset are
5034supported. If REPERTORY is a char-table, all characters who have a
027a33c0 5035non-nil value in the table are supported. If REPERTORY is nil, Emacs
819e81df
KH		 5036gets the repertory information by an opened font and ENCODING. */);
5037 Vfont_encoding_alist = Qnil;
5038
d0ab1ebe
KH		 5039 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table,
5040 doc: /* Vector of valid font weight values.
5041Each element has the form:
5042 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
17ab8f5d 5043NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
d0ab1ebe
KH		 5044 Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
5045
5046 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table,
5047 doc: /* Vector of font slant symbols vs the corresponding numeric values.
17ab8f5d 5048See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5049 Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
5050
5051 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table,
5052 doc: /* Alist of font width symbols vs the corresponding numeric values.
17ab8f5d 5053See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5054 Vfont_width_table = BUILD_STYLE_TABLE (width_table);
5055
5056 staticpro (&font_style_table);
5057 font_style_table = Fmake_vector (make_number (3), Qnil);
5058 ASET (font_style_table, 0, Vfont_weight_table);
5059 ASET (font_style_table, 1, Vfont_slant_table);
5060 ASET (font_style_table, 2, Vfont_width_table);
5061
5062 DEFVAR_LISP ("font-log", &Vfont_log, doc: /*
5063*Logging list of font related actions and results.
5064The value t means to suppress the logging.
5065The initial value is set to nil if the environment variable
5066EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5067 Vfont_log = Qnil;
5068
819e81df 5069#ifdef HAVE_WINDOW_SYSTEM
c2f5bfd6 5070#ifdef HAVE_FREETYPE
35027d0c 5071 syms_of_ftfont ();
c2f5bfd6 5072#ifdef HAVE_X_WINDOWS
35027d0c
KH		 5073 syms_of_xfont ();
5074 syms_of_ftxfont ();
c2f5bfd6 5075#ifdef HAVE_XFT
35027d0c 5076 syms_of_xftfont ();
c2f5bfd6
KH		 5077#endif /* HAVE_XFT */
5078#endif /* HAVE_X_WINDOWS */
5079#else /* not HAVE_FREETYPE */
5080#ifdef HAVE_X_WINDOWS
35027d0c 5081 syms_of_xfont ();
c2f5bfd6
KH		 5082#endif /* HAVE_X_WINDOWS */
5083#endif /* not HAVE_FREETYPE */
5084#ifdef HAVE_BDFFONT
35027d0c 5085 syms_of_bdffont ();
c2f5bfd6
KH		 5086#endif /* HAVE_BDFFONT */
5087#ifdef WINDOWSNT
35027d0c 5088 syms_of_w32font ();
c2f5bfd6 5089#endif /* WINDOWSNT */
edfda783
AR		 5090#ifdef HAVE_NS
5091 syms_of_nsfont ();
5092#endif /* HAVE_NS */
819e81df 5093#endif /* HAVE_WINDOW_SYSTEM */
c2f5bfd6 5094}
885b7d09
MB		 5095
5096/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5097 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.