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