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