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