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