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