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