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