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