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