HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(font_match_p): Fix for the case that a vector of
[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;
d0ab1ebe 1601 int dpi;
ec6fe57c 1602 int i, len = 1;
ef18374f 1603 char *p;
a9262bb8 1604 Lisp_Object styles[3];
417a1b10 1605 char *style_names[3] = { "weight", "slant", "width" };
35027d0c 1606 char work[256];
ef18374f 1607
b1868a1a
CY		 1608 family = AREF (font, FONT_FAMILY_INDEX);
1609 if (! NILP (family))
1610 {
1611 if (SYMBOLP (family))
1612 {
1613 family = SYMBOL_NAME (family);
1614 len += SBYTES (family);
1615 }
1616 else
1617 family = Qnil;
1618 }
ec6fe57c
KH		 1619
1620 val = AREF (font, FONT_SIZE_INDEX);
1621 if (INTEGERP (val))
ef18374f 1622 {
ec6fe57c
KH		 1623 if (XINT (val) != 0)
1624 pixel_size = XINT (val);
1625 point_size = -1;
1626 len += 21; /* for ":pixelsize=NUM" */
ef18374f 1627 }
ec6fe57c 1628 else if (FLOATP (val))
ef18374f 1629 {
ec6fe57c
KH		 1630 pixel_size = -1;
1631 point_size = (int) XFLOAT_DATA (val);
1632 len += 11; /* for "-NUM" */
ef18374f 1633 }
ec6fe57c 1634
b1868a1a
CY		 1635 foundry = AREF (font, FONT_FOUNDRY_INDEX);
1636 if (! NILP (foundry))
1637 {
1638 if (SYMBOLP (foundry))
1639 {
1640 foundry = SYMBOL_NAME (foundry);
1641 len += 9 + SBYTES (foundry); /* ":foundry=NAME" */
1642 }
1643 else
1644 foundry = Qnil;
1645 }
ec6fe57c 1646
35027d0c 1647 for (i = 0; i < 3; i++)
a9262bb8 1648 {
35027d0c
KH		 1649 styles[i] = font_style_symbolic (font, FONT_WEIGHT_INDEX + i, 0);
1650 if (! NILP (styles[i]))
1651 len += sprintf (work, ":%s=%s", style_names[i],
1652 SDATA (SYMBOL_NAME (styles[i])));
ec6fe57c 1653 }
35027d0c
KH		 1654
1655 if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
1656 len += sprintf (work, ":dpi=%d", dpi);
1657 if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
1658 len += strlen (":spacing=100");
1659 if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
1660 len += strlen (":scalable=false"); /* or ":scalable=true" */
1661 for (tail = AREF (font, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
ec6fe57c 1662 {
35027d0c
KH		 1663 Lisp_Object key = XCAR (XCAR (tail)), val = XCDR (XCAR (tail));
1664
1665 len += SBYTES (SYMBOL_NAME (key)) + 1; /* for :KEY= */
1666 if (STRINGP (val))
1667 len += SBYTES (val);
1668 else if (INTEGERP (val))
1669 len += sprintf (work, "%d", XINT (val));
1670 else if (SYMBOLP (val))
1671 len += (NILP (val) ? 5 : 4); /* for "false" or "true" */
ec6fe57c
KH		 1672 }
1673
ef18374f
KH		 1674 if (len > nbytes)
1675 return -1;
1676 p = name;
b1868a1a
CY		 1677 if (! NILP (family))
1678 p += sprintf (p, "%s", SDATA (family));
ec6fe57c
KH		 1679 if (point_size > 0)
1680 {
1681 if (p == name)
1682 p += sprintf (p, "%d", point_size);
1683 else
1684 p += sprintf (p, "-%d", point_size);
1685 }
ef18374f
KH		 1686 else if (pixel_size > 0)
1687 p += sprintf (p, ":pixelsize=%d", pixel_size);
35027d0c 1688 if (! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
a9262bb8
KH		 1689 p += sprintf (p, ":foundry=%s",
1690 SDATA (SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX))));
1691 for (i = 0; i < 3; i++)
35027d0c 1692 if (! NILP (styles[i]))
a9262bb8 1693 p += sprintf (p, ":%s=%s", style_names[i],
35027d0c
KH		 1694 SDATA (SYMBOL_NAME (styles[i])));
1695 if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
1696 p += sprintf (p, ":dpi=%d", XINT (AREF (font, FONT_DPI_INDEX)));
1697 if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
1698 p += sprintf (p, ":spacing=%d", XINT (AREF (font, FONT_SPACING_INDEX)));
1699 if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
1700 {
1701 if (XINT (AREF (font, FONT_AVGWIDTH_INDEX)) == 0)
1702 p += sprintf (p, ":scalable=true");
1703 else
1704 p += sprintf (p, ":scalable=false");
1705 }
ef18374f
KH		 1706 return (p - name);
1707}
1708
b1868a1a
CY		 1709/* Store GTK-style font name of FONT (font-spec or font-entity) in
1710 NAME (NBYTES length), and return the name length. F is the frame
1711 on which the font is displayed; it is used to calculate the point
1712 size. */
1713
1714int
1715font_unparse_gtkname (font, f, name, nbytes)
1716 Lisp_Object font;
1717 struct frame *f;
1718 char *name;
1719 int nbytes;
1720{
1721 char *p;
1722 int len = 1;
1723 Lisp_Object family, weight, slant, size;
1724 int point_size = -1;
1725
1726 family = AREF (font, FONT_FAMILY_INDEX);
1727 if (! NILP (family))
1728 {
1729 if (! SYMBOLP (family))
1730 return -1;
1731 family = SYMBOL_NAME (family);
1732 len += SBYTES (family);
1733 }
1734
1735 weight = font_style_symbolic (font, FONT_WEIGHT_INDEX, 0);
93eed26b 1736 if (EQ (weight, Qnormal))
b1868a1a
CY		 1737 weight = Qnil;
1738 else if (! NILP (weight))
1739 {
1740 weight = SYMBOL_NAME (weight);
1741 len += SBYTES (weight);
1742 }
1743
1744 slant = font_style_symbolic (font, FONT_SLANT_INDEX, 0);
93eed26b 1745 if (EQ (slant, Qnormal))
b1868a1a
CY		 1746 slant = Qnil;
1747 else if (! NILP (slant))
1748 {
1749 slant = SYMBOL_NAME (slant);
1750 len += SBYTES (slant);
1751 }
1752
1753 size = AREF (font, FONT_SIZE_INDEX);
1754 /* Convert pixel size to point size. */
1755 if (INTEGERP (size))
1756 {
1757 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
1758 int dpi = 75;
1759 if (INTEGERP (font_dpi))
1760 dpi = XINT (font_dpi);
1761 else if (f)
1762 dpi = f->resy;
1763 point_size = PIXEL_TO_POINT (XINT (size), dpi);
1764 len += 11;
1765 }
1766 else if (FLOATP (size))
1767 {
1768 point_size = (int) XFLOAT_DATA (size);
1769 len += 11;
1770 }
1771
1772 if (len > nbytes)
1773 return -1;
1774
1775 p = name + sprintf (name, "%s", SDATA (family));
1776
1777 if (! NILP (weight))
1778 {
1779 char *q = p;
1780 p += sprintf (p, " %s", SDATA (weight));
1781 q[1] = toupper (q[1]);
1782 }
1783
1784 if (! NILP (slant))
1785 {
1786 char *q = p;
1787 p += sprintf (p, " %s", SDATA (slant));
1788 q[1] = toupper (q[1]);
1789 }
1790
1791 if (point_size > 0)
1792 p += sprintf (p, " %d", point_size);
1793
1794 return (p - name);
1795}
1796
ef18374f
KH		 1797/* Parse NAME (null terminated) and store information in FONT
1798 (font-spec or font-entity). If NAME is successfully parsed, return
35027d0c 1799 0. Otherwise return -1. */
ef18374f
KH		 1800
1801static int
ec6fe57c 1802font_parse_name (name, font)
ef18374f
KH		 1803 char *name;
1804 Lisp_Object font;
ef18374f
KH		 1805{
1806 if (name[0] == '-' || index (name, '*'))
e950d6f1 1807 return font_parse_xlfd (name, font);
ec6fe57c 1808 return font_parse_fcname (name, font);
ef18374f
KH		 1809}
1810
35027d0c
KH		 1811
1812/* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1813 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1814 part. */
45eb10fb 1815
c2f5bfd6 1816void
35027d0c
KH		 1817font_parse_family_registry (family, registry, font_spec)
1818 Lisp_Object family, registry, font_spec;
c2f5bfd6 1819{
35027d0c
KH		 1820 int len;
1821 char *p0, *p1;
1822
d0ab1ebe
KH		 1823 if (! NILP (family)
1824 && NILP (AREF (font_spec, FONT_FAMILY_INDEX)))
c2f5bfd6 1825 {
35027d0c
KH		 1826 CHECK_STRING (family);
1827 len = SBYTES (family);
1828 p0 = (char *) SDATA (family);
1829 p1 = index (p0, '-');
1830 if (p1)
c2f5bfd6 1831 {
d0ab1ebe
KH		 1832 if ((*p0 != '*' || p1 - p0 > 1)
1833 && NILP (AREF (font_spec, FONT_FOUNDRY_INDEX)))
2f286d4f 1834 Ffont_put (font_spec, QCfoundry, font_intern_prop (p0, p1 - p0, 1));
35027d0c
KH		 1835 p1++;
1836 len -= p1 - p0;
2f286d4f 1837 Ffont_put (font_spec, QCfamily, font_intern_prop (p1, len, 1));
c2f5bfd6 1838 }
35027d0c
KH		 1839 else
1840 ASET (font_spec, FONT_FAMILY_INDEX, Fintern (family, Qnil));
c2f5bfd6 1841 }
35027d0c 1842 if (! NILP (registry))
c2f5bfd6 1843 {
35027d0c
KH		 1844 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1845 CHECK_STRING (registry);
1846 len = SBYTES (registry);
1847 p0 = (char *) SDATA (registry);
1848 p1 = index (p0, '-');
1849 if (! p1)
c2f5bfd6 1850 {
35027d0c
KH		 1851 if (SDATA (registry)[len - 1] == '*')
1852 registry = concat2 (registry, build_string ("-*"));
1853 else
1854 registry = concat2 (registry, build_string ("*-*"));
c2f5bfd6 1855 }
35027d0c
KH		 1856 registry = Fdowncase (registry);
1857 ASET (font_spec, FONT_REGISTRY_INDEX, Fintern (registry, Qnil));
c2f5bfd6
KH		 1858 }
1859}
1860
45eb10fb 1861\f
35027d0c
KH		 1862/* This part (through the next ^L) is still experimental and not
1863 tested much. We may drastically change codes. */
10d16101 1864
45eb10fb 1865/* OTF handler */
10d16101 1866
6a3dadd2
KH		 1867#if 0
1868
e950d6f1
KH		 1869#define LGSTRING_HEADER_SIZE 6
1870#define LGSTRING_GLYPH_SIZE 8
1871
1872static int
1873check_gstring (gstring)
1874 Lisp_Object gstring;
1875{
1876 Lisp_Object val;
1877 int i, j;
1878
1879 CHECK_VECTOR (gstring);
1880 val = AREF (gstring, 0);
1881 CHECK_VECTOR (val);
1882 if (ASIZE (val) < LGSTRING_HEADER_SIZE)
1883 goto err;
1884 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
f9ffa1ea
SM		 1885 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
1886 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
1887 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
1888 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
1889 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
1890 CHECK_NATNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
1891 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
1892 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
1893 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
1894 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
e950d6f1 1895
071132a9 1896 for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
e950d6f1
KH		 1897 {
1898 val = LGSTRING_GLYPH (gstring, i);
1899 CHECK_VECTOR (val);
1900 if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
1901 goto err;
f9ffa1ea 1902 if (NILP (AREF (val, LGLYPH_IX_CHAR)))
e950d6f1 1903 break;
f9ffa1ea
SM		 1904 CHECK_NATNUM (AREF (val, LGLYPH_IX_FROM));
1905 CHECK_NATNUM (AREF (val, LGLYPH_IX_TO));
1906 CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
1907 if (!NILP (AREF (val, LGLYPH_IX_CODE)))
1908 CHECK_NATNUM (AREF (val, LGLYPH_IX_CODE));
1909 if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
1910 CHECK_NATNUM (AREF (val, LGLYPH_IX_WIDTH));
1911 if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
e950d6f1 1912 {
f9ffa1ea 1913 val = AREF (val, LGLYPH_IX_ADJUSTMENT);
e950d6f1
KH		 1914 CHECK_VECTOR (val);
1915 if (ASIZE (val) < 3)
1916 goto err;
1917 for (j = 0; j < 3; j++)
1918 CHECK_NUMBER (AREF (val, j));
1919 }
1920 }
1921 return i;
1922 err:
1923 error ("Invalid glyph-string format");
1924 return -1;
1925}
1926
cf385d93
KH		 1927static void
1928check_otf_features (otf_features)
1929 Lisp_Object otf_features;
1930{
35027d0c 1931 Lisp_Object val;
cf385d93
KH		 1932
1933 CHECK_CONS (otf_features);
1934 CHECK_SYMBOL (XCAR (otf_features));
1935 otf_features = XCDR (otf_features);
1936 CHECK_CONS (otf_features);
1937 CHECK_SYMBOL (XCAR (otf_features));
1938 otf_features = XCDR (otf_features);
1939 for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
1940 {
1941 CHECK_SYMBOL (Fcar (val));
1942 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1943 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val)));
1944 }
1945 otf_features = XCDR (otf_features);
1946 for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
1947 {
1948 CHECK_SYMBOL (Fcar (val));
1949 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1950 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val)));
1951 }
1952}
1953
c2f5bfd6
KH		 1954#ifdef HAVE_LIBOTF
1955#include <otf.h>
1956
733fd013 1957Lisp_Object otf_list;
c2f5bfd6
KH		 1958
1959static Lisp_Object
1960otf_tag_symbol (tag)
1961 OTF_Tag tag;
1962{
1963 char name[5];
1964
1965 OTF_tag_name (tag, name);
1966 return Fintern (make_unibyte_string (name, 4), Qnil);
1967}
1968
1969static OTF *
35027d0c
KH		 1970otf_open (file)
1971 Lisp_Object file;
c2f5bfd6 1972{
35027d0c 1973 Lisp_Object val = Fassoc (file, otf_list);
733fd013
KH		 1974 OTF *otf;
1975
1976 if (! NILP (val))
1977 otf = XSAVE_VALUE (XCDR (val))->pointer;
1978 else
c2f5bfd6 1979 {
35027d0c 1980 otf = STRINGP (file) ? OTF_open ((char *) SDATA (file)) : NULL;
733fd013 1981 val = make_save_value (otf, 0);
35027d0c 1982 otf_list = Fcons (Fcons (file, val), otf_list);
c2f5bfd6 1983 }
733fd013 1984 return otf;
c2f5bfd6
KH		 1985}
1986
1987
1988/* Return a list describing which scripts/languages FONT supports by
1989 which GSUB/GPOS features of OpenType tables. See the comment of
51c01100 1990 (struct font_driver).otf_capability. */
c2f5bfd6
KH		 1991
1992Lisp_Object
1993font_otf_capability (font)
1994 struct font *font;
1995{
1996 OTF *otf;
1997 Lisp_Object capability = Fcons (Qnil, Qnil);
1998 int i;
1999
35027d0c 2000 otf = otf_open (font->props[FONT_FILE_INDEX]);
c2f5bfd6
KH		 2001 if (! otf)
2002 return Qnil;
2003 for (i = 0; i < 2; i++)
2004 {
2005 OTF_GSUB_GPOS *gsub_gpos;
2006 Lisp_Object script_list = Qnil;
2007 int j;
2008
2009 if (OTF_get_features (otf, i == 0) < 0)
2010 continue;
2011 gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
2012 for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
2013 {
2014 OTF_Script *script = gsub_gpos->ScriptList.Script + j;
2015 Lisp_Object langsys_list = Qnil;
2016 Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
2017 int k;
2018
2019 for (k = script->LangSysCount; k >= 0; k--)
2020 {
2021 OTF_LangSys *langsys;
2022 Lisp_Object feature_list = Qnil;
2023 Lisp_Object langsys_tag;
2024 int l;
2025
e80e09b4 2026 if (k == script->LangSysCount)
c2f5bfd6
KH		 2027 {
2028 langsys = &script->DefaultLangSys;
2029 langsys_tag = Qnil;
2030 }
2031 else
2032 {
2033 langsys = script->LangSys + k;
2034 langsys_tag
2035 = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
2036 }
e80e09b4 2037 for (l = langsys->FeatureCount - 1; l >= 0; l--)
c2f5bfd6
KH		 2038 {
2039 OTF_Feature *feature
2040 = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
2041 Lisp_Object feature_tag
2042 = otf_tag_symbol (feature->FeatureTag);
2043
2044 feature_list = Fcons (feature_tag, feature_list);
2045 }
2046 langsys_list = Fcons (Fcons (langsys_tag, feature_list),
2047 langsys_list);
2048 }
2049 script_list = Fcons (Fcons (script_tag, langsys_list),
2050 script_list);
2051 }
2052
2053 if (i == 0)
2054 XSETCAR (capability, script_list);
2055 else
2056 XSETCDR (capability, script_list);
2057 }
2058
2059 return capability;
2060}
2061
733fd013
KH		 2062/* Parse OTF features in SPEC and write a proper features spec string
2063 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2064 assured that the sufficient memory has already allocated for
2065 FEATURES. */
2066
e80e09b4 2067static void
733fd013 2068generate_otf_features (spec, features)
c2f5bfd6 2069 Lisp_Object spec;
733fd013 2070 char *features;
c2f5bfd6
KH		 2071{
2072 Lisp_Object val;
35027d0c 2073 char *p;
c2f5bfd6
KH		 2074 int asterisk;
2075
733fd013 2076 p = features;
e80e09b4 2077 *p = '\0';
c2f5bfd6
KH		 2078 for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
2079 {
2080 val = XCAR (spec);
e80e09b4
KH		 2081 CHECK_SYMBOL (val);
2082 if (p > features)
733fd013 2083 *p++ = ',';
c2f5bfd6
KH		 2084 if (SREF (SYMBOL_NAME (val), 0) == '*')
2085 {
2086 asterisk = 1;
e80e09b4 2087 *p++ = '*';
c2f5bfd6
KH		 2088 }
2089 else if (! asterisk)
e80e09b4
KH		 2090 {
2091 val = SYMBOL_NAME (val);
e80e09b4
KH		 2092 p += sprintf (p, "%s", SDATA (val));
2093 }
c2f5bfd6 2094 else
e80e09b4
KH		 2095 {
2096 val = SYMBOL_NAME (val);
e80e09b4
KH		 2097 p += sprintf (p, "~%s", SDATA (val));
2098 }
c2f5bfd6 2099 }
e80e09b4
KH		 2100 if (CONSP (spec))
2101 error ("OTF spec too long");
2102}
2103
733fd013
KH		 2104Lisp_Object
2105font_otf_DeviceTable (device_table)
2106 OTF_DeviceTable *device_table;
2107{
2108 int len = device_table->StartSize - device_table->EndSize + 1;
2109
2110 return Fcons (make_number (len),
2111 make_unibyte_string (device_table->DeltaValue, len));
2112}
2113
2114Lisp_Object
2115font_otf_ValueRecord (value_format, value_record)
2116 int value_format;
2117 OTF_ValueRecord *value_record;
2118{
2119 Lisp_Object val = Fmake_vector (make_number (8), Qnil);
2120
2121 if (value_format & OTF_XPlacement)
43c0454d 2122 ASET (val, 0, make_number (value_record->XPlacement));
733fd013 2123 if (value_format & OTF_YPlacement)
43c0454d 2124 ASET (val, 1, make_number (value_record->YPlacement));
733fd013 2125 if (value_format & OTF_XAdvance)
43c0454d 2126 ASET (val, 2, make_number (value_record->XAdvance));
733fd013 2127 if (value_format & OTF_YAdvance)
43c0454d 2128 ASET (val, 3, make_number (value_record->YAdvance));
733fd013
KH		 2129 if (value_format & OTF_XPlaDevice)
2130 ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
2131 if (value_format & OTF_YPlaDevice)
2132 ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
2133 if (value_format & OTF_XAdvDevice)
2134 ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
2135 if (value_format & OTF_YAdvDevice)
2136 ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
2137 return val;
2138}
2139
2140Lisp_Object
2141font_otf_Anchor (anchor)
2142 OTF_Anchor *anchor;
2143{
2144 Lisp_Object val;
2145
2146 val = Fmake_vector (make_number (anchor->AnchorFormat + 1), Qnil);
2147 ASET (val, 0, make_number (anchor->XCoordinate));
2148 ASET (val, 1, make_number (anchor->YCoordinate));
2149 if (anchor->AnchorFormat == 2)
2150 ASET (val, 2, make_number (anchor->f.f1.AnchorPoint));
2151 else
2152 {
2153 ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
2154 ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
2155 }
2156 return val;
2157}
c2f5bfd6 2158#endif /* HAVE_LIBOTF */
6a3dadd2 2159#endif /* 0 */
c2f5bfd6 2160
c2f5bfd6
KH		 2161\f
2162/* Font sorting */
2163
4007dd1c 2164static unsigned font_score P_ ((Lisp_Object, Lisp_Object *));
c2f5bfd6
KH		 2165static int font_compare P_ ((const void *, const void *));
2166static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object,
7181ea6a 2167 Lisp_Object, int));
c2f5bfd6
KH		 2168
2169/* We sort fonts by scoring each of them against a specified
2170 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2171 the value is, the closer the font is to the font-spec.
2172
4007dd1c
KH		 2173 The lowest 2 bits of the score is used for driver type. The font
2174 available by the most preferred font driver is 0.
35027d0c 2175
4007dd1c 2176 Each 7-bit in the higher 28 bits are used for numeric properties
c2f5bfd6
KH		 2177 WEIGHT, SLANT, WIDTH, and SIZE. */
2178
2179/* How many bits to shift to store the difference value of each font
35027d0c
KH		 2180 property in a score. Note that flots for FONT_TYPE_INDEX and
2181 FONT_REGISTRY_INDEX are not used. */
c2f5bfd6
KH		 2182static int sort_shift_bits[FONT_SIZE_INDEX + 1];
2183
9331887d
KH		 2184/* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2185 The return value indicates how different ENTITY is compared with
51c13510 2186 SPEC_PROP. */
c2f5bfd6
KH		 2187
2188static unsigned
4007dd1c 2189font_score (entity, spec_prop)
9331887d 2190 Lisp_Object entity, *spec_prop;
c2f5bfd6
KH		 2191{
2192 unsigned score = 0;
2193 int i;
c2f5bfd6 2194
35027d0c
KH		 2195 /* Score three style numeric fields. Maximum difference is 127. */
2196 for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
2197 if (! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i]))
2198 {
2199 int diff = (XINT (AREF (entity, i)) >> 8) - (XINT (spec_prop[i]) >> 8);
2200
2201 if (diff < 0)
2202 diff = - diff;
f4cc0153
KH		 2203 if (diff > 0)
2204 score |= min (diff, 127) << sort_shift_bits[i];
35027d0c
KH		 2205 }
2206
2207 /* Score the size. Maximum difference is 127. */
2208 i = FONT_SIZE_INDEX;
2641e213 2209 if (! NILP (spec_prop[i]) && XINT (AREF (entity, i)) > 0)
35027d0c
KH		 2210 {
2211 /* We use the higher 6-bit for the actual size difference. The
2212 lowest bit is set if the DPI is different. */
2213 int diff = XINT (spec_prop[i]) - XINT (AREF (entity, i));
2214
2215 if (diff < 0)
2216 diff = - diff;
d0ab1ebe 2217 diff <<= 1;
35027d0c
KH		 2218 if (! NILP (spec_prop[FONT_DPI_INDEX])
2219 && ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
2220 diff |= 1;
2221 score |= min (diff, 127) << sort_shift_bits[FONT_SIZE_INDEX];
c2f5bfd6
KH		 2222 }
2223
2224 return score;
2225}
2226
2227
2228/* The comparison function for qsort. */
2229
2230static int
2231font_compare (d1, d2)
2232 const void *d1, *d2;
2233{
35027d0c 2234 return (*(unsigned *) d1 - *(unsigned *) d2);
c2f5bfd6
KH		 2235}
2236
2237
2238/* The structure for elements being sorted by qsort. */
2239struct font_sort_data
2240{
2241 unsigned score;
2242 Lisp_Object entity;
2243};
2244
2245
2246/* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2247 If PREFER specifies a point-size, calculate the corresponding
9331887d 2248 pixel-size from QCdpi property of PREFER or from the Y-resolution
7181ea6a 2249 of FRAME before sorting.
35027d0c
KH		 2250
2251 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2252 return the sorted VEC. */
c2f5bfd6
KH		 2253
2254static Lisp_Object
7181ea6a
KH		 2255font_sort_entites (vec, prefer, frame, best_only)
2256 Lisp_Object vec, prefer, frame;
35027d0c 2257 int best_only;
c2f5bfd6 2258{
9331887d 2259 Lisp_Object prefer_prop[FONT_SPEC_MAX];
c2f5bfd6
KH		 2260 int len, i;
2261 struct font_sort_data *data;
35027d0c 2262 unsigned best_score;
4007dd1c
KH		 2263 Lisp_Object best_entity, driver_type;
2264 int driver_order;
2265 struct frame *f = XFRAME (frame);
2266 struct font_driver_list *list;
c2f5bfd6
KH		 2267 USE_SAFE_ALLOCA;
2268
2269 len = ASIZE (vec);
2270 if (len <= 1)
35027d0c 2271 return best_only ? AREF (vec, 0) : vec;
c2f5bfd6 2272
2641e213 2273 for (i = FONT_WEIGHT_INDEX; i <= FONT_DPI_INDEX; i++)
9331887d 2274 prefer_prop[i] = AREF (prefer, i);
9331887d
KH		 2275 if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
2276 prefer_prop[FONT_SIZE_INDEX]
2277 = make_number (font_pixel_size (XFRAME (frame), prefer));
2278
c2f5bfd6
KH		 2279 /* Scoring and sorting. */
2280 SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len);
35027d0c 2281 best_score = 0xFFFFFFFF;
4007dd1c
KH		 2282 /* We are sure that the length of VEC > 1. */
2283 driver_type = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
2284 for (driver_order = 0, list = f->font_driver_list; list;
2285 driver_order++, list = list->next)
2286 if (EQ (driver_type, list->driver->type))
2287 break;
2288 best_entity = data[0].entity = AREF (vec, 0);
2289 best_score = data[0].score
2290 = font_score (data[0].entity, prefer_prop) | driver_order;
c2f5bfd6
KH		 2291 for (i = 0; i < len; i++)
2292 {
4007dd1c
KH		 2293 if (!EQ (driver_type, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
2294 for (driver_order = 0, list = f->font_driver_list; list;
2295 driver_order++, list = list->next)
2296 if (EQ (driver_type, list->driver->type))
2297 break;
c2f5bfd6 2298 data[i].entity = AREF (vec, i);
4007dd1c 2299 data[i].score = font_score (data[i].entity, prefer_prop) | driver_order;
35027d0c
KH		 2300 if (best_only && best_score > data[i].score)
2301 {
2302 best_score = data[i].score;
2303 best_entity = data[i].entity;
2304 if (best_score == 0)
2305 break;
2306 }
c2f5bfd6 2307 }
7181ea6a 2308 if (! best_only)
35027d0c
KH		 2309 {
2310 qsort (data, len, sizeof *data, font_compare);
2311 for (i = 0; i < len; i++)
2312 ASET (vec, i, data[i].entity);
2313 }
2314 else
2315 vec = best_entity;
c2f5bfd6
KH		 2316 SAFE_FREE ();
2317
d0ab1ebe 2318 font_add_log ("sort-by", prefer, vec);
c2f5bfd6
KH		 2319 return vec;
2320}
2321
2322\f
2323/* API of Font Service Layer. */
2324
45eb10fb
KH		 2325/* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2326 sort_shift_bits. Finternal_set_font_selection_order calls this
2327 function with font_sort_order after setting up it. */
2328
c2f5bfd6
KH		 2329void
2330font_update_sort_order (order)
2331 int *order;
2332{
35027d0c 2333 int i, shift_bits;
c2f5bfd6 2334
943b7eea 2335 for (i = 0, shift_bits = 23; i < 4; i++, shift_bits -= 7)
c2f5bfd6
KH		 2336 {
2337 int xlfd_idx = order[i];
2338
2339 if (xlfd_idx == XLFD_WEIGHT_INDEX)
2340 sort_shift_bits[FONT_WEIGHT_INDEX] = shift_bits;
2341 else if (xlfd_idx == XLFD_SLANT_INDEX)
2342 sort_shift_bits[FONT_SLANT_INDEX] = shift_bits;
2343 else if (xlfd_idx == XLFD_SWIDTH_INDEX)
2344 sort_shift_bits[FONT_WIDTH_INDEX] = shift_bits;
2345 else
2346 sort_shift_bits[FONT_SIZE_INDEX] = shift_bits;
2347 }
2348}
2349
51c13510
KH		 2350static int
2351font_check_otf_features (script, langsys, features, table)
2352 Lisp_Object script, langsys, features, table;
2353{
2354 Lisp_Object val;
2355 int negative;
2356
2357 table = assq_no_quit (script, table);
2358 if (NILP (table))
2359 return 0;
2360 table = XCDR (table);
2361 if (! NILP (langsys))
2362 {
2363 table = assq_no_quit (langsys, table);
2364 if (NILP (table))
2365 return 0;
2366 }
2367 else
2368 {
2369 val = assq_no_quit (Qnil, table);
2370 if (NILP (val))
2371 table = XCAR (table);
2372 else
2373 table = val;
2374 }
2375 table = XCDR (table);
2376 for (negative = 0; CONSP (features); features = XCDR (features))
2377 {
2378 if (NILP (XCAR (features)))
2379 negative = 1;
2380 if (NILP (Fmemq (XCAR (features), table)) != negative)
2381 return 0;
2382 }
2383 return 1;
2384}
2385
2386/* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2387
2388static int
3cba9369 2389font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
51c13510
KH		 2390{
2391 Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
2392
2393 script = XCAR (spec);
2394 spec = XCDR (spec);
2395 if (! NILP (spec))
2396 {
2397 langsys = XCAR (spec);
2398 spec = XCDR (spec);
2399 if (! NILP (spec))
2400 {
2401 gsub = XCAR (spec);
2402 spec = XCDR (spec);
2403 if (! NILP (spec))
2404 gpos = XCAR (spec);
2405 }
2406 }
2407
2408 if (! NILP (gsub) && ! font_check_otf_features (script, langsys, gsub,
2409 XCAR (otf_capability)))
2410 return 0;
2411 if (! NILP (gpos) && ! font_check_otf_features (script, langsys, gpos,
2412 XCDR (otf_capability)))
2413 return 0;
2414 return 1;
2415}
2416
45eb10fb 2417
51c13510
KH		 2418
2419/* Check if FONT (font-entity or font-object) matches with the font
2420 specification SPEC. */
45eb10fb 2421
ef18374f 2422int
51c13510
KH		 2423font_match_p (spec, font)
2424 Lisp_Object spec, font;
ef18374f 2425{
51c13510
KH		 2426 Lisp_Object prop[FONT_SPEC_MAX], *props;
2427 Lisp_Object extra, font_extra;
ef18374f
KH		 2428 int i;
2429
51c13510
KH		 2430 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
2431 if (! NILP (AREF (spec, i))
2432 && ! NILP (AREF (font, i))
2433 && ! EQ (AREF (spec, i), AREF (font, i)))
2434 return 0;
2435 props = XFONT_SPEC (spec)->props;
2436 if (FLOATP (props[FONT_SIZE_INDEX]))
2437 {
2438 for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++)
2439 prop[i] = AREF (spec, i);
2440 prop[FONT_SIZE_INDEX]
2441 = make_number (font_pixel_size (XFRAME (selected_frame), spec));
2442 props = prop;
2443 }
2444
2445 if (font_score (font, props) > 0)
2446 return 0;
2447 extra = AREF (spec, FONT_EXTRA_INDEX);
2448 font_extra = AREF (font, FONT_EXTRA_INDEX);
2449 for (; CONSP (extra); extra = XCDR (extra))
35027d0c 2450 {
51c13510
KH		 2451 Lisp_Object key = XCAR (XCAR (extra));
2452 Lisp_Object val = XCDR (XCAR (extra)), val2;
2453
2454 if (EQ (key, QClang))
2455 {
2456 val2 = assq_no_quit (key, font_extra);
2457 if (NILP (val2))
2458 return 0;
2459 val2 = XCDR (val2);
2460 if (CONSP (val))
2461 {
2462 if (! CONSP (val2))
2463 return 0;
2464 while (CONSP (val))
2465 if (NILP (Fmemq (val, val2)))
2466 return 0;
2467 }
2468 else
2469 if (CONSP (val2)
2470 ? NILP (Fmemq (val, XCDR (val2)))
2471 : ! EQ (val, val2))
2472 return 0;
2473 }
2474 else if (EQ (key, QCscript))
2475 {
2476 val2 = assq_no_quit (val, Vscript_representative_chars);
5bdd4dd2
KH		 2477 if (CONSP (val2))
2478 {
2479 val2 = XCDR (val2);
2480 if (CONSP (val2))
2481 {
2482 /* All characters in the list must be supported. */
2483 for (; CONSP (val2); val2 = XCDR (val2))
2484 {
2485 if (! NATNUMP (XCAR (val2)))
2486 continue;
2487 if (font_encode_char (font, XFASTINT (XCAR (val2)))
2488 == FONT_INVALID_CODE)
2489 return 0;
2490 }
2491 }
2492 else if (VECTORP (val2))
2493 {
2494 /* At most one character in the vector must be supported. */
2495 for (i = 0; i < ASIZE (val2); i++)
2496 {
2497 if (! NATNUMP (AREF (val2, i)))
2498 continue;
2499 if (font_encode_char (font, XFASTINT (AREF (val2, i)))
2500 != FONT_INVALID_CODE)
2501 return break;
2502 }
2503 if (i == ASIZE (val2))
2504 return 0;
2505 }
2506 }
51c13510
KH		 2507 }
2508 else if (EQ (key, QCotf))
2509 {
2510 struct font *fontp;
2511
2512 if (! FONT_OBJECT_P (font))
2513 return 0;
2514 fontp = XFONT_OBJECT (font);
2515 if (! fontp->driver->otf_capability)
2516 return 0;
2517 val2 = fontp->driver->otf_capability (fontp);
2518 if (NILP (val2) || ! font_check_otf (val, val2))
2519 return 0;
2520 }
35027d0c
KH		 2521 }
2522
51c13510 2523 return 1;
ef18374f 2524}
ca4da08a 2525\f
819e81df 2526
ca4da08a
KH		 2527/* Font cache
2528
2529 Each font backend has the callback function get_cache, and it
2530 returns a cons cell of which cdr part can be freely used for
2531 caching fonts. The cons cell may be shared by multiple frames
2532 and/or multiple font drivers. So, we arrange the cdr part as this:
2533
2534 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2535
2536 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2537 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2538 cons (FONT-SPEC FONT-ENTITY ...). */
2539
2540static void font_prepare_cache P_ ((FRAME_PTR, struct font_driver *));
2541static void font_finish_cache P_ ((FRAME_PTR, struct font_driver *));
2542static Lisp_Object font_get_cache P_ ((FRAME_PTR, struct font_driver *));
2543static void font_clear_cache P_ ((FRAME_PTR, Lisp_Object,
2544 struct font_driver *));
2545
2546static void
2547font_prepare_cache (f, driver)
2548 FRAME_PTR f;
2549 struct font_driver *driver;
2550{
2551 Lisp_Object cache, val;
2552
2553 cache = driver->get_cache (f);
2554 val = XCDR (cache);
2555 while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
2556 val = XCDR (val);
2557 if (NILP (val))
2558 {
2559 val = Fcons (driver->type, Fcons (make_number (1), Qnil));
2560 XSETCDR (cache, Fcons (val, XCDR (cache)));
2561 }
2562 else
2563 {
2564 val = XCDR (XCAR (val));
2565 XSETCAR (val, make_number (XINT (XCAR (val)) + 1));
2566 }
2567}
2568
43c0454d 2569
ca4da08a
KH		 2570static void
2571font_finish_cache (f, driver)
2572 FRAME_PTR f;
2573 struct font_driver *driver;
2574{
2575 Lisp_Object cache, val, tmp;
2576
2577
2578 cache = driver->get_cache (f);
2579 val = XCDR (cache);
2580 while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
2581 cache = val, val = XCDR (val);
d0ab1ebe 2582 font_assert (! NILP (val));
ca4da08a 2583 tmp = XCDR (XCAR (val));
43c0454d 2584 XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1));
ca4da08a
KH		 2585 if (XINT (XCAR (tmp)) == 0)
2586 {
2587 font_clear_cache (f, XCAR (val), driver);
2588 XSETCDR (cache, XCDR (val));
2589 }
ca4da08a
KH		 2590}
2591
43c0454d 2592
ca4da08a
KH		 2593static Lisp_Object
2594font_get_cache (f, driver)
2595 FRAME_PTR f;
2596 struct font_driver *driver;
2597{
2598 Lisp_Object val = driver->get_cache (f);
2599 Lisp_Object type = driver->type;
2600
d0ab1ebe 2601 font_assert (CONSP (val));
ca4da08a 2602 for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val));
d0ab1ebe 2603 font_assert (CONSP (val));
ca4da08a
KH		 2604 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2605 val = XCDR (XCAR (val));
2606 return val;
2607}
2608
43c0454d
KH		 2609static int num_fonts;
2610
ca4da08a
KH		 2611static void
2612font_clear_cache (f, cache, driver)
2613 FRAME_PTR f;
2614 Lisp_Object cache;
2615 struct font_driver *driver;
2616{
2617 Lisp_Object tail, elt;
51c01100 2618
ca4da08a
KH		 2619 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2620 for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
2621 {
2622 elt = XCAR (tail);
be9442ad 2623 if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)) && VECTORP (XCDR (elt)))
ca4da08a
KH		 2624 {
2625 Lisp_Object vec = XCDR (elt);
2626 int i;
2627
2628 for (i = 0; i < ASIZE (vec); i++)
2629 {
2630 Lisp_Object entity = AREF (vec, i);
2631
2632 if (EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
2633 {
2634 Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
2635
2636 for (; CONSP (objlist); objlist = XCDR (objlist))
2637 {
2638 Lisp_Object val = XCAR (objlist);
35027d0c 2639 struct font *font = XFONT_OBJECT (val);
ca4da08a 2640
5e634ec9
KH		 2641 if (! NILP (AREF (val, FONT_TYPE_INDEX)))
2642 {
2643 font_assert (font && driver == font->driver);
2644 driver->close (f, font);
2645 num_fonts--;
2646 }
ca4da08a
KH		 2647 }
2648 if (driver->free_entity)
2649 driver->free_entity (entity);
2650 }
2651 }
2652 }
2653 }
2654 XSETCDR (cache, Qnil);
2655}
2656\f
2657
c2f5bfd6
KH		 2658static Lisp_Object scratch_font_spec, scratch_font_prefer;
2659
35027d0c
KH		 2660Lisp_Object
2661font_delete_unmatched (list, spec, size)
2662 Lisp_Object list, spec;
2663 int size;
2664{
d0ab1ebe 2665 Lisp_Object entity, val;
35027d0c 2666 enum font_property_index prop;
45eb10fb 2667
d0ab1ebe 2668 for (val = Qnil; CONSP (list); list = XCDR (list))
35027d0c 2669 {
d0ab1ebe 2670 entity = XCAR (list);
35027d0c
KH		 2671 for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
2672 if (INTEGERP (AREF (spec, prop))
2673 && ((XINT (AREF (spec, prop)) >> 8)
2674 != (XINT (AREF (entity, prop)) >> 8)))
2675 prop = FONT_SPEC_MAX;
7181ea6a 2676 if (prop < FONT_SPEC_MAX
35027d0c
KH		 2677 && size
2678 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
2679 {
2680 int diff = XINT (AREF (entity, FONT_SIZE_INDEX)) - size;
c2f5bfd6 2681
35027d0c
KH		 2682 if (diff != 0
2683 && (diff < 0 ? -diff > FONT_PIXEL_SIZE_QUANTUM
2684 : diff > FONT_PIXEL_SIZE_QUANTUM))
2685 prop = FONT_SPEC_MAX;
2686 }
7181ea6a
KH		 2687 if (prop < FONT_SPEC_MAX
2688 && INTEGERP (AREF (spec, FONT_DPI_INDEX))
2689 && INTEGERP (AREF (entity, FONT_DPI_INDEX))
c576d6dc 2690 && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
7181ea6a
KH		 2691 && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX)))
2692 prop = FONT_SPEC_MAX;
2693 if (prop < FONT_SPEC_MAX
2694 && INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX))
2695 && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
c576d6dc 2696 && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0
7181ea6a
KH		 2697 && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX),
2698 AREF (entity, FONT_AVGWIDTH_INDEX)))
2699 prop = FONT_SPEC_MAX;
35027d0c 2700 if (prop < FONT_SPEC_MAX)
d0ab1ebe 2701 val = Fcons (entity, val);
35027d0c 2702 }
d0ab1ebe 2703 return val;
35027d0c
KH		 2704}
2705
2706
2707/* Return a vector of font-entities matching with SPEC on FRAME. */
2708
2709Lisp_Object
c2f5bfd6
KH		 2710font_list_entities (frame, spec)
2711 Lisp_Object frame, spec;
2712{
2713 FRAME_PTR f = XFRAME (frame);
2714 struct font_driver_list *driver_list = f->font_driver_list;
4007dd1c 2715 Lisp_Object ftype, val;
35027d0c
KH		 2716 Lisp_Object *vec;
2717 int size;
2718 int need_filtering = 0;
c2f5bfd6
KH		 2719 int i;
2720
d0ab1ebe 2721 font_assert (FONT_SPEC_P (spec));
c2f5bfd6 2722
35027d0c
KH		 2723 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
2724 size = XINT (AREF (spec, FONT_SIZE_INDEX));
2725 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
2726 size = font_pixel_size (f, spec);
2727 else
2728 size = 0;
2729
c2f5bfd6 2730 ftype = AREF (spec, FONT_TYPE_INDEX);
4007dd1c 2731 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
35027d0c 2732 ASET (scratch_font_spec, i, AREF (spec, i));
4007dd1c 2733 for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
35027d0c
KH		 2734 {
2735 ASET (scratch_font_spec, i, Qnil);
2736 if (! NILP (AREF (spec, i)))
2737 need_filtering = 1;
4007dd1c
KH		 2738 if (i == FONT_DPI_INDEX)
2739 /* Skip FONT_SPACING_INDEX */
2740 i++;
35027d0c 2741 }
aa50ca2f 2742 ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
35027d0c
KH		 2743 ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
2744
4007dd1c 2745 vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
35027d0c
KH		 2746 if (! vec)
2747 return null_vector;
51c01100 2748
c2f5bfd6 2749 for (i = 0; driver_list; driver_list = driver_list->next)
417a1b10
KH		 2750 if (driver_list->on
2751 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
c2f5bfd6 2752 {
ca4da08a 2753 Lisp_Object cache = font_get_cache (f, driver_list->driver);
c2f5bfd6 2754
e4c93315 2755 ASET (scratch_font_spec, FONT_TYPE_INDEX, driver_list->driver->type);
4007dd1c
KH		 2756 val = assoc_no_quit (scratch_font_spec, XCDR (cache));
2757 if (CONSP (val))
2758 val = XCDR (val);
2759 else
c2f5bfd6 2760 {
4007dd1c 2761 Lisp_Object copy;
35027d0c 2762
4007dd1c
KH		 2763 val = driver_list->driver->list (frame, scratch_font_spec);
2764 copy = Fcopy_font_spec (scratch_font_spec);
2765 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2766 XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
c2f5bfd6 2767 }
4007dd1c
KH		 2768 if (! NILP (val) && need_filtering)
2769 val = font_delete_unmatched (val, spec, size);
2770 if (! NILP (val))
2771 vec[i++] = val;
c2f5bfd6 2772 }
35027d0c 2773
d0ab1ebe
KH		 2774 val = (i > 0 ? Fvconcat (i, vec) : null_vector);
2775 font_add_log ("list", spec, val);
2776 return (val);
c2f5bfd6
KH		 2777}
2778
45eb10fb 2779
35027d0c
KH		 2780/* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2781 nil, is an array of face's attributes, which specifies preferred
2782 font-related attributes. */
45eb10fb 2783
e950d6f1 2784static Lisp_Object
35027d0c
KH		 2785font_matching_entity (f, attrs, spec)
2786 FRAME_PTR f;
2787 Lisp_Object *attrs, spec;
e950d6f1 2788{
e950d6f1
KH		 2789 struct font_driver_list *driver_list = f->font_driver_list;
2790 Lisp_Object ftype, size, entity;
35027d0c 2791 Lisp_Object frame;
819ab95f 2792 Lisp_Object work = Fcopy_font_spec (spec);
e950d6f1 2793
35027d0c 2794 XSETFRAME (frame, f);
e950d6f1
KH		 2795 ftype = AREF (spec, FONT_TYPE_INDEX);
2796 size = AREF (spec, FONT_SIZE_INDEX);
819ab95f 2797
8d0e382e
AR		 2798 if (FLOATP (size))
2799 ASET (work, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
819ab95f
KH		 2800 FONT_SET_STYLE (work, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
2801 FONT_SET_STYLE (work, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
2802 FONT_SET_STYLE (work, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
2803
e950d6f1
KH		 2804 entity = Qnil;
2805 for (; driver_list; driver_list = driver_list->next)
2806 if (driver_list->on
2807 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
2808 {
ca4da08a 2809 Lisp_Object cache = font_get_cache (f, driver_list->driver);
7cee5d63 2810 Lisp_Object copy;
e950d6f1 2811
819ab95f
KH		 2812 ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
2813 entity = assoc_no_quit (work, XCDR (cache));
7cee5d63 2814 if (CONSP (entity))
e950d6f1
KH		 2815 entity = XCDR (entity);
2816 else
2817 {
819ab95f
KH		 2818 entity = driver_list->driver->match (frame, work);
2819 copy = Fcopy_font_spec (work);
7cee5d63
KH		 2820 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2821 XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache)));
e950d6f1
KH		 2822 }
2823 if (! NILP (entity))
2824 break;
2825 }
819ab95f 2826 font_add_log ("match", work, entity);
e950d6f1
KH		 2827 return entity;
2828}
2829
45eb10fb
KH		 2830
2831/* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2832 opened font object. */
2833
c2f5bfd6
KH		 2834static Lisp_Object
2835font_open_entity (f, entity, pixel_size)
2836 FRAME_PTR f;
2837 Lisp_Object entity;
2838 int pixel_size;
2839{
2840 struct font_driver_list *driver_list;
43c0454d 2841 Lisp_Object objlist, size, val, font_object;
c2f5bfd6 2842 struct font *font;
d26424c5 2843 int min_width, height;
c2f5bfd6 2844
d0ab1ebe 2845 font_assert (FONT_ENTITY_P (entity));
c2f5bfd6 2846 size = AREF (entity, FONT_SIZE_INDEX);
c2f5bfd6
KH		 2847 if (XINT (size) != 0)
2848 pixel_size = XINT (size);
2849
2850 for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
2851 objlist = XCDR (objlist))
5e634ec9
KH		 2852 if (! NILP (AREF (XCAR (objlist), FONT_TYPE_INDEX))
2853 && XFONT_OBJECT (XCAR (objlist))->pixel_size == pixel_size)
35027d0c
KH		 2854 return XCAR (objlist);
2855
2856 val = AREF (entity, FONT_TYPE_INDEX);
2857 for (driver_list = f->font_driver_list;
2858 driver_list && ! EQ (driver_list->driver->type, val);
2859 driver_list = driver_list->next);
2860 if (! driver_list)
2861 return Qnil;
c2f5bfd6 2862
35027d0c 2863 font_object = driver_list->driver->open (f, entity, pixel_size);
d0ab1ebe 2864 font_add_log ("open", entity, font_object);
43c0454d 2865 if (NILP (font_object))
35027d0c
KH		 2866 return Qnil;
2867 ASET (entity, FONT_OBJLIST_INDEX,
2868 Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
5e634ec9 2869 ASET (font_object, FONT_OBJLIST_INDEX, Qnil);
35027d0c
KH		 2870 num_fonts++;
2871
2872 font = XFONT_OBJECT (font_object);
2873 min_width = (font->min_width ? font->min_width
2874 : font->average_width ? font->average_width
2875 : font->space_width ? font->space_width
2876 : 1);
d26424c5 2877 height = (font->height ? font->height : 1);
819e81df 2878#ifdef HAVE_WINDOW_SYSTEM
35027d0c
KH		 2879 FRAME_X_DISPLAY_INFO (f)->n_fonts++;
2880 if (FRAME_X_DISPLAY_INFO (f)->n_fonts == 1)
43c0454d 2881 {
35027d0c 2882 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width;
d26424c5 2883 FRAME_SMALLEST_FONT_HEIGHT (f) = height;
35027d0c
KH		 2884 fonts_changed_p = 1;
2885 }
2886 else
2887 {
2888 if (FRAME_SMALLEST_CHAR_WIDTH (f) > min_width)
2889 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width, fonts_changed_p = 1;
d26424c5
KH		 2890 if (FRAME_SMALLEST_FONT_HEIGHT (f) > height)
2891 FRAME_SMALLEST_FONT_HEIGHT (f) = height, fonts_changed_p = 1;
43c0454d 2892 }
819e81df 2893#endif
43c0454d
KH		 2894
2895 return font_object;
c2f5bfd6
KH		 2896}
2897
45eb10fb
KH		 2898
2899/* Close FONT_OBJECT that is opened on frame F. */
2900
c2f5bfd6
KH		 2901void
2902font_close_object (f, font_object)
2903 FRAME_PTR f;
2904 Lisp_Object font_object;
2905{
35027d0c 2906 struct font *font = XFONT_OBJECT (font_object);
c2f5bfd6 2907
5e634ec9
KH		 2908 if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
2909 /* Already closed. */
2910 return;
2911 font_add_log ("close", font_object, Qnil);
2912 font->driver->close (f, font);
819e81df 2913#ifdef HAVE_WINDOW_SYSTEM
5e634ec9
KH		 2914 font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
2915 FRAME_X_DISPLAY_INFO (f)->n_fonts--;
819e81df 2916#endif
5e634ec9 2917 num_fonts--;
c2f5bfd6
KH		 2918}
2919
45eb10fb 2920
1701724c
KH		 2921/* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2922 FONT is a font-entity and it must be opened to check. */
45eb10fb 2923
c2f5bfd6 2924int
1b834a8d 2925font_has_char (f, font, c)
c2f5bfd6 2926 FRAME_PTR f;
1b834a8d 2927 Lisp_Object font;
c2f5bfd6
KH		 2928 int c;
2929{
1b834a8d 2930 struct font *fontp;
c2f5bfd6 2931
1b834a8d
KH		 2932 if (FONT_ENTITY_P (font))
2933 {
2934 Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
2935 struct font_driver_list *driver_list;
2936
2937 for (driver_list = f->font_driver_list;
2938 driver_list && ! EQ (driver_list->driver->type, type);
2939 driver_list = driver_list->next);
2940 if (! driver_list)
2941 return 0;
2942 if (! driver_list->driver->has_char)
2943 return -1;
2944 return driver_list->driver->has_char (font, c);
2945 }
2946
d0ab1ebe 2947 font_assert (FONT_OBJECT_P (font));
35027d0c 2948 fontp = XFONT_OBJECT (font);
1b834a8d
KH		 2949 if (fontp->driver->has_char)
2950 {
35027d0c 2951 int result = fontp->driver->has_char (font, c);
1b834a8d
KH		 2952
2953 if (result >= 0)
2954 return result;
2955 }
2956 return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
c2f5bfd6
KH		 2957}
2958
45eb10fb
KH		 2959
2960/* Return the glyph ID of FONT_OBJECT for character C. */
2961
c2f5bfd6
KH		 2962unsigned
2963font_encode_char (font_object, c)
2964 Lisp_Object font_object;
2965 int c;
2966{
35027d0c 2967 struct font *font;
c2f5bfd6 2968
d0ab1ebe 2969 font_assert (FONT_OBJECT_P (font_object));
35027d0c 2970 font = XFONT_OBJECT (font_object);
c2f5bfd6
KH		 2971 return font->driver->encode_char (font, c);
2972}
2973
45eb10fb
KH		 2974
2975/* Return the name of FONT_OBJECT. */
2976
ef18374f 2977Lisp_Object
c2f5bfd6
KH		 2978font_get_name (font_object)
2979 Lisp_Object font_object;
2980{
d0ab1ebe 2981 font_assert (FONT_OBJECT_P (font_object));
35027d0c 2982 return AREF (font_object, FONT_NAME_INDEX);
ef18374f
KH		 2983}
2984
45eb10fb
KH		 2985
2986/* Return the specification of FONT_OBJECT. */
2987
ef18374f
KH		 2988Lisp_Object
2989font_get_spec (font_object)
2990 Lisp_Object font_object;
2991{
35027d0c 2992 Lisp_Object spec = font_make_spec ();
ef18374f
KH		 2993 int i;
2994
2995 for (i = 0; i < FONT_SIZE_INDEX; i++)
35027d0c
KH		 2996 ASET (spec, i, AREF (font_object, i));
2997 ASET (spec, FONT_SIZE_INDEX,
2998 make_number (XFONT_OBJECT (font_object)->pixel_size));
ef18374f 2999 return spec;
c2f5bfd6
KH		 3000}
3001
35027d0c
KH		 3002Lisp_Object
3003font_spec_from_name (font_name)
3004 Lisp_Object font_name;
3005{
3006 Lisp_Object args[2];
3007
3008 args[0] = QCname;
3009 args[1] = font_name;
3010 return Ffont_spec (2, args);
3011}
3012
45eb10fb 3013
35027d0c
KH		 3014void
3015font_clear_prop (attrs, prop)
3016 Lisp_Object *attrs;
3017 enum font_property_index prop;
3018{
3019 Lisp_Object font = attrs[LFACE_FONT_INDEX];
45eb10fb 3020
35027d0c
KH		 3021 if (! FONTP (font))
3022 return;
3023 if (NILP (AREF (font, prop))
e234927a
CY		 3024 && prop != FONT_FAMILY_INDEX
3025 && prop != FONT_FOUNDRY_INDEX
3026 && prop != FONT_WIDTH_INDEX
4007dd1c 3027 && prop != FONT_SIZE_INDEX)
35027d0c
KH		 3028 return;
3029 font = Fcopy_font_spec (font);
3030 ASET (font, prop, Qnil);
4007dd1c 3031 if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
35027d0c 3032 {
4007dd1c
KH		 3033 if (prop == FONT_FAMILY_INDEX)
3034 ASET (font, FONT_FOUNDRY_INDEX, Qnil);
35027d0c 3035 ASET (font, FONT_ADSTYLE_INDEX, Qnil);
4007dd1c 3036 ASET (font, FONT_REGISTRY_INDEX, Qnil);
35027d0c
KH		 3037 ASET (font, FONT_SIZE_INDEX, Qnil);
3038 ASET (font, FONT_DPI_INDEX, Qnil);
3039 ASET (font, FONT_SPACING_INDEX, Qnil);
3040 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3041 }
3042 else if (prop == FONT_SIZE_INDEX)
3043 {
3044 ASET (font, FONT_DPI_INDEX, Qnil);
3045 ASET (font, FONT_SPACING_INDEX, Qnil);
3046 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3047 }
e234927a
CY		 3048 else if (prop == FONT_WIDTH_INDEX)
3049 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
35027d0c
KH		 3050 attrs[LFACE_FONT_INDEX] = font;
3051}
3052
3053void
3054font_update_lface (f, attrs)
3055 FRAME_PTR f;
3056 Lisp_Object *attrs;
c2f5bfd6 3057{
d0ab1ebe 3058 Lisp_Object spec;
35027d0c
KH		 3059
3060 spec = attrs[LFACE_FONT_INDEX];
3061 if (! FONT_SPEC_P (spec))
3062 return;
3063
4007dd1c
KH		 3064 if (! NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
3065 attrs[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FOUNDRY_INDEX));
3066 if (! NILP (AREF (spec, FONT_FAMILY_INDEX)))
3067 attrs[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FAMILY_INDEX));
35027d0c
KH		 3068 if (! NILP (AREF (spec, FONT_WEIGHT_INDEX)))
3069 attrs[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (spec);
3070 if (! NILP (AREF (spec, FONT_SLANT_INDEX)))
3071 attrs[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (spec);;
3072 if (! NILP (AREF (spec, FONT_WIDTH_INDEX)))
3073 attrs[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (spec);
3074 if (! NILP (AREF (spec, FONT_SIZE_INDEX)))
3075 {
3076 int point;
3077
3078 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
3079 {
3080 Lisp_Object val;
3081 int dpi = f->resy;
3082
3083 val = Ffont_get (spec, QCdpi);
3084 if (! NILP (val))
3085 dpi = XINT (val);
3086 point = PIXEL_TO_POINT (XINT (AREF (spec, FONT_SIZE_INDEX)) * 10,
3087 dpi);
3088 }
3089 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
3090 point = XFLOAT_DATA (AREF (spec, FONT_SIZE_INDEX)) * 10;
3091 attrs[LFACE_HEIGHT_INDEX] = make_number (point);
3092 }
c2f5bfd6
KH		 3093}
3094
45eb10fb 3095
35027d0c
KH		 3096/* Return a font-entity satisfying SPEC and best matching with face's
3097 font related attributes in ATTRS. C, if not negative, is a
1701724c 3098 character that the entity must support. */
c2f5bfd6
KH		 3099
3100Lisp_Object
35027d0c 3101font_find_for_lface (f, attrs, spec, c)
c2f5bfd6 3102 FRAME_PTR f;
35027d0c 3103 Lisp_Object *attrs;
c2f5bfd6 3104 Lisp_Object spec;
1701724c 3105 int c;
c2f5bfd6 3106{
4007dd1c 3107 Lisp_Object work;
35027d0c 3108 Lisp_Object frame, entities, val, props[FONT_REGISTRY_INDEX + 1] ;
22459668 3109 Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
1d1e1245 3110 int pixel_size;
22459668 3111 int i, j, k, l, result;
d0a47776
KH		 3112
3113 registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
3114 if (NILP (registry[0]))
3115 {
edfda783 3116 registry[0] = DEFAULT_ENCODING;
d0a47776
KH		 3117 registry[1] = Qascii_0;
3118 registry[2] = null_vector;
3119 }
3120 else
3121 registry[1] = null_vector;
c2f5bfd6 3122
4007dd1c 3123 if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
fe5ddfbc 3124 {
35027d0c 3125 struct charset *encoding, *repertory;
1701724c 3126
4007dd1c
KH		 3127 if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
3128 &encoding, &repertory) < 0)
35027d0c
KH		 3129 return Qnil;
3130 if (repertory)
1701724c 3131 {
35027d0c 3132 if (ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
1701724c 3133 return Qnil;
35027d0c
KH		 3134 /* Any font of this registry support C. So, let's
3135 suppress the further checking. */
3136 c = -1;
1701724c 3137 }
35027d0c
KH		 3138 else if (c > encoding->max_char)
3139 return Qnil;
c2f5bfd6
KH		 3140 }
3141
4007dd1c 3142 work = Fcopy_font_spec (spec);
35027d0c
KH		 3143 XSETFRAME (frame, f);
3144 size = AREF (spec, FONT_SIZE_INDEX);
1d1e1245
KH		 3145 pixel_size = font_pixel_size (f, spec);
3146 if (pixel_size == 0)
3147 {
3148 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
3149
3150 pixel_size = POINT_TO_PIXEL (pt / 10, f->resy);
3151 }
4007dd1c
KH		 3152 ASET (work, FONT_SIZE_INDEX, Qnil);
3153 foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
3154 if (! NILP (foundry[0]))
3155 foundry[1] = null_vector;
3156 else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
3157 {
071132a9
KH		 3158 val = attrs[LFACE_FOUNDRY_INDEX];
3159 foundry[0] = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
4007dd1c
KH		 3160 foundry[1] = Qnil;
3161 foundry[2] = null_vector;
3162 }
3163 else
3164 foundry[0] = Qnil, foundry[1] = null_vector;
3165
22459668
KH		 3166 adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
3167 if (! NILP (adstyle[0]))
3168 adstyle[1] = null_vector;
3169 else if (FONTP (attrs[LFACE_FONT_INDEX]))
3170 {
3171 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3172
3173 if (! NILP (AREF (face_font, FONT_ADSTYLE_INDEX)))
3174 {
3175 adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
3176 adstyle[1] = Qnil;
3177 adstyle[2] = null_vector;
3178 }
3179 else
3180 adstyle[0] = Qnil, adstyle[1] = null_vector;
3181 }
3182 else
3183 adstyle[0] = Qnil, adstyle[1] = null_vector;
3184
3185
4007dd1c
KH		 3186 val = AREF (work, FONT_FAMILY_INDEX);
3187 if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
071132a9
KH		 3188 {
3189 val = attrs[LFACE_FAMILY_INDEX];
3190 val = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
3191 }
4007dd1c
KH		 3192 if (NILP (val))
3193 {
3194 family = alloca ((sizeof family[0]) * 2);
3195 family[0] = Qnil;
3196 family[1] = null_vector; /* terminator. */
3197 }
3198 else
3199 {
3200 Lisp_Object alters
819ab95f
KH		 3201 = Fassoc_string (val, Vface_alternative_font_family_alist,
3202#ifndef HAVE_NS
3203 Qt
3204#else
3205 Qnil
3206#endif
3207 );
4007dd1c
KH		 3208
3209 if (! NILP (alters))
3210 {
3211 family = alloca ((sizeof family[0]) * (XINT (Flength (alters)) + 2));
3212 for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
3213 family[i] = XCAR (alters);
3214 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3215 family[i++] = Qnil;
3216 family[i] = null_vector;
3217 }
3218 else
3219 {
3220 family = alloca ((sizeof family[0]) * 3);
3221 i = 0;
3222 family[i++] = val;
3223 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3224 family[i++] = Qnil;
3225 family[i] = null_vector;
3226 }
3227 }
3228
d0a47776 3229 for (i = 0; SYMBOLP (family[i]); i++)
4007dd1c 3230 {
d0a47776
KH		 3231 ASET (work, FONT_FAMILY_INDEX, family[i]);
3232 for (j = 0; SYMBOLP (foundry[j]); j++)
4007dd1c 3233 {
d0a47776
KH		 3234 ASET (work, FONT_FOUNDRY_INDEX, foundry[j]);
3235 for (k = 0; SYMBOLP (registry[k]); k++)
3236 {
904a2e0e 3237 ASET (work, FONT_REGISTRY_INDEX, registry[k]);
22459668
KH		 3238 for (l = 0; SYMBOLP (adstyle[l]); l++)
3239 {
3240 ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
3241 entities = font_list_entities (frame, work);
3242 if (ASIZE (entities) > 0)
3243 goto found;
3244 }
d0a47776 3245 }
4007dd1c 3246 }
4007dd1c 3247 }
d0a47776
KH		 3248 return Qnil;
3249 found:
35027d0c
KH		 3250 if (ASIZE (entities) == 1)
3251 {
3252 if (c < 0)
3253 return AREF (entities, 0);
3254 }
3255 else
c2f5bfd6 3256 {
fe5ddfbc 3257 /* Sort fonts by properties specified in LFACE. */
ec6fe57c 3258 Lisp_Object prefer = scratch_font_prefer;
d0ab1ebe 3259
35027d0c 3260 for (i = 0; i < FONT_EXTRA_INDEX; i++)
4007dd1c 3261 ASET (prefer, i, AREF (work, i));
79f105c9
KH		 3262 if (FONTP (attrs[LFACE_FONT_INDEX]))
3263 {
3264 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3265
3266 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3267 if (NILP (AREF (prefer, i)))
3268 ASET (prefer, i, AREF (face_font, i));
3269 }
35027d0c
KH		 3270 if (NILP (AREF (prefer, FONT_WEIGHT_INDEX)))
3271 FONT_SET_STYLE (prefer, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
3272 if (NILP (AREF (prefer, FONT_SLANT_INDEX)))
3273 FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
3274 if (NILP (AREF (prefer, FONT_WIDTH_INDEX)))
3275 FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
1d1e1245 3276 ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size));
7181ea6a 3277 entities = font_sort_entites (entities, prefer, frame, c < 0);
c2f5bfd6 3278 }
1701724c 3279 if (c < 0)
35027d0c 3280 return entities;
45eb10fb 3281
35027d0c
KH		 3282 for (i = 0; i < ASIZE (entities); i++)
3283 {
3284 int j;
3285
3286 val = AREF (entities, i);
3287 if (i > 0)
3288 {
3289 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3290 if (! EQ (AREF (val, j), props[j]))
3291 break;
3292 if (j > FONT_REGISTRY_INDEX)
3293 continue;
3294 }
3295 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3296 props[j] = AREF (val, j);
3297 result = font_has_char (f, val, c);
3298 if (result > 0)
3299 return val;
3300 if (result == 0)
3301 return Qnil;
3302 val = font_open_for_lface (f, val, attrs, spec);
3303 if (NILP (val))
3304 continue;
3305 result = font_has_char (f, val, c);
3306 font_close_object (f, val);
3307 if (result > 0)
3308 return AREF (entities, i);
3309 }
1701724c
KH		 3310 return Qnil;
3311}
45eb10fb
KH		 3312
3313
c2f5bfd6 3314Lisp_Object
35027d0c 3315font_open_for_lface (f, entity, attrs, spec)
c2f5bfd6 3316 FRAME_PTR f;
c2f5bfd6 3317 Lisp_Object entity;
35027d0c 3318 Lisp_Object *attrs;
733fd013 3319 Lisp_Object spec;
c2f5bfd6 3320{
9331887d 3321 int size;
c2f5bfd6 3322
4007dd1c
KH		 3323 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX))
3324 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
3325 size = XINT (AREF (entity, FONT_SIZE_INDEX));
3326 else if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
1d1e1245 3327 size = font_pixel_size (f, spec);
733fd013
KH		 3328 else
3329 {
35027d0c 3330 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
733fd013
KH		 3331
3332 pt /= 10;
3333 size = POINT_TO_PIXEL (pt, f->resy);
ed96cde8
AR		 3334#ifdef HAVE_NS
3335 if (size == 0)
3336 {
3337 Lisp_Object ffsize = get_frame_param(f, Qfontsize);
3338 size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
3339 }
3340#endif
733fd013 3341 }
c2f5bfd6
KH		 3342 return font_open_entity (f, entity, size);
3343}
3344
45eb10fb 3345
35027d0c
KH		 3346/* Find a font satisfying SPEC and best matching with face's
3347 attributes in ATTRS on FRAME, and return the opened
3348 font-object. */
45eb10fb 3349
35027d0c
KH		 3350Lisp_Object
3351font_load_for_lface (f, attrs, spec)
c2f5bfd6 3352 FRAME_PTR f;
35027d0c 3353 Lisp_Object *attrs, spec;
c2f5bfd6 3354{
35027d0c 3355 Lisp_Object entity;
ef18374f 3356
35027d0c
KH		 3357 entity = font_find_for_lface (f, attrs, spec, -1);
3358 if (NILP (entity))
ef18374f 3359 {
35027d0c
KH		 3360 /* No font is listed for SPEC, but each font-backend may have
3361 the different criteria about "font matching". So, try
3362 it. */
3363 entity = font_matching_entity (f, attrs, spec);
3364 if (NILP (entity))
3365 return Qnil;
c2f5bfd6 3366 }
35027d0c 3367 return font_open_for_lface (f, entity, attrs, spec);
c2f5bfd6
KH		 3368}
3369
45eb10fb
KH		 3370
3371/* Make FACE on frame F ready to use the font opened for FACE. */
3372
c2f5bfd6
KH		 3373void
3374font_prepare_for_face (f, face)
3375 FRAME_PTR f;
3376 struct face *face;
3377{
35027d0c
KH		 3378 if (face->font->driver->prepare_face)
3379 face->font->driver->prepare_face (f, face);
c2f5bfd6
KH		 3380}
3381
45eb10fb
KH		 3382
3383/* Make FACE on frame F stop using the font opened for FACE. */
3384
c2f5bfd6
KH		 3385void
3386font_done_for_face (f, face)
3387 FRAME_PTR f;
3388 struct face *face;
3389{
35027d0c
KH		 3390 if (face->font->driver->done_face)
3391 face->font->driver->done_face (f, face);
c2f5bfd6
KH		 3392 face->extra = NULL;
3393}
3394
45eb10fb
KH		 3395
3396/* Open a font best matching with NAME on frame F. If no proper font
3397 is found, return Qnil. */
3398
c2f5bfd6
KH		 3399Lisp_Object
3400font_open_by_name (f, name)
3401 FRAME_PTR f;
3402 char *name;
3403{
ef18374f 3404 Lisp_Object args[2];
4007dd1c 3405 Lisp_Object spec, attrs[LFACE_VECTOR_SIZE];
a9262bb8 3406
ef18374f
KH		 3407 args[0] = QCname;
3408 args[1] = make_unibyte_string (name, strlen (name));
3409 spec = Ffont_spec (2, args);
4007dd1c
KH		 3410 /* We set up the default font-related attributes of a face to prefer
3411 a moderate font. */
3412 attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
3413 attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
3414 = attrs[LFACE_SLANT_INDEX] = Qnormal;
ed96cde8 3415#ifndef HAVE_NS
4007dd1c 3416 attrs[LFACE_HEIGHT_INDEX] = make_number (120);
ed96cde8
AR		 3417#else
3418 attrs[LFACE_HEIGHT_INDEX] = make_number (0);
3419#endif
4007dd1c
KH		 3420 attrs[LFACE_FONT_INDEX] = Qnil;
3421
3422 return font_load_for_lface (f, attrs, spec);
c2f5bfd6
KH		 3423}
3424
3425
3426/* Register font-driver DRIVER. This function is used in two ways.
3427
417a1b10
KH		 3428 The first is with frame F non-NULL. In this case, make DRIVER
3429 available (but not yet activated) on F. All frame creaters
3430 (e.g. Fx_create_frame) must call this function at least once with
3431 an available font-driver.
c2f5bfd6
KH		 3432
3433 The second is with frame F NULL. In this case, DRIVER is globally
3434 registered in the variable `font_driver_list'. All font-driver
3435 implementations must call this function in its syms_of_XXXX
3436 (e.g. syms_of_xfont). */
3437
3438void
3439register_font_driver (driver, f)
3440 struct font_driver *driver;
3441 FRAME_PTR f;
3442{
3443 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
3444 struct font_driver_list *prev, *list;
3445
3446 if (f && ! driver->draw)
43a1d19b 3447 error ("Unusable font driver for a frame: %s",
c2f5bfd6
KH		 3448 SDATA (SYMBOL_NAME (driver->type)));
3449
3450 for (prev = NULL, list = root; list; prev = list, list = list->next)
cf23b845 3451 if (EQ (list->driver->type, driver->type))
c2f5bfd6
KH		 3452 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
3453
3454 list = malloc (sizeof (struct font_driver_list));
417a1b10 3455 list->on = 0;
c2f5bfd6
KH		 3456 list->driver = driver;
3457 list->next = NULL;
3458 if (prev)
3459 prev->next = list;
3460 else if (f)
3461 f->font_driver_list = list;
3462 else
3463 font_driver_list = list;
72606e45
KH		 3464 if (! f)
3465 num_font_drivers++;
c2f5bfd6
KH		 3466}
3467
45eb10fb 3468
f697fff0 3469/* Make the frame F use font backends listed in NEW_DRIVERS (list of
ca4da08a
KH		 3470 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3471 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
417a1b10 3472
ca4da08a
KH		 3473 A caller must free all realized faces if any in advance. The
3474 return value is a list of font backends actually made used on
3475 F. */
e950d6f1
KH		 3476
3477Lisp_Object
3478font_update_drivers (f, new_drivers)
417a1b10
KH		 3479 FRAME_PTR f;
3480 Lisp_Object new_drivers;
417a1b10
KH		 3481{
3482 Lisp_Object active_drivers = Qnil;
4007dd1c 3483 struct font_driver *driver;
417a1b10
KH		 3484 struct font_driver_list *list;
3485
4007dd1c
KH		 3486 /* At first, turn off non-requested drivers, and turn on requested
3487 drivers. */
f697fff0 3488 for (list = f->font_driver_list; list; list = list->next)
4007dd1c
KH		 3489 {
3490 driver = list->driver;
3491 if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers)))
3492 != list->on)
3493 {
3494 if (list->on)
3495 {
3496 if (driver->end_for_frame)
3497 driver->end_for_frame (f);
3498 font_finish_cache (f, driver);
3499 list->on = 0;
3500 }
3501 else
3502 {
3503 if (! driver->start_for_frame
3504 || driver->start_for_frame (f) == 0)
3505 {
3506 font_prepare_cache (f, driver);
3507 list->on = 1;
3508 }
3509 }
3510 }
3511 }
3512
3513 if (NILP (new_drivers))
3514 return Qnil;
3515
3516 if (! EQ (new_drivers, Qt))
3517 {
3518 /* Re-order the driver list according to new_drivers. */
3306c6dc 3519 struct font_driver_list **list_table, **next;
4007dd1c
KH		 3520 Lisp_Object tail;
3521 int i;
3522
3523 list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
3524 for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
3525 {
3526 for (list = f->font_driver_list; list; list = list->next)
3527 if (list->on && EQ (list->driver->type, XCAR (tail)))
3528 break;
3529 if (list)
3530 list_table[i++] = list;
3531 }
3532 for (list = f->font_driver_list; list; list = list->next)
3533 if (! list->on)
3534 list_table[i] = list;
3535 list_table[i] = NULL;
3536
3306c6dc 3537 next = &f->font_driver_list;
4007dd1c
KH		 3538 for (i = 0; list_table[i]; i++)
3539 {
3306c6dc
AS		 3540 *next = list_table[i];
3541 next = &(*next)->next;
4007dd1c 3542 }
3306c6dc 3543 *next = NULL;
4007dd1c 3544 }
417a1b10 3545
4007dd1c
KH		 3546 for (list = f->font_driver_list; list; list = list->next)
3547 if (list->on)
3548 active_drivers = nconc2 (active_drivers,
3549 Fcons (list->driver->type, Qnil));
e950d6f1 3550 return active_drivers;
417a1b10
KH		 3551}
3552
f697fff0
KH		 3553int
3554font_put_frame_data (f, driver, data)
3555 FRAME_PTR f;
3556 struct font_driver *driver;
3557 void *data;
3558{
3559 struct font_data_list *list, *prev;
3560
3561 for (prev = NULL, list = f->font_data_list; list;
3562 prev = list, list = list->next)
3563 if (list->driver == driver)
3564 break;
3565 if (! data)
3566 {
3567 if (list)
3568 {
3569 if (prev)
3570 prev->next = list->next;
3571 else
3572 f->font_data_list = list->next;
3573 free (list);
3574 }
3575 return 0;
3576 }
3577
3578 if (! list)
3579 {
3580 list = malloc (sizeof (struct font_data_list));
3581 if (! list)
3582 return -1;
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))
4486 isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
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.