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