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