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