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