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