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