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