HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Don't define CANNOT_DUMP for GNUStep any more.
[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 {
d0ab1ebe
KH		 1847 if ((*p0 != '*' || p1 - p0 > 1)
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
KH		 2180static int font_compare P_ ((const void *, const void *));
2181static Lisp_Object font_sort_entites 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
7181ea6a
KH		 2314font_sort_entites (vec, prefer, frame, best_only)
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);
2641e213 2329 for (i = FONT_WEIGHT_INDEX; i <= FONT_DPI_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
d0ab1ebe 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
KH		 2834 val = (i > 0 ? Fvconcat (i, vec) : null_vector);
2835 font_add_log ("list", spec, val);
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 }
819ab95f 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));
d0ab1ebe 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;
2975 font_add_log ("close", font_object, Qnil);
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
c9477f01 3225 return font_sort_entites (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);
35027d0c
KH		 3275 XSETFRAME (frame, f);
3276 size = AREF (spec, FONT_SIZE_INDEX);
1d1e1245
KH		 3277 pixel_size = font_pixel_size (f, spec);
3278 if (pixel_size == 0)
3279 {
3280 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
3281
3282 pixel_size = POINT_TO_PIXEL (pt / 10, f->resy);
3283 }
4007dd1c
KH		 3284 ASET (work, FONT_SIZE_INDEX, Qnil);
3285 foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
3286 if (! NILP (foundry[0]))
3287 foundry[1] = null_vector;
3288 else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
3289 {
071132a9
KH		 3290 val = attrs[LFACE_FOUNDRY_INDEX];
3291 foundry[0] = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
4007dd1c
KH		 3292 foundry[1] = Qnil;
3293 foundry[2] = null_vector;
3294 }
3295 else
3296 foundry[0] = Qnil, foundry[1] = null_vector;
3297
22459668
KH		 3298 adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
3299 if (! NILP (adstyle[0]))
3300 adstyle[1] = null_vector;
3301 else if (FONTP (attrs[LFACE_FONT_INDEX]))
3302 {
3303 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3304
3305 if (! NILP (AREF (face_font, FONT_ADSTYLE_INDEX)))
3306 {
3307 adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
3308 adstyle[1] = Qnil;
3309 adstyle[2] = null_vector;
3310 }
3311 else
3312 adstyle[0] = Qnil, adstyle[1] = null_vector;
3313 }
3314 else
3315 adstyle[0] = Qnil, adstyle[1] = null_vector;
3316
3317
4007dd1c
KH		 3318 val = AREF (work, FONT_FAMILY_INDEX);
3319 if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
071132a9
KH		 3320 {
3321 val = attrs[LFACE_FAMILY_INDEX];
3322 val = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
3323 }
4007dd1c
KH		 3324 if (NILP (val))
3325 {
3326 family = alloca ((sizeof family[0]) * 2);
3327 family[0] = Qnil;
3328 family[1] = null_vector; /* terminator. */
3329 }
3330 else
3331 {
3332 Lisp_Object alters
819ab95f
KH		 3333 = Fassoc_string (val, Vface_alternative_font_family_alist,
3334#ifndef HAVE_NS
3335 Qt
3336#else
3337 Qnil
3338#endif
3339 );
4007dd1c
KH		 3340
3341 if (! NILP (alters))
3342 {
3343 family = alloca ((sizeof family[0]) * (XINT (Flength (alters)) + 2));
3344 for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
3345 family[i] = XCAR (alters);
3346 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3347 family[i++] = Qnil;
3348 family[i] = null_vector;
3349 }
3350 else
3351 {
3352 family = alloca ((sizeof family[0]) * 3);
3353 i = 0;
3354 family[i++] = val;
3355 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3356 family[i++] = Qnil;
3357 family[i] = null_vector;
3358 }
3359 }
3360
d0a47776 3361 for (i = 0; SYMBOLP (family[i]); i++)
4007dd1c 3362 {
d0a47776
KH		 3363 ASET (work, FONT_FAMILY_INDEX, family[i]);
3364 for (j = 0; SYMBOLP (foundry[j]); j++)
4007dd1c 3365 {
d0a47776
KH		 3366 ASET (work, FONT_FOUNDRY_INDEX, foundry[j]);
3367 for (k = 0; SYMBOLP (registry[k]); k++)
3368 {
904a2e0e 3369 ASET (work, FONT_REGISTRY_INDEX, registry[k]);
22459668
KH		 3370 for (l = 0; SYMBOLP (adstyle[l]); l++)
3371 {
3372 ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
3373 entities = font_list_entities (frame, work);
3374 if (ASIZE (entities) > 0)
988a7ddb
KH		 3375 {
3376 val = font_select_entity (frame, entities,
3377 attrs, pixel_size, c);
3378 if (! NILP (val))
3379 return val;
3380 }
22459668 3381 }
d0a47776 3382 }
4007dd1c 3383 }
4007dd1c 3384 }
d0a47776 3385 return Qnil;
1701724c 3386}
45eb10fb
KH		 3387
3388
c2f5bfd6 3389Lisp_Object
35027d0c 3390font_open_for_lface (f, entity, attrs, spec)
c2f5bfd6 3391 FRAME_PTR f;
c2f5bfd6 3392 Lisp_Object entity;
35027d0c 3393 Lisp_Object *attrs;
733fd013 3394 Lisp_Object spec;
c2f5bfd6 3395{
9331887d 3396 int size;
c2f5bfd6 3397
4007dd1c
KH		 3398 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX))
3399 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
3400 size = XINT (AREF (entity, FONT_SIZE_INDEX));
3401 else if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
1d1e1245 3402 size = font_pixel_size (f, spec);
733fd013
KH		 3403 else
3404 {
50b0cd29
CY		 3405 double pt;
3406 if (INTEGERP (attrs[LFACE_HEIGHT_INDEX]))
3407 pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
3408 else
3409 {
3410 struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID);
3411 Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX];
3412 if (INTEGERP (height))
3413 pt = XINT (height);
3414 else
3415 abort(); /* We should never end up here. */
3416 }
733fd013
KH		 3417
3418 pt /= 10;
3419 size = POINT_TO_PIXEL (pt, f->resy);
ed96cde8
AR		 3420#ifdef HAVE_NS
3421 if (size == 0)
3422 {
3423 Lisp_Object ffsize = get_frame_param(f, Qfontsize);
3424 size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
3425 }
3426#endif
733fd013 3427 }
c2f5bfd6
KH		 3428 return font_open_entity (f, entity, size);
3429}
3430
45eb10fb 3431
35027d0c
KH		 3432/* Find a font satisfying SPEC and best matching with face's
3433 attributes in ATTRS on FRAME, and return the opened
3434 font-object. */
45eb10fb 3435
35027d0c
KH		 3436Lisp_Object
3437font_load_for_lface (f, attrs, spec)
c2f5bfd6 3438 FRAME_PTR f;
35027d0c 3439 Lisp_Object *attrs, spec;
c2f5bfd6 3440{
35027d0c 3441 Lisp_Object entity;
ef18374f 3442
908567ef 3443 entity = font_find_for_lface (f, attrs, spec, -1);
35027d0c 3444 if (NILP (entity))
ef18374f 3445 {
35027d0c
KH		 3446 /* No font is listed for SPEC, but each font-backend may have
3447 the different criteria about "font matching". So, try
3448 it. */
3449 entity = font_matching_entity (f, attrs, spec);
3450 if (NILP (entity))
3451 return Qnil;
c2f5bfd6 3452 }
35027d0c 3453 return font_open_for_lface (f, entity, attrs, spec);
c2f5bfd6
KH		 3454}
3455
45eb10fb
KH		 3456
3457/* Make FACE on frame F ready to use the font opened for FACE. */
3458
c2f5bfd6
KH		 3459void
3460font_prepare_for_face (f, face)
3461 FRAME_PTR f;
3462 struct face *face;
3463{
35027d0c
KH		 3464 if (face->font->driver->prepare_face)
3465 face->font->driver->prepare_face (f, face);
c2f5bfd6
KH		 3466}
3467
45eb10fb
KH		 3468
3469/* Make FACE on frame F stop using the font opened for FACE. */
3470
c2f5bfd6
KH		 3471void
3472font_done_for_face (f, face)
3473 FRAME_PTR f;
3474 struct face *face;
3475{
35027d0c
KH		 3476 if (face->font->driver->done_face)
3477 face->font->driver->done_face (f, face);
c2f5bfd6
KH		 3478 face->extra = NULL;
3479}
3480
45eb10fb 3481
c50b7e98
KH		 3482/* Open a font matching with font-spec SPEC on frame F. If no proper
3483 font is found, return Qnil. */
45eb10fb 3484
c2f5bfd6 3485Lisp_Object
c50b7e98 3486font_open_by_spec (f, spec)
c2f5bfd6 3487 FRAME_PTR f;
c50b7e98 3488 Lisp_Object spec;
c2f5bfd6 3489{
c50b7e98 3490 Lisp_Object attrs[LFACE_VECTOR_SIZE];
a9262bb8 3491
4007dd1c
KH		 3492 /* We set up the default font-related attributes of a face to prefer
3493 a moderate font. */
3494 attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
3495 attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
3496 = attrs[LFACE_SLANT_INDEX] = Qnormal;
ed96cde8 3497#ifndef HAVE_NS
4007dd1c 3498 attrs[LFACE_HEIGHT_INDEX] = make_number (120);
ed96cde8
AR		 3499#else
3500 attrs[LFACE_HEIGHT_INDEX] = make_number (0);
3501#endif
4007dd1c
KH		 3502 attrs[LFACE_FONT_INDEX] = Qnil;
3503
3504 return font_load_for_lface (f, attrs, spec);
c2f5bfd6
KH		 3505}
3506
3507
c50b7e98
KH		 3508/* Open a font matching with NAME on frame F. If no proper font is
3509 found, return Qnil. */
3510
3511Lisp_Object
3512font_open_by_name (f, name)
3513 FRAME_PTR f;
3514 char *name;
3515{
3516 Lisp_Object args[2];
3517 Lisp_Object spec;
3518
3519 args[0] = QCname;
3520 args[1] = make_unibyte_string (name, strlen (name));
3521 spec = Ffont_spec (2, args);
3522 return font_open_by_spec (f, spec);
3523}
3524
3525
c2f5bfd6
KH		 3526/* Register font-driver DRIVER. This function is used in two ways.
3527
417a1b10
KH		 3528 The first is with frame F non-NULL. In this case, make DRIVER
3529 available (but not yet activated) on F. All frame creaters
3530 (e.g. Fx_create_frame) must call this function at least once with
3531 an available font-driver.
c2f5bfd6
KH		 3532
3533 The second is with frame F NULL. In this case, DRIVER is globally
3534 registered in the variable `font_driver_list'. All font-driver
3535 implementations must call this function in its syms_of_XXXX
3536 (e.g. syms_of_xfont). */
3537
3538void
3539register_font_driver (driver, f)
3540 struct font_driver *driver;
3541 FRAME_PTR f;
3542{
3543 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
3544 struct font_driver_list *prev, *list;
3545
3546 if (f && ! driver->draw)
43a1d19b 3547 error ("Unusable font driver for a frame: %s",
c2f5bfd6
KH		 3548 SDATA (SYMBOL_NAME (driver->type)));
3549
3550 for (prev = NULL, list = root; list; prev = list, list = list->next)
cf23b845 3551 if (EQ (list->driver->type, driver->type))
c2f5bfd6
KH		 3552 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
3553
c115043b 3554 list = xmalloc (sizeof (struct font_driver_list));
417a1b10 3555 list->on = 0;
c2f5bfd6
KH		 3556 list->driver = driver;
3557 list->next = NULL;
3558 if (prev)
3559 prev->next = list;
3560 else if (f)
3561 f->font_driver_list = list;
3562 else
3563 font_driver_list = list;
72606e45
KH		 3564 if (! f)
3565 num_font_drivers++;
c2f5bfd6
KH		 3566}
3567
2ed98482
CY		 3568void
3569free_font_driver_list (f)
3570 FRAME_PTR f;
3571{
3572 struct font_driver_list *list, *next;
3573
3574 for (list = f->font_driver_list; list; list = next)
3575 {
3576 next = list->next;
3577 xfree (list);
3578 }
3579 f->font_driver_list = NULL;
3580}
3581
45eb10fb 3582
f697fff0 3583/* Make the frame F use font backends listed in NEW_DRIVERS (list of
ca4da08a
KH		 3584 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3585 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
417a1b10 3586
ca4da08a
KH		 3587 A caller must free all realized faces if any in advance. The
3588 return value is a list of font backends actually made used on
3589 F. */
e950d6f1
KH		 3590
3591Lisp_Object
3592font_update_drivers (f, new_drivers)
417a1b10
KH		 3593 FRAME_PTR f;
3594 Lisp_Object new_drivers;
417a1b10
KH		 3595{
3596 Lisp_Object active_drivers = Qnil;
4007dd1c 3597 struct font_driver *driver;
417a1b10
KH		 3598 struct font_driver_list *list;
3599
4007dd1c
KH		 3600 /* At first, turn off non-requested drivers, and turn on requested
3601 drivers. */
f697fff0 3602 for (list = f->font_driver_list; list; list = list->next)
4007dd1c
KH		 3603 {
3604 driver = list->driver;
3605 if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers)))
3606 != list->on)
3607 {
3608 if (list->on)
3609 {
3610 if (driver->end_for_frame)
3611 driver->end_for_frame (f);
3612 font_finish_cache (f, driver);
3613 list->on = 0;
3614 }
3615 else
3616 {
3617 if (! driver->start_for_frame
3618 || driver->start_for_frame (f) == 0)
3619 {
3620 font_prepare_cache (f, driver);
3621 list->on = 1;
3622 }
3623 }
3624 }
3625 }
3626
3627 if (NILP (new_drivers))
3628 return Qnil;
3629
3630 if (! EQ (new_drivers, Qt))
3631 {
3632 /* Re-order the driver list according to new_drivers. */
3306c6dc 3633 struct font_driver_list **list_table, **next;
4007dd1c
KH		 3634 Lisp_Object tail;
3635 int i;
3636
3637 list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
3638 for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
3639 {
3640 for (list = f->font_driver_list; list; list = list->next)
3641 if (list->on && EQ (list->driver->type, XCAR (tail)))
3642 break;
3643 if (list)
3644 list_table[i++] = list;
3645 }
3646 for (list = f->font_driver_list; list; list = list->next)
3647 if (! list->on)
6136b72f 3648 list_table[i++] = list;
4007dd1c
KH		 3649 list_table[i] = NULL;
3650
3306c6dc 3651 next = &f->font_driver_list;
4007dd1c
KH		 3652 for (i = 0; list_table[i]; i++)
3653 {
3306c6dc
AS		 3654 *next = list_table[i];
3655 next = &(*next)->next;
4007dd1c 3656 }
3306c6dc 3657 *next = NULL;
4007dd1c 3658 }
417a1b10 3659
4007dd1c
KH		 3660 for (list = f->font_driver_list; list; list = list->next)
3661 if (list->on)
3662 active_drivers = nconc2 (active_drivers,
3663 Fcons (list->driver->type, Qnil));
e950d6f1 3664 return active_drivers;
417a1b10
KH		 3665}
3666
f697fff0
KH		 3667int
3668font_put_frame_data (f, driver, data)
3669 FRAME_PTR f;
3670 struct font_driver *driver;
3671 void *data;
3672{
3673 struct font_data_list *list, *prev;
3674
3675 for (prev = NULL, list = f->font_data_list; list;
3676 prev = list, list = list->next)
3677 if (list->driver == driver)
3678 break;
3679 if (! data)
3680 {
3681 if (list)
3682 {
3683 if (prev)
3684 prev->next = list->next;
3685 else
3686 f->font_data_list = list->next;
973e7849 3687 xfree (list);
f697fff0
KH		 3688 }
3689 return 0;
3690 }
3691
3692 if (! list)
3693 {
c115043b 3694 list = xmalloc (sizeof (struct font_data_list));
f697fff0
KH		 3695 list->driver = driver;
3696 list->next = f->font_data_list;
3697 f->font_data_list = list;
3698 }
3699 list->data = data;
3700 return 0;
3701}
3702
3703
3704void *
3705font_get_frame_data (f, driver)
3706 FRAME_PTR f;
3707 struct font_driver *driver;
3708{
3709 struct font_data_list *list;
3710
3711 for (list = f->font_data_list; list; list = list->next)
3712 if (list->driver == driver)
3713 break;
3714 if (! list)
3715 return NULL;
3716 return list->data;
3717}
3718
417a1b10 3719
45eb10fb 3720/* Return the font used to draw character C by FACE at buffer position
e3ee0340
KH		 3721 POS in window W. If STRING is non-nil, it is a string containing C
3722 at index POS. If C is negative, get C from the current buffer or
3723 STRING. */
45eb10fb 3724
10d16101 3725Lisp_Object
e3ee0340 3726font_at (c, pos, face, w, string)
10d16101
KH		 3727 int c;
3728 EMACS_INT pos;
3729 struct face *face;
3730 struct window *w;
e3ee0340 3731 Lisp_Object string;
10d16101
KH		 3732{
3733 FRAME_PTR f;
e3ee0340 3734 int multibyte;
35027d0c 3735 Lisp_Object font_object;
e3ee0340 3736
e500c47d
KH		 3737 multibyte = (NILP (string)
3738 ? ! NILP (current_buffer->enable_multibyte_characters)
3739 : STRING_MULTIBYTE (string));
e3ee0340
KH		 3740 if (c < 0)
3741 {
3742 if (NILP (string))
3743 {
e3ee0340
KH		 3744 if (multibyte)
3745 {
3746 EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
3747
3748 c = FETCH_CHAR (pos_byte);
3749 }
3750 else
3751 c = FETCH_BYTE (pos);
3752 }
3753 else
3754 {
3755 unsigned char *str;
3756
3757 multibyte = STRING_MULTIBYTE (string);
3758 if (multibyte)
3759 {
3760 EMACS_INT pos_byte = string_char_to_byte (string, pos);
3761
3762 str = SDATA (string) + pos_byte;
3763 c = STRING_CHAR (str, 0);
3764 }
3765 else
3766 c = SDATA (string)[pos];
3767 }
3768 }
10d16101
KH		 3769
3770 f = XFRAME (w->frame);
1385a806
KH		 3771 if (! FRAME_WINDOW_P (f))
3772 return Qnil;
10d16101
KH		 3773 if (! face)
3774 {
e3ee0340 3775 int face_id;
0f8b27ea 3776 EMACS_INT endptr;
e3ee0340
KH		 3777
3778 if (STRINGP (string))
3779 face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
10d16101
KH		 3780 DEFAULT_FACE_ID, 0);
3781 else
e3ee0340 3782 face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
6970f632 3783 pos + 100, 0, -1);
10d16101
KH		 3784 face = FACE_FROM_ID (f, face_id);
3785 }
e3ee0340
KH		 3786 if (multibyte)
3787 {
3788 int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
3789 face = FACE_FROM_ID (f, face_id);
3790 }
35027d0c 3791 if (! face->font)
10d16101 3792 return Qnil;
35027d0c 3793
35027d0c
KH		 3794 XSETFONT (font_object, face->font);
3795 return font_object;
3796}
3797
3798
071132a9
KH		 3799#ifdef HAVE_WINDOW_SYSTEM
3800
3801/* Check how many characters after POS (at most to *LIMIT) can be
3802 displayed by the same font on the window W. FACE, if non-NULL, is
3803 the face selected for the character at POS. If STRING is not nil,
3804 it is the string to check instead of the current buffer. In that
3805 case, FACE must be not NULL.
027a33c0 3806
071132a9
KH		 3807 The return value is the font-object for the character at POS.
3808 *LIMIT is set to the position where that font can't be used.
35027d0c 3809
071132a9
KH		 3810 It is assured that the current buffer (or STRING) is multibyte. */
3811
3812Lisp_Object
3813font_range (pos, limit, w, face, string)
3814 EMACS_INT pos, *limit;
3815 struct window *w;
35027d0c 3816 struct face *face;
35027d0c
KH		 3817 Lisp_Object string;
3818{
071132a9 3819 EMACS_INT pos_byte, ignore, start, start_byte;
35027d0c 3820 int c;
071132a9 3821 Lisp_Object font_object = Qnil;
35027d0c
KH		 3822
3823 if (NILP (string))
3824 {
35027d0c 3825 pos_byte = CHAR_TO_BYTE (pos);
071132a9
KH		 3826 if (! face)
3827 {
3828 int face_id;
3829
6970f632
CY		 3830 face_id = face_at_buffer_position (w, pos, 0, 0, &ignore,
3831 *limit, 0, -1);
071132a9
KH		 3832 face = FACE_FROM_ID (XFRAME (w->frame), face_id);
3833 }
35027d0c
KH		 3834 }
3835 else
3836 {
071132a9 3837 font_assert (face);
35027d0c
KH		 3838 pos_byte = string_char_to_byte (string, pos);
3839 }
3840
071132a9
KH		 3841 start = pos, start_byte = pos_byte;
3842 while (pos < *limit)
35027d0c 3843 {
071132a9 3844 Lisp_Object category;
35027d0c
KH		 3845
3846 if (NILP (string))
3847 FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
3848 else
3849 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
071132a9 3850 if (NILP (font_object))
35027d0c 3851 {
071132a9
KH		 3852 font_object = font_for_char (face, c, pos - 1, string);
3853 if (NILP (font_object))
3854 return Qnil;
35027d0c
KH		 3855 continue;
3856 }
071132a9
KH		 3857
3858 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3859 if (! EQ (category, QCf)
78a2f9cd 3860 && ! CHAR_VARIATION_SELECTOR_P (c)
071132a9 3861 && font_encode_char (font_object, c) == FONT_INVALID_CODE)
35027d0c 3862 {
071132a9
KH		 3863 Lisp_Object f = font_for_char (face, c, pos - 1, string);
3864 EMACS_INT i, i_byte;
3865
3866
3867 if (NILP (f))
3868 {
3869 *limit = pos - 1;
3870 return font_object;
3871 }
3872 i = start, i_byte = start_byte;
3873 while (i < pos - 1)
3874 {
3875
3876 if (NILP (string))
3877 FETCH_CHAR_ADVANCE_NO_CHECK (c, i, i_byte);
3878 else
3879 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, i, i_byte);
3880 category = CHAR_TABLE_REF (Vunicode_category_table, c);
3881 if (! EQ (category, QCf)
78a2f9cd 3882 && ! CHAR_VARIATION_SELECTOR_P (c)
071132a9
KH		 3883 && font_encode_char (f, c) == FONT_INVALID_CODE)
3884 {
3885 *limit = pos - 1;
3886 return font_object;
3887 }
3888 }
3889 font_object = f;
35027d0c
KH		 3890 }
3891 }
071132a9 3892 return font_object;
10d16101 3893}
071132a9 3894#endif
10d16101 3895
c2f5bfd6
KH		 3896\f
3897/* Lisp API */
3898
35027d0c 3899DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
6c8ec042 3900 doc: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
35027d0c
KH		 3901Return nil otherwise.
3902Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
027a33c0 3903which kind of font it is. It must be one of `font-spec', `font-entity',
35027d0c
KH		 3904`font-object'. */)
3905 (object, extra_type)
3906 Lisp_Object object, extra_type;
c2f5bfd6 3907{
35027d0c
KH		 3908 if (NILP (extra_type))
3909 return (FONTP (object) ? Qt : Qnil);
3910 if (EQ (extra_type, Qfont_spec))
3911 return (FONT_SPEC_P (object) ? Qt : Qnil);
3912 if (EQ (extra_type, Qfont_entity))
3913 return (FONT_ENTITY_P (object) ? Qt : Qnil);
3914 if (EQ (extra_type, Qfont_object))
3915 return (FONT_OBJECT_P (object) ? Qt : Qnil);
3916 wrong_type_argument (intern ("font-extra-type"), extra_type);
c2f5bfd6
KH		 3917}
3918
3919DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
45eb10fb
KH		 3920 doc: /* Return a newly created font-spec with arguments as properties.
3921
3922ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3923valid font property name listed below:
3924
3925`:family', `:weight', `:slant', `:width'
3926
3927They are the same as face attributes of the same name. See
51c01100 3928`set-face-attribute'.
45eb10fb
KH		 3929
3930`:foundry'
3931
3932VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3933
3934`:adstyle'
3935
3936VALUE must be a string or a symbol specifying the additional
35027d0c 3937typographic style information of a font, e.g. ``sans''.
45eb10fb
KH		 3938
3939`:registry'
3940
3941VALUE must be a string or a symbol specifying the charset registry and
3942encoding of a font, e.g. ``iso8859-1''.
3943
3944`:size'
3945
3946VALUE must be a non-negative integer or a floating point number
c423ecca
KH		 3947specifying the font size. It specifies the font size in pixels (if
3948VALUE is an integer), or in points (if VALUE is a float).
2babb359
KH		 3949
3950`:name'
3951
7a18a178 3952VALUE must be a string of XLFD-style or fontconfig-style font name.
5bdd4dd2
KH		 3953
3954`:script'
3955
3956VALUE must be a symbol representing a script that the font must
209f39ac
KH		 3957support. It may be a symbol representing a subgroup of a script
3958listed in the variable `script-representative-chars'.
c423ecca
KH		 3959
3960`:lang'
3961
3962VALUE must be a symbol of two-letter ISO-639 language names,
3963e.g. `ja'.
3964
3965`:otf'
3966
3967VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3968required OpenType features.
3969
3970 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3971 LANGSYS-TAG: OpenType language system tag symbol,
3972 or nil for the default language system.
3973 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3974 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3975
3976GSUB and GPOS may contain `nil' element. In such a case, the font
3977must not have any of the remaining elements.
3978
3979For instance, if the VALUE is `(thai nil nil (mark))', the font must
22f79966 3980be an OpenType font, and whose GPOS table of `thai' script's default
c423ecca
KH		 3981language system must contain `mark' feature.
3982
ba3de0e8 3983usage: (font-spec ARGS...) */)
c2f5bfd6
KH		 3984 (nargs, args)
3985 int nargs;
3986 Lisp_Object *args;
3987{
35027d0c 3988 Lisp_Object spec = font_make_spec ();
c2f5bfd6
KH		 3989 int i;
3990
3991 for (i = 0; i < nargs; i += 2)
3992 {
c2f5bfd6
KH		 3993 Lisp_Object key = args[i], val = args[i + 1];
3994
35027d0c
KH		 3995 if (EQ (key, QCname))
3996 {
3997 CHECK_STRING (val);
3998 font_parse_name ((char *) SDATA (val), spec);
3999 font_put_extra (spec, key, val);
4000 }
c2f5bfd6 4001 else
4485a28e 4002 {
35027d0c
KH		 4003 int idx = get_font_prop_index (key);
4004
4005 if (idx >= 0)
ec6fe57c 4006 {
35027d0c
KH		 4007 val = font_prop_validate (idx, Qnil, val);
4008 if (idx < FONT_EXTRA_INDEX)
4009 ASET (spec, idx, val);
4010 else
4011 font_put_extra (spec, key, val);
ec6fe57c 4012 }
35027d0c
KH		 4013 else
4014 font_put_extra (spec, key, font_prop_validate (0, key, val));
4485a28e 4015 }
e950d6f1 4016 }
c2f5bfd6
KH		 4017 return spec;
4018}
4019
35027d0c
KH		 4020DEFUN ("copy-font-spec", Fcopy_font_spec, Scopy_font_spec, 1, 1, 0,
4021 doc: /* Return a copy of FONT as a font-spec. */)
4022 (font)
4023 Lisp_Object font;
4024{
d26424c5 4025 Lisp_Object new_spec, tail, prev, extra;
35027d0c
KH		 4026 int i;
4027
4028 CHECK_FONT (font);
4029 new_spec = font_make_spec ();
4030 for (i = 1; i < FONT_EXTRA_INDEX; i++)
4031 ASET (new_spec, i, AREF (font, i));
d26424c5
KH		 4032 extra = Fcopy_sequence (AREF (font, FONT_EXTRA_INDEX));
4033 /* We must remove :font-entity property. */
4034 for (prev = Qnil, tail = extra; CONSP (tail); prev = tail, tail = XCDR (tail))
4035 if (EQ (XCAR (XCAR (tail)), QCfont_entity))
4036 {
4037 if (NILP (prev))
4038 extra = XCDR (extra);
4039 else
4040 XSETCDR (prev, XCDR (tail));
4041 break;
4042 }
35027d0c
KH		 4043 ASET (new_spec, FONT_EXTRA_INDEX, extra);
4044 return new_spec;
4045}
4046
4047DEFUN ("merge-font-spec", Fmerge_font_spec, Smerge_font_spec, 2, 2, 0,
4048 doc: /* Merge font-specs FROM and TO, and return a new font-spec.
4049Every specified properties in FROM override the corresponding
4050properties in TO. */)
4051 (from, to)
4052 Lisp_Object from, to;
4053{
4054 Lisp_Object extra, tail;
4055 int i;
4056
4057 CHECK_FONT (from);
4058 CHECK_FONT (to);
4059 to = Fcopy_font_spec (to);
4060 for (i = 0; i < FONT_EXTRA_INDEX; i++)
4061 ASET (to, i, AREF (from, i));
4062 extra = AREF (to, FONT_EXTRA_INDEX);
4063 for (tail = AREF (from, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
4064 if (! EQ (XCAR (XCAR (tail)), Qfont_entity))
4065 {
4066 Lisp_Object slot = assq_no_quit (XCAR (XCAR (tail)), extra);
4067
4068 if (! NILP (slot))
4069 XSETCDR (slot, XCDR (XCAR (tail)));
4070 else
4071 extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
4072 }
4073 ASET (to, FONT_EXTRA_INDEX, extra);
4074 return to;
4075}
c2f5bfd6
KH		 4076
4077DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
45eb10fb 4078 doc: /* Return the value of FONT's property KEY.
5bdd4dd2
KH		 4079FONT is a font-spec, a font-entity, or a font-object.
4080KEY must be one of these symbols:
4081 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4082 :size, :name, :script
4083See the documentation of `font-spec' for their meanings.
4084If FONT is a font-entity or font-object, the value of :script may be
4085a list of scripts that are supported by the font. */)
45eb10fb
KH		 4086 (font, key)
4087 Lisp_Object font, key;
c2f5bfd6 4088{
35027d0c 4089 int idx;
c2f5bfd6 4090
35027d0c
KH		 4091 CHECK_FONT (font);
4092 CHECK_SYMBOL (key);
e80e09b4 4093
35027d0c 4094 idx = get_font_prop_index (key);
2babb359
KH		 4095 if (idx >= FONT_WEIGHT_INDEX && idx <= FONT_WIDTH_INDEX)
4096 return font_style_symbolic (font, idx, 0);
35027d0c 4097 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
c2f5bfd6 4098 return AREF (font, idx);
35027d0c 4099 return Fcdr (Fassq (key, AREF (font, FONT_EXTRA_INDEX)));
c2f5bfd6
KH		 4100}
4101
51cf11be
AS		 4102#ifdef HAVE_WINDOW_SYSTEM
4103
b1868a1a
CY		 4104DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1, 2, 0,
4105 doc: /* Return a plist of face attributes generated by FONT.
4106FONT is a font name, a font-spec, a font-entity, or a font-object.
4107The return value is a list of the form
4108
6f568955 4109\(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
b1868a1a 4110
48105a6a 4111where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
5989ba2f
CY		 4112compatible with `set-face-attribute'. Some of these key-attribute pairs
4113may be omitted from the list if they are not specified by FONT.
b1868a1a 4114
48105a6a
JB		 4115The optional argument FRAME specifies the frame that the face attributes
4116are to be displayed on. If omitted, the selected frame is used. */)
b1868a1a 4117 (font, frame)
6f568955 4118 Lisp_Object font, frame;
b1868a1a
CY		 4119{
4120 struct frame *f;
4121 Lisp_Object plist[10];
4122 Lisp_Object val;
5989ba2f 4123 int n = 0;
b1868a1a
CY		 4124
4125 if (NILP (frame))
4126 frame = selected_frame;
4127 CHECK_LIVE_FRAME (frame);
4128 f = XFRAME (frame);
4129
4130 if (STRINGP (font))
4131 {
4132 int fontset = fs_query_fontset (font, 0);
4133 Lisp_Object name = font;
4134 if (fontset >= 0)
4135 font = fontset_ascii (fontset);
4136 font = font_spec_from_name (name);
4137 if (! FONTP (font))
4138 signal_error ("Invalid font name", name);
4139 }
4140 else if (! FONTP (font))
4141 signal_error ("Invalid font object", font);
4142
b1868a1a 4143 val = AREF (font, FONT_FAMILY_INDEX);
5989ba2f
CY		 4144 if (! NILP (val))
4145 {
4146 plist[n++] = QCfamily;
4147 plist[n++] = SYMBOL_NAME (val);
4148 }
b1868a1a 4149
b1868a1a
CY		 4150 val = AREF (font, FONT_SIZE_INDEX);
4151 if (INTEGERP (val))
4152 {
4153 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
4154 int dpi = INTEGERP (font_dpi) ? XINT (font_dpi) : f->resy;
5989ba2f 4155 plist[n++] = QCheight;
c3bb5465 4156 plist[n++] = make_number (PIXEL_TO_POINT (XINT (val) * 10, dpi));
b1868a1a
CY		 4157 }
4158 else if (FLOATP (val))
5989ba2f
CY		 4159 {
4160 plist[n++] = QCheight;
4161 plist[n++] = make_number (10 * (int) XFLOAT_DATA (val));
4162 }
b1868a1a 4163
b1868a1a 4164 val = FONT_WEIGHT_FOR_FACE (font);
5989ba2f
CY		 4165 if (! NILP (val))
4166 {
4167 plist[n++] = QCweight;
4168 plist[n++] = val;
4169 }
b1868a1a 4170
b1868a1a 4171 val = FONT_SLANT_FOR_FACE (font);
5989ba2f
CY		 4172 if (! NILP (val))
4173 {
4174 plist[n++] = QCslant;
4175 plist[n++] = val;
4176 }
b1868a1a 4177
b1868a1a 4178 val = FONT_WIDTH_FOR_FACE (font);
5989ba2f
CY		 4179 if (! NILP (val))
4180 {
4181 plist[n++] = QCwidth;
4182 plist[n++] = val;
4183 }
b1868a1a 4184
5989ba2f 4185 return Flist (n, plist);
b1868a1a 4186}
c2f5bfd6 4187
51cf11be
AS		 4188#endif
4189
c2f5bfd6 4190DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
51c01100 4191 doc: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
c2f5bfd6
KH		 4192 (font_spec, prop, val)
4193 Lisp_Object font_spec, prop, val;
4194{
35027d0c 4195 int idx;
c2f5bfd6
KH		 4196
4197 CHECK_FONT_SPEC (font_spec);
35027d0c
KH		 4198 idx = get_font_prop_index (prop);
4199 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
69eb9e8b 4200 ASET (font_spec, idx, font_prop_validate (idx, Qnil, val));
c2f5bfd6 4201 else
35027d0c 4202 font_put_extra (font_spec, prop, font_prop_validate (0, prop, val));
c2f5bfd6
KH		 4203 return val;
4204}
4205
4206DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
4207 doc: /* List available fonts matching FONT-SPEC on the current frame.
4208Optional 2nd argument FRAME specifies the target frame.
4209Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
45eb10fb
KH		 4210Optional 4th argument PREFER, if non-nil, is a font-spec to
4211control the order of the returned list. Fonts are sorted by
027a33c0 4212how close they are to PREFER. */)
c2f5bfd6
KH		 4213 (font_spec, frame, num, prefer)
4214 Lisp_Object font_spec, frame, num, prefer;
4215{
4216 Lisp_Object vec, list, tail;
4217 int n = 0, i, len;
4218
4219 if (NILP (frame))
4220 frame = selected_frame;
4221 CHECK_LIVE_FRAME (frame);
35027d0c 4222 CHECK_FONT_SPEC (font_spec);
c2f5bfd6
KH		 4223 if (! NILP (num))
4224 {
4225 CHECK_NUMBER (num);
4226 n = XINT (num);
4227 if (n <= 0)
4228 return Qnil;
4229 }
4230 if (! NILP (prefer))
35027d0c 4231 CHECK_FONT_SPEC (prefer);
c2f5bfd6
KH		 4232
4233 vec = font_list_entities (frame, font_spec);
4234 len = ASIZE (vec);
4235 if (len == 0)
4236 return Qnil;
4237 if (len == 1)
4238 return Fcons (AREF (vec, 0), Qnil);
4239
4240 if (! NILP (prefer))
7181ea6a 4241 vec = font_sort_entites (vec, prefer, frame, 0);
c2f5bfd6
KH		 4242
4243 list = tail = Fcons (AREF (vec, 0), Qnil);
4244 if (n == 0 || n > len)
4245 n = len;
4246 for (i = 1; i < n; i++)
4247 {
4248 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
4249
4250 XSETCDR (tail, val);
4251 tail = val;
4252 }
4253 return list;
4254}
4255
35027d0c 4256DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
c2f5bfd6 4257 doc: /* List available font families on the current frame.
027a33c0 4258Optional argument FRAME, if non-nil, specifies the target frame. */)
c2f5bfd6
KH		 4259 (frame)
4260 Lisp_Object frame;
4261{
4262 FRAME_PTR f;
4263 struct font_driver_list *driver_list;
4264 Lisp_Object list;
4265
4266 if (NILP (frame))
4267 frame = selected_frame;
4268 CHECK_LIVE_FRAME (frame);
4269 f = XFRAME (frame);
4270 list = Qnil;
4271 for (driver_list = f->font_driver_list; driver_list;
4272 driver_list = driver_list->next)
4273 if (driver_list->driver->list_family)
4274 {
4275 Lisp_Object val = driver_list->driver->list_family (frame);
13bf758b 4276 Lisp_Object tail = list;
c2f5bfd6 4277
13bf758b
CY		 4278 for (; CONSP (val); val = XCDR (val))
4279 if (NILP (Fmemq (XCAR (val), tail))
4280 && SYMBOLP (XCAR (val)))
4281 list = Fcons (SYMBOL_NAME (XCAR (val)), list);
c2f5bfd6
KH		 4282 }
4283 return list;
4284}
4285
4286DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
4287 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
4288Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4289 (font_spec, frame)
4290 Lisp_Object font_spec, frame;
4291{
4292 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
4293
4294 if (CONSP (val))
4295 val = XCAR (val);
4296 return val;
4297}
4298
d0ab1ebe 4299DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
c2f5bfd6
KH		 4300 doc: /* Return XLFD name of FONT.
4301FONT is a font-spec, font-entity, or font-object.
d0ab1ebe
KH		 4302If the name is too long for XLFD (maximum 255 chars), return nil.
4303If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4304the consecutive wildcards are folded to one. */)
4305 (font, fold_wildcards)
4306 Lisp_Object font, fold_wildcards;
c2f5bfd6
KH		 4307{
4308 char name[256];
4309 int pixel_size = 0;
4310
35027d0c
KH		 4311 CHECK_FONT (font);
4312
4313 if (FONT_OBJECT_P (font))
c2f5bfd6 4314 {
35027d0c 4315 Lisp_Object font_name = AREF (font, FONT_NAME_INDEX);
c2f5bfd6 4316
35027d0c
KH		 4317 if (STRINGP (font_name)
4318 && SDATA (font_name)[0] == '-')
d0ab1ebe
KH		 4319 {
4320 if (NILP (fold_wildcards))
4321 return font_name;
4322 strcpy (name, (char *) SDATA (font_name));
4323 goto done;
4324 }
35027d0c 4325 pixel_size = XFONT_OBJECT (font)->pixel_size;
c2f5bfd6 4326 }
c2f5bfd6
KH		 4327 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
4328 return Qnil;
d0ab1ebe
KH		 4329 done:
4330 if (! NILP (fold_wildcards))
4331 {
4332 char *p0 = name, *p1;
4333
4334 while ((p1 = strstr (p0, "-*-*")))
4335 {
4336 strcpy (p1, p1 + 2);
4337 p0 = p1;
4338 }
4339 }
4340
c2f5bfd6
KH		 4341 return build_string (name);
4342}
4343
4344DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
4345 doc: /* Clear font cache. */)
4346 ()
4347{
4348 Lisp_Object list, frame;
4349
4350 FOR_EACH_FRAME (list, frame)
4351 {
4352 FRAME_PTR f = XFRAME (frame);
4353 struct font_driver_list *driver_list = f->font_driver_list;
4354
4355 for (; driver_list; driver_list = driver_list->next)
417a1b10
KH		 4356 if (driver_list->on)
4357 {
ca4da08a
KH		 4358 Lisp_Object cache = driver_list->driver->get_cache (f);
4359 Lisp_Object val;
51c01100 4360
ca4da08a 4361 val = XCDR (cache);
43c0454d
KH		 4362 while (! NILP (val)
4363 && ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
ca4da08a 4364 val = XCDR (val);
d0ab1ebe 4365 font_assert (! NILP (val));
ca4da08a
KH		 4366 val = XCDR (XCAR (val));
4367 if (XINT (XCAR (val)) == 0)
417a1b10 4368 {
ca4da08a
KH		 4369 font_clear_cache (f, XCAR (val), driver_list->driver);
4370 XSETCDR (cache, XCDR (val));
417a1b10 4371 }
417a1b10 4372 }
c2f5bfd6
KH		 4373 }
4374
4375 return Qnil;
4376}
4377
071132a9
KH		 4378\f
4379void
4380font_fill_lglyph_metrics (glyph, font_object)
4381 Lisp_Object glyph, font_object;
c2f5bfd6 4382{
071132a9 4383 struct font *font = XFONT_OBJECT (font_object);
f62ab7c5
EZ		 4384 unsigned code;
4385 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4386 EMACS_INT ecode = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
071132a9 4387 struct font_metrics metrics;
c2f5bfd6 4388
f62ab7c5
EZ		 4389 LGLYPH_SET_CODE (glyph, ecode);
4390 code = ecode;
071132a9
KH		 4391 font->driver->text_extents (font, &code, 1, &metrics);
4392 LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
4393 LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
4394 LGLYPH_SET_WIDTH (glyph, metrics.width);
4395 LGLYPH_SET_ASCENT (glyph, metrics.ascent);
4396 LGLYPH_SET_DESCENT (glyph, metrics.descent);
c2f5bfd6
KH		 4397}
4398
c2f5bfd6 4399
071132a9
KH		 4400DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0,
4401 doc: /* Shape the glyph-string GSTRING.
4402Shaping means substituting glyphs and/or adjusting positions of glyphs
4403to get the correct visual image of character sequences set in the
4404header of the glyph-string.
1701724c 4405
071132a9
KH		 4406If the shaping was successful, the value is GSTRING itself or a newly
4407created glyph-string. Otherwise, the value is nil. */)
4408 (gstring)
4409 Lisp_Object gstring;
1701724c
KH		 4410{
4411 struct font *font;
071132a9 4412 Lisp_Object font_object, n, glyph;
fc3a285e 4413 int i, j, from, to;
ba3de0e8 4414
071132a9
KH		 4415 if (! composition_gstring_p (gstring))
4416 signal_error ("Invalid glyph-string: ", gstring);
4417 if (! NILP (LGSTRING_ID (gstring)))
4418 return gstring;
4419 font_object = LGSTRING_FONT (gstring);
4420 CHECK_FONT_OBJECT (font_object);
35027d0c 4421 font = XFONT_OBJECT (font_object);
b876ea91
KH		 4422 if (! font->driver->shape)
4423 return Qnil;
4424
40fb53d6
KH		 4425 /* Try at most three times with larger gstring each time. */
4426 for (i = 0; i < 3; i++)
4427 {
40fb53d6
KH		 4428 n = font->driver->shape (gstring);
4429 if (INTEGERP (n))
4430 break;
071132a9
KH		 4431 gstring = larger_vector (gstring,
4432 ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
4433 Qnil);
40fb53d6 4434 }
071132a9 4435 if (i == 3 || XINT (n) == 0)
1701724c 4436 return Qnil;
ba3de0e8 4437
071132a9 4438 glyph = LGSTRING_GLYPH (gstring, 0);
fc3a285e
KH		 4439 from = LGLYPH_FROM (glyph);
4440 to = LGLYPH_TO (glyph);
4441 for (i = 1, j = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
071132a9
KH		 4442 {
4443 Lisp_Object this = LGSTRING_GLYPH (gstring, i);
10d16101 4444
071132a9
KH		 4445 if (NILP (this))
4446 break;
4447 if (NILP (LGLYPH_ADJUSTMENT (this)))
fc3a285e
KH		 4448 {
4449 if (j < i - 1)
4450 for (; j < i; j++)
4451 {
4452 glyph = LGSTRING_GLYPH (gstring, j);
4453 LGLYPH_SET_FROM (glyph, from);
4454 LGLYPH_SET_TO (glyph, to);
4455 }
4456 from = LGLYPH_FROM (this);
4457 to = LGLYPH_TO (this);
4458 j = i;
4459 }
071132a9 4460 else
b2937119 4461 {
fc3a285e
KH		 4462 if (from > LGLYPH_FROM (this))
4463 from = LGLYPH_FROM (this);
4464 if (to < LGLYPH_TO (this))
4465 to = LGLYPH_TO (this);
b2937119 4466 }
10d16101 4467 }
fc3a285e
KH		 4468 if (j < i - 1)
4469 for (; j < i; j++)
4470 {
4471 glyph = LGSTRING_GLYPH (gstring, j);
4472 LGLYPH_SET_FROM (glyph, from);
4473 LGLYPH_SET_TO (glyph, to);
4474 }
071132a9 4475 return composition_gstring_put_cache (gstring, XINT (n));
c2f5bfd6
KH		 4476}
4477
78a2f9cd
KH		 4478DEFUN ("font-variation-glyphs", Ffont_variation_glyphs, Sfont_variation_glyphs,
4479 2, 2, 0,
4480 doc: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4481Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4482where
4483 VARIATION-SELECTOR is a chracter code of variation selection
4484 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4485 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4486 (font_object, character)
4487 Lisp_Object font_object, character;
4488{
4489 unsigned variations[256];
4490 struct font *font;
4491 int i, n;
4492 Lisp_Object val;
4493
4494 CHECK_FONT_OBJECT (font_object);
4495 CHECK_CHARACTER (character);
4496 font = XFONT_OBJECT (font_object);
4497 if (! font->driver->get_variation_glyphs)
4498 return Qnil;
4499 n = font->driver->get_variation_glyphs (font, XINT (character), variations);
4500 if (! n)
4501 return Qnil;
4502 val = Qnil;
4503 for (i = 0; i < 255; i++)
4504 if (variations[i])
4505 {
4506 Lisp_Object code;
4507 int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
b60861e6
GM		 4508 /* Stops GCC whining about limited range of data type. */
4509 EMACS_INT var = variations[i];
78a2f9cd 4510
b60861e6 4511 if (var > MOST_POSITIVE_FIXNUM)
78a2f9cd
KH		 4512 code = Fcons (make_number ((variations[i]) >> 16),
4513 make_number ((variations[i]) & 0xFFFF));
4514 else
4515 code = make_number (variations[i]);
4516 val = Fcons (Fcons (make_number (vs), code), val);
4517 }
4518 return val;
4519}
4520
6a3dadd2
KH		 4521#if 0
4522
733fd013
KH		 4523DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
4524 doc: /* Apply OpenType features on glyph-string GSTRING-IN.
51c01100 4525OTF-FEATURES specifies which features to apply in this format:
733fd013 4526 (SCRIPT LANGSYS GSUB GPOS)
e80e09b4
KH		 4527where
4528 SCRIPT is a symbol specifying a script tag of OpenType,
4529 LANGSYS is a symbol specifying a langsys tag of OpenType,
733fd013 4530 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
e80e09b4
KH		 4531
4532If LANGYS is nil, the default langsys is selected.
4533
51c01100
JB		 4534The features are applied in the order they appear in the list. The
4535symbol `*' means to apply all available features not present in this
733fd013
KH		 4536list, and the remaining features are ignored. For instance, (vatu
4537pstf * haln) is to apply vatu and pstf in this order, then to apply
4538all available features other than vatu, pstf, and haln.
e80e09b4
KH		 4539
4540The features are applied to the glyphs in the range FROM and TO of
733fd013 4541the glyph-string GSTRING-IN.
e80e09b4 4542
51c01100 4543If some feature is actually applicable, the resulting glyphs are
e80e09b4
KH		 4544produced in the glyph-string GSTRING-OUT from the index INDEX. In
4545this case, the value is the number of produced glyphs.
4546
4547If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4548the value is 0.
4549
51c01100 4550If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
e80e09b4
KH		 4551produced in GSTRING-OUT, and the value is nil.
4552
4553See the documentation of `font-make-gstring' for the format of
4554glyph-string. */)
733fd013
KH		 4555 (otf_features, gstring_in, from, to, gstring_out, index)
4556 Lisp_Object otf_features, gstring_in, from, to, gstring_out, index;
e80e09b4
KH		 4557{
4558 Lisp_Object font_object = LGSTRING_FONT (gstring_in);
733fd013
KH		 4559 Lisp_Object val;
4560 struct font *font;
e80e09b4
KH		 4561 int len, num;
4562
733fd013 4563 check_otf_features (otf_features);
35027d0c
KH		 4564 CHECK_FONT_OBJECT (font_object);
4565 font = XFONT_OBJECT (font_object);
733fd013 4566 if (! font->driver->otf_drive)
e80e09b4
KH		 4567 error ("Font backend %s can't drive OpenType GSUB table",
4568 SDATA (SYMBOL_NAME (font->driver->type)));
733fd013
KH		 4569 CHECK_CONS (otf_features);
4570 CHECK_SYMBOL (XCAR (otf_features));
4571 val = XCDR (otf_features);
4572 CHECK_SYMBOL (XCAR (val));
4573 val = XCDR (otf_features);
4574 if (! NILP (val))
4575 CHECK_CONS (val);
e80e09b4
KH		 4576 len = check_gstring (gstring_in);
4577 CHECK_VECTOR (gstring_out);
4578 CHECK_NATNUM (from);
4579 CHECK_NATNUM (to);
4580 CHECK_NATNUM (index);
4581
4582 if (XINT (from) >= XINT (to) || XINT (to) > len)
4583 args_out_of_range_3 (from, to, make_number (len));
4584 if (XINT (index) >= ASIZE (gstring_out))
4585 args_out_of_range (index, make_number (ASIZE (gstring_out)));
733fd013
KH		 4586 num = font->driver->otf_drive (font, otf_features,
4587 gstring_in, XINT (from), XINT (to),
4588 gstring_out, XINT (index), 0);
e80e09b4
KH		 4589 if (num < 0)
4590 return Qnil;
4591 return make_number (num);
4592}
4593
e80e09b4
KH		 4594DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
4595 3, 3, 0,
4596 doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
51c01100 4597OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
e80e09b4
KH		 4598in this format:
4599 (SCRIPT LANGSYS FEATURE ...)
027a33c0 4600See the documentation of `font-drive-otf' for more detail.
e80e09b4
KH		 4601
4602The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4603where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4604character code corresponding to the glyph or nil if there's no
4605corresponding character. */)
733fd013
KH		 4606 (font_object, character, otf_features)
4607 Lisp_Object font_object, character, otf_features;
e80e09b4
KH		 4608{
4609 struct font *font;
4610 Lisp_Object gstring_in, gstring_out, g;
4611 Lisp_Object alternates;
4612 int i, num;
4613
4614 CHECK_FONT_GET_OBJECT (font_object, font);
733fd013 4615 if (! font->driver->otf_drive)
e950d6f1
KH		 4616 error ("Font backend %s can't drive OpenType GSUB table",
4617 SDATA (SYMBOL_NAME (font->driver->type)));
e80e09b4 4618 CHECK_CHARACTER (character);
733fd013 4619 CHECK_CONS (otf_features);
e80e09b4
KH		 4620
4621 gstring_in = Ffont_make_gstring (font_object, make_number (1));
4622 g = LGSTRING_GLYPH (gstring_in, 0);
f9ffa1ea 4623 LGLYPH_SET_CHAR (g, XINT (character));
e80e09b4 4624 gstring_out = Ffont_make_gstring (font_object, make_number (10));
733fd013
KH		 4625 while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
4626 gstring_out, 0, 1)) < 0)
e80e09b4
KH		 4627 gstring_out = Ffont_make_gstring (font_object,
4628 make_number (ASIZE (gstring_out) * 2));
4629 alternates = Qnil;
4630 for (i = 0; i < num; i++)
4631 {
4632 Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
f9ffa1ea
SM		 4633 int c = LGLYPH_CHAR (g);
4634 unsigned code = LGLYPH_CODE (g);
e80e09b4
KH		 4635
4636 alternates = Fcons (Fcons (make_number (code),
4637 c > 0 ? make_number (c) : Qnil),
4638 alternates);
4639 }
4640 return Fnreverse (alternates);
4641}
6a3dadd2 4642#endif /* 0 */
c2f5bfd6
KH		 4643
4644#ifdef FONT_DEBUG
4645
4646DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
4647 doc: /* Open FONT-ENTITY. */)
4648 (font_entity, size, frame)
4649 Lisp_Object font_entity;
4650 Lisp_Object size;
4651 Lisp_Object frame;
4652{
4653 int isize;
4654
4655 CHECK_FONT_ENTITY (font_entity);
c2f5bfd6
KH		 4656 if (NILP (frame))
4657 frame = selected_frame;
4658 CHECK_LIVE_FRAME (frame);
51c01100 4659
35027d0c
KH		 4660 if (NILP (size))
4661 isize = XINT (AREF (font_entity, FONT_SIZE_INDEX));
4662 else
4663 {
4664 CHECK_NUMBER_OR_FLOAT (size);
4665 if (FLOATP (size))
d03b5cdb 4666 isize = POINT_TO_PIXEL (XFLOAT_DATA (size), XFRAME (frame)->resy);
35027d0c
KH		 4667 else
4668 isize = XINT (size);
4669 if (isize == 0)
4670 isize = 120;
4671 }
c2f5bfd6
KH		 4672 return font_open_entity (XFRAME (frame), font_entity, isize);
4673}
4674
4675DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
4676 doc: /* Close FONT-OBJECT. */)
4677 (font_object, frame)
4678 Lisp_Object font_object, frame;
4679{
4680 CHECK_FONT_OBJECT (font_object);
4681 if (NILP (frame))
4682 frame = selected_frame;
4683 CHECK_LIVE_FRAME (frame);
4684 font_close_object (XFRAME (frame), font_object);
4685 return Qnil;
4686}
4687
4688DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
e80e09b4
KH		 4689 doc: /* Return information about FONT-OBJECT.
4690The value is a vector:
4691 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
e0708580 4692 CAPABILITY ]
e80e09b4
KH		 4693
4694NAME is a string of the font name (or nil if the font backend doesn't
4695provide a name).
4696
4697FILENAME is a string of the font file (or nil if the font backend
4698doesn't provide a file name).
4699
4700PIXEL-SIZE is a pixel size by which the font is opened.
4701
027a33c0 4702SIZE is a maximum advance width of the font in pixels.
e80e09b4
KH		 4703
4704ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
027a33c0 4705pixels.
e80e09b4 4706
e0708580
KH		 4707CAPABILITY is a list whose first element is a symbol representing the
4708font format \(x, opentype, truetype, type1, pcf, or bdf) and the
027a33c0 4709remaining elements describe the details of the font capability.
e0708580
KH		 4710
4711If the font is OpenType font, the form of the list is
4712 \(opentype GSUB GPOS)
4713where GSUB shows which "GSUB" features the font supports, and GPOS
4714shows which "GPOS" features the font supports. Both GSUB and GPOS are
4715lists of the format:
4716 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4717
4718If the font is not OpenType font, currently the length of the form is
4719one.
e80e09b4
KH		 4720
4721SCRIPT is a symbol representing OpenType script tag.
4722
4723LANGSYS is a symbol representing OpenType langsys tag, or nil
4724representing the default langsys.
4725
51c01100 4726FEATURE is a symbol representing OpenType feature tag.
e80e09b4 4727
51c01100 4728If the font is not OpenType font, CAPABILITY is nil. */)
c2f5bfd6
KH		 4729 (font_object)
4730 Lisp_Object font_object;
4731{
4732 struct font *font;
4733 Lisp_Object val;
4734
4735 CHECK_FONT_GET_OBJECT (font_object, font);
4736
4737 val = Fmake_vector (make_number (9), Qnil);
35027d0c
KH		 4738 ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
4739 ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
c2f5bfd6 4740 ASET (val, 2, make_number (font->pixel_size));
35027d0c 4741 ASET (val, 3, make_number (font->max_width));
c2f5bfd6
KH		 4742 ASET (val, 4, make_number (font->ascent));
4743 ASET (val, 5, make_number (font->descent));
35027d0c
KH		 4744 ASET (val, 6, make_number (font->space_width));
4745 ASET (val, 7, make_number (font->average_width));
c2f5bfd6 4746 if (font->driver->otf_capability)
e0708580 4747 ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
c2f5bfd6
KH		 4748 return val;
4749}
4750
4751DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
4752 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4753Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4754 (font_object, string)
4755 Lisp_Object font_object, string;
4756{
4757 struct font *font;
4758 int i, len;
4759 Lisp_Object vec;
4760
4761 CHECK_FONT_GET_OBJECT (font_object, font);
4762 CHECK_STRING (string);
4763 len = SCHARS (string);
4764 vec = Fmake_vector (make_number (len), Qnil);
4765 for (i = 0; i < len; i++)
4766 {
4767 Lisp_Object ch = Faref (string, make_number (i));
4768 Lisp_Object val;
4769 int c = XINT (ch);
4770 unsigned code;
2930d117 4771 EMACS_INT cod;
c2f5bfd6
KH		 4772 struct font_metrics metrics;
4773
2930d117 4774 cod = code = font->driver->encode_char (font, c);
c2f5bfd6
KH		 4775 if (code == FONT_INVALID_CODE)
4776 continue;
4777 val = Fmake_vector (make_number (6), Qnil);
2930d117 4778 if (cod <= MOST_POSITIVE_FIXNUM)
c2f5bfd6
KH		 4779 ASET (val, 0, make_number (code));
4780 else
4781 ASET (val, 0, Fcons (make_number (code >> 16),
4782 make_number (code & 0xFFFF)));
51c01100 4783 font->driver->text_extents (font, &code, 1, &metrics);
c2f5bfd6
KH		 4784 ASET (val, 1, make_number (metrics.lbearing));
4785 ASET (val, 2, make_number (metrics.rbearing));
4786 ASET (val, 3, make_number (metrics.width));
4787 ASET (val, 4, make_number (metrics.ascent));
4788 ASET (val, 5, make_number (metrics.descent));
4789 ASET (vec, i, val);
4790 }
4791 return vec;
4792}
4793
ec6fe57c 4794DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
67b5d7de 4795 doc: /* Return t if and only if font-spec SPEC matches with FONT.
ec6fe57c
KH		 4796FONT is a font-spec, font-entity, or font-object. */)
4797 (spec, font)
4798 Lisp_Object spec, font;
4799{
4800 CHECK_FONT_SPEC (spec);
35027d0c 4801 CHECK_FONT (font);
ec6fe57c
KH		 4802
4803 return (font_match_p (spec, font) ? Qt : Qnil);
4804}
4805
1701724c 4806DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
51c01100 4807 doc: /* Return a font-object for displaying a character at POSITION.
10d16101
KH		 4808Optional second arg WINDOW, if non-nil, is a window displaying
4809the current buffer. It defaults to the currently selected window. */)
1701724c
KH		 4810 (position, window, string)
4811 Lisp_Object position, window, string;
10d16101
KH		 4812{
4813 struct window *w;
e3ee0340 4814 EMACS_INT pos;
10d16101 4815
1701724c
KH		 4816 if (NILP (string))
4817 {
4818 CHECK_NUMBER_COERCE_MARKER (position);
4819 pos = XINT (position);
4820 if (pos < BEGV || pos >= ZV)
4821 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1701724c
KH		 4822 }
4823 else
4824 {
1701724c
KH		 4825 CHECK_NUMBER (position);
4826 CHECK_STRING (string);
4827 pos = XINT (position);
4828 if (pos < 0 || pos >= SCHARS (string))
4829 args_out_of_range (string, position);
1701724c 4830 }
10d16101
KH		 4831 if (NILP (window))
4832 window = selected_window;
4833 CHECK_LIVE_WINDOW (window);
40fb53d6 4834 w = XWINDOW (window);
10d16101 4835
40fb53d6 4836 return font_at (-1, pos, NULL, w, string);
10d16101
KH		 4837}
4838
c2f5bfd6
KH		 4839#if 0
4840DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
4841 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4842The value is a number of glyphs drawn.
4843Type C-l to recover what previously shown. */)
4844 (font_object, string)
4845 Lisp_Object font_object, string;
4846{
4847 Lisp_Object frame = selected_frame;
4848 FRAME_PTR f = XFRAME (frame);
4849 struct font *font;
4850 struct face *face;
4851 int i, len, width;
4852 unsigned *code;
4853
4854 CHECK_FONT_GET_OBJECT (font_object, font);
4855 CHECK_STRING (string);
4856 len = SCHARS (string);
4857 code = alloca (sizeof (unsigned) * len);
4858 for (i = 0; i < len; i++)
4859 {
4860 Lisp_Object ch = Faref (string, make_number (i));
4861 Lisp_Object val;
4862 int c = XINT (ch);
4863
4864 code[i] = font->driver->encode_char (font, c);
4865 if (code[i] == FONT_INVALID_CODE)
4866 break;
4867 }
4868 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4869 face->fontp = font;
4870 if (font->driver->prepare_face)
4871 font->driver->prepare_face (f, face);
4872 width = font->driver->text_extents (font, code, i, NULL);
4873 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
4874 if (font->driver->done_face)
4875 font->driver->done_face (f, face);
4876 face->fontp = NULL;
4877 return make_number (len);
4878}
4879#endif
4880
4881#endif /* FONT_DEBUG */
4882
a266686a
KH		 4883#ifdef HAVE_WINDOW_SYSTEM
4884
72606e45
KH		 4885DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
4886 doc: /* Return information about a font named NAME on frame FRAME.
4887If FRAME is omitted or nil, use the selected frame.
06f19b91 4888The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
72606e45
KH		 4889 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4890where
4891 OPENED-NAME is the name used for opening the font,
4892 FULL-NAME is the full name of the font,
06f19b91
KH		 4893 SIZE is the pixelsize of the font,
4894 HEIGHT is the pixel-height of the font (i.e ascent + descent),
72606e45
KH		 4895 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4896 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4897 how to compose characters.
4898If the named font is not yet loaded, return nil. */)
4899 (name, frame)
4900 Lisp_Object name, frame;
4901{
4902 FRAME_PTR f;
4903 struct font *font;
4904 Lisp_Object info;
4905 Lisp_Object font_object;
4906
4907 (*check_window_system_func) ();
4908
4909 if (! FONTP (name))
4910 CHECK_STRING (name);
4911 if (NILP (frame))
4912 frame = selected_frame;
4913 CHECK_LIVE_FRAME (frame);
4914 f = XFRAME (frame);
4915
4916 if (STRINGP (name))
4917 {
4918 int fontset = fs_query_fontset (name, 0);
4919
4920 if (fontset >= 0)
4921 name = fontset_ascii (fontset);
4922 font_object = font_open_by_name (f, (char *) SDATA (name));
4923 }
4924 else if (FONT_OBJECT_P (name))
4925 font_object = name;
4926 else if (FONT_ENTITY_P (name))
4927 font_object = font_open_entity (f, name, 0);
4928 else
4929 {
4930 struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4931 Lisp_Object entity = font_matching_entity (f, face->lface, name);
4932
4933 font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
4934 }
4935 if (NILP (font_object))
4936 return Qnil;
4937 font = XFONT_OBJECT (font_object);
4938
4939 info = Fmake_vector (make_number (7), Qnil);
4940 XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
06f19b91 4941 XVECTOR (info)->contents[1] = AREF (font_object, FONT_FULLNAME_INDEX);
72606e45
KH		 4942 XVECTOR (info)->contents[2] = make_number (font->pixel_size);
4943 XVECTOR (info)->contents[3] = make_number (font->height);
4944 XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
4945 XVECTOR (info)->contents[5] = make_number (font->relative_compose);
4946 XVECTOR (info)->contents[6] = make_number (font->default_ascent);
4947
4948#if 0
4949 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4950 close it now. Perhaps, we should manage font-objects
4951 by `reference-count'. */
4952 font_close_object (f, font_object);
4953#endif
4954 return info;
4955}
a266686a 4956#endif
72606e45 4957
c2f5bfd6 4958\f
d0ab1ebe
KH		 4959#define BUILD_STYLE_TABLE(TBL) \
4960 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4961
4962static Lisp_Object
4963build_style_table (entry, nelement)
4964 struct table_entry *entry;
4965 int nelement;
4966{
4967 int i, j;
4968 Lisp_Object table, elt;
17ab8f5d 4969
d0ab1ebe
KH		 4970 table = Fmake_vector (make_number (nelement), Qnil);
4971 for (i = 0; i < nelement; i++)
4972 {
4973 for (j = 0; entry[i].names[j]; j++);
4974 elt = Fmake_vector (make_number (j + 1), Qnil);
4975 ASET (elt, 0, make_number (entry[i].numeric));
4976 for (j = 0; entry[i].names[j]; j++)
17ab8f5d 4977 ASET (elt, j + 1, intern (entry[i].names[j]));
d0ab1ebe
KH		 4978 ASET (table, i, elt);
4979 }
4980 return table;
4981}
4982
4983static Lisp_Object Vfont_log;
4984static int font_log_env_checked;
4985
d0818984
KH		 4986/* The deferred font-log data of the form [ACTION ARG RESULT].
4987 If ACTION is not nil, that is added to the log when font_add_log is
4988 called next time. At that time, ACTION is set back to nil. */
4989static Lisp_Object Vfont_log_deferred;
4990
4991/* Prepend the font-related logging data in Vfont_log if it is not
4992 `t'. ACTION describes a kind of font-related action (e.g. listing,
4993 opening), ARG is the argument for the action, and RESULT is the
4994 result of the action. */
d0ab1ebe
KH		 4995void
4996font_add_log (action, arg, result)
4997 char *action;
4998 Lisp_Object arg, result;
4999{
5000 Lisp_Object tail, val;
5001 int i;
5002
5003 if (! font_log_env_checked)
5004 {
5005 Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
5006 font_log_env_checked = 1;
5007 }
5008 if (EQ (Vfont_log, Qt))
5009 return;
d0818984
KH		 5010 if (STRINGP (AREF (Vfont_log_deferred, 0)))
5011 {
071132a9 5012 char *str = (char *) SDATA (AREF (Vfont_log_deferred, 0));
d0818984
KH		 5013
5014 ASET (Vfont_log_deferred, 0, Qnil);
5015 font_add_log (str, AREF (Vfont_log_deferred, 1),
5016 AREF (Vfont_log_deferred, 2));
5017 }
5018
d0ab1ebe 5019 if (FONTP (arg))
db716644
KH		 5020 {
5021 Lisp_Object tail, elt;
5022 Lisp_Object equalstr = build_string ("=");
5023
5024 val = Ffont_xlfd_name (arg, Qt);
5025 for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
5026 tail = XCDR (tail))
5027 {
5028 elt = XCAR (tail);
49f9c344
KH		 5029 if (EQ (XCAR (elt), QCscript)
5030 && SYMBOLP (XCDR (elt)))
db716644
KH		 5031 val = concat3 (val, SYMBOL_NAME (QCscript),
5032 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
49f9c344
KH		 5033 else if (EQ (XCAR (elt), QClang)
5034 && SYMBOLP (XCDR (elt)))
db716644
KH		 5035 val = concat3 (val, SYMBOL_NAME (QClang),
5036 concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
49f9c344
KH		 5037 else if (EQ (XCAR (elt), QCotf)
5038 && CONSP (XCDR (elt)) && SYMBOLP (XCAR (XCDR (elt))))
db716644
KH		 5039 val = concat3 (val, SYMBOL_NAME (QCotf),
5040 concat2 (equalstr,
5041 SYMBOL_NAME (XCAR (XCDR (elt)))));
5042 }
5043 arg = val;
5044 }
d0ab1ebe 5045 if (FONTP (result))
d26424c5
KH		 5046 {
5047 val = Ffont_xlfd_name (result, Qt);
5048 if (! FONT_SPEC_P (result))
5049 val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
5050 build_string (":"), val);
5051 result = val;
5052 }
d0ab1ebe
KH		 5053 else if (CONSP (result))
5054 {
5055 result = Fcopy_sequence (result);
5056 for (tail = result; CONSP (tail); tail = XCDR (tail))
5057 {
5058 val = XCAR (tail);
5059 if (FONTP (val))
5060 val = Ffont_xlfd_name (val, Qt);
5061 XSETCAR (tail, val);
5062 }
5063 }
5064 else if (VECTORP (result))
5065 {
5066 result = Fcopy_sequence (result);
5067 for (i = 0; i < ASIZE (result); i++)
5068 {
5069 val = AREF (result, i);
5070 if (FONTP (val))
5071 val = Ffont_xlfd_name (val, Qt);
5072 ASET (result, i, val);
5073 }
5074 }
5075 Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
5076}
5077
d0818984
KH		 5078/* Record a font-related logging data to be added to Vfont_log when
5079 font_add_log is called next time. ACTION, ARG, RESULT are the same
5080 as font_add_log. */
5081
5082void
5083font_deferred_log (action, arg, result)
5084 char *action;
5085 Lisp_Object arg, result;
5086{
5087 ASET (Vfont_log_deferred, 0, build_string (action));
5088 ASET (Vfont_log_deferred, 1, arg);
5089 ASET (Vfont_log_deferred, 2, result);
ba3de0e8 5090}
d0818984 5091
c2f5bfd6
KH		 5092extern void syms_of_ftfont P_ (());
5093extern void syms_of_xfont P_ (());
5094extern void syms_of_xftfont P_ (());
5095extern void syms_of_ftxfont P_ (());
5096extern void syms_of_bdffont P_ (());
5097extern void syms_of_w32font P_ (());
5098extern void syms_of_atmfont P_ (());
edfda783 5099extern void syms_of_nsfont P_ (());
c2f5bfd6
KH		 5100
5101void
5102syms_of_font ()
5103{
4007dd1c
KH		 5104 sort_shift_bits[FONT_TYPE_INDEX] = 0;
5105 sort_shift_bits[FONT_SLANT_INDEX] = 2;
5106 sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
5107 sort_shift_bits[FONT_SIZE_INDEX] = 16;
5108 sort_shift_bits[FONT_WIDTH_INDEX] = 23;
5109 /* Note that the other elements in sort_shift_bits are not used. */
c2f5bfd6 5110
1701724c
KH		 5111 staticpro (&font_charset_alist);
5112 font_charset_alist = Qnil;
5113
e0708580 5114 DEFSYM (Qopentype, "opentype");
c2f5bfd6 5115
9e1bb909 5116 DEFSYM (Qascii_0, "ascii-0");
1bb1d99b
KH		 5117 DEFSYM (Qiso8859_1, "iso8859-1");
5118 DEFSYM (Qiso10646_1, "iso10646-1");
5119 DEFSYM (Qunicode_bmp, "unicode-bmp");
cf96c5c2 5120 DEFSYM (Qunicode_sip, "unicode-sip");
1bb1d99b 5121
071132a9
KH		 5122 DEFSYM (QCf, "Cf");
5123
c2f5bfd6 5124 DEFSYM (QCotf, ":otf");
35027d0c 5125 DEFSYM (QClang, ":lang");
c2f5bfd6 5126 DEFSYM (QCscript, ":script");
4c496d0d 5127 DEFSYM (QCantialias, ":antialias");
c2f5bfd6
KH		 5128
5129 DEFSYM (QCfoundry, ":foundry");
5130 DEFSYM (QCadstyle, ":adstyle");
5131 DEFSYM (QCregistry, ":registry");
9331887d
KH		 5132 DEFSYM (QCspacing, ":spacing");
5133 DEFSYM (QCdpi, ":dpi");
ec6fe57c 5134 DEFSYM (QCscalable, ":scalable");
35027d0c
KH		 5135 DEFSYM (QCavgwidth, ":avgwidth");
5136 DEFSYM (QCfont_entity, ":font-entity");
5137 DEFSYM (QCfc_unknown_spec, ":fc-unknown-spec");
c2f5bfd6 5138
ec6fe57c
KH		 5139 DEFSYM (Qc, "c");
5140 DEFSYM (Qm, "m");
5141 DEFSYM (Qp, "p");
5142 DEFSYM (Qd, "d");
5143
cf702558
CY		 5144 DEFSYM (Qja, "ja");
5145 DEFSYM (Qko, "ko");
5146
c2f5bfd6
KH		 5147 staticpro (&null_vector);
5148 null_vector = Fmake_vector (make_number (0), Qnil);
5149
5150 staticpro (&scratch_font_spec);
5151 scratch_font_spec = Ffont_spec (0, NULL);
5152 staticpro (&scratch_font_prefer);
5153 scratch_font_prefer = Ffont_spec (0, NULL);
5154
d0818984
KH		 5155 staticpro (&Vfont_log_deferred);
5156 Vfont_log_deferred = Fmake_vector (make_number (3), Qnil);
5157
6a3dadd2 5158#if 0
733fd013
KH		 5159#ifdef HAVE_LIBOTF
5160 staticpro (&otf_list);
5161 otf_list = Qnil;
6a3dadd2
KH		 5162#endif /* HAVE_LIBOTF */
5163#endif /* 0 */
733fd013 5164
c2f5bfd6
KH		 5165 defsubr (&Sfontp);
5166 defsubr (&Sfont_spec);
5167 defsubr (&Sfont_get);
51cf11be 5168#ifdef HAVE_WINDOW_SYSTEM
b1868a1a 5169 defsubr (&Sfont_face_attributes);
51cf11be 5170#endif
c2f5bfd6
KH		 5171 defsubr (&Sfont_put);
5172 defsubr (&Slist_fonts);
35027d0c 5173 defsubr (&Sfont_family_list);
c2f5bfd6
KH		 5174 defsubr (&Sfind_font);
5175 defsubr (&Sfont_xlfd_name);
5176 defsubr (&Sclear_font_cache);
071132a9 5177 defsubr (&Sfont_shape_gstring);
78a2f9cd 5178 defsubr (&Sfont_variation_glyphs);
6a3dadd2 5179#if 0
733fd013 5180 defsubr (&Sfont_drive_otf);
e80e09b4 5181 defsubr (&Sfont_otf_alternates);
6a3dadd2 5182#endif /* 0 */
c2f5bfd6
KH		 5183
5184#ifdef FONT_DEBUG
5185 defsubr (&Sopen_font);
5186 defsubr (&Sclose_font);
5187 defsubr (&Squery_font);
5188 defsubr (&Sget_font_glyphs);
ec6fe57c 5189 defsubr (&Sfont_match_p);
10d16101 5190 defsubr (&Sfont_at);
c2f5bfd6
KH		 5191#if 0
5192 defsubr (&Sdraw_string);
5193#endif
5194#endif /* FONT_DEBUG */
a266686a 5195#ifdef HAVE_WINDOW_SYSTEM
72606e45 5196 defsubr (&Sfont_info);
a266686a 5197#endif
c2f5bfd6 5198
819e81df
KH		 5199 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
5200 doc: /*
5201Alist of fontname patterns vs the corresponding encoding and repertory info.
5202Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5203where ENCODING is a charset or a char-table,
5204and REPERTORY is a charset, a char-table, or nil.
5205
027a33c0 5206If ENCODING and REPERTORY are the same, the element can have the form
819e81df
KH		 5207\(REGEXP . ENCODING).
5208
5209ENCODING is for converting a character to a glyph code of the font.
5210If ENCODING is a charset, encoding a character by the charset gives
5211the corresponding glyph code. If ENCODING is a char-table, looking up
5212the table by a character gives the corresponding glyph code.
5213
5214REPERTORY specifies a repertory of characters supported by the font.
5215If REPERTORY is a charset, all characters beloging to the charset are
5216supported. If REPERTORY is a char-table, all characters who have a
027a33c0 5217non-nil value in the table are supported. If REPERTORY is nil, Emacs
819e81df
KH		 5218gets the repertory information by an opened font and ENCODING. */);
5219 Vfont_encoding_alist = Qnil;
5220
d0ab1ebe
KH		 5221 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table,
5222 doc: /* Vector of valid font weight values.
5223Each element has the form:
5224 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
17ab8f5d 5225NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
d0ab1ebe
KH		 5226 Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
5227
5228 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table,
5229 doc: /* Vector of font slant symbols vs the corresponding numeric values.
17ab8f5d 5230See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5231 Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
5232
5233 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table,
5234 doc: /* Alist of font width symbols vs the corresponding numeric values.
17ab8f5d 5235See `font-weight-table' for the format of the vector. */);
d0ab1ebe
KH		 5236 Vfont_width_table = BUILD_STYLE_TABLE (width_table);
5237
5238 staticpro (&font_style_table);
5239 font_style_table = Fmake_vector (make_number (3), Qnil);
5240 ASET (font_style_table, 0, Vfont_weight_table);
5241 ASET (font_style_table, 1, Vfont_slant_table);
5242 ASET (font_style_table, 2, Vfont_width_table);
5243
5244 DEFVAR_LISP ("font-log", &Vfont_log, doc: /*
5245*Logging list of font related actions and results.
5246The value t means to suppress the logging.
5247The initial value is set to nil if the environment variable
5248EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5249 Vfont_log = Qnil;
5250
819e81df 5251#ifdef HAVE_WINDOW_SYSTEM
c2f5bfd6 5252#ifdef HAVE_FREETYPE
35027d0c 5253 syms_of_ftfont ();
c2f5bfd6 5254#ifdef HAVE_X_WINDOWS
35027d0c
KH		 5255 syms_of_xfont ();
5256 syms_of_ftxfont ();
c2f5bfd6 5257#ifdef HAVE_XFT
35027d0c 5258 syms_of_xftfont ();
c2f5bfd6
KH		 5259#endif /* HAVE_XFT */
5260#endif /* HAVE_X_WINDOWS */
5261#else /* not HAVE_FREETYPE */
5262#ifdef HAVE_X_WINDOWS
35027d0c 5263 syms_of_xfont ();
c2f5bfd6
KH		 5264#endif /* HAVE_X_WINDOWS */
5265#endif /* not HAVE_FREETYPE */
5266#ifdef HAVE_BDFFONT
35027d0c 5267 syms_of_bdffont ();
c2f5bfd6
KH		 5268#endif /* HAVE_BDFFONT */
5269#ifdef WINDOWSNT
35027d0c 5270 syms_of_w32font ();
c2f5bfd6 5271#endif /* WINDOWSNT */
edfda783
AR		 5272#ifdef HAVE_NS
5273 syms_of_nsfont ();
5274#endif /* HAVE_NS */
819e81df 5275#endif /* HAVE_WINDOW_SYSTEM */
c2f5bfd6 5276}
885b7d09
MB		 5277
5278/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5279 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.