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