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