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