HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(reorder_font_vector): Fix typo.
[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);
0a16d567 2702 if (result == 0)
1701724c
KH		 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 }
c8ea71f6
KH		 2756 else if (STRINGP (font_object))
2757 {
2758 font_object = font_open_by_name (f, SDATA (font_object));
2759 }
c2f5bfd6 2760
ef18374f
KH		 2761 if (! NILP (font_object))
2762 {
2763 struct font *font = XSAVE_VALUE (font_object)->pointer;
2764
2765 face->font = font->font.font;
2766 face->font_info = (struct font_info *) font;
2767 face->font_info_id = 0;
2768 face->font_name = font->font.full_name;
2769 }
2770 else
2771 {
2772 face->font = NULL;
2773 face->font_info = NULL;
2774 face->font_info_id = -1;
2775 face->font_name = NULL;
2776 add_to_log ("Unable to load font for a face%s", null_string, Qnil);
c2f5bfd6 2777 }
c2f5bfd6
KH		 2778}
2779
45eb10fb
KH		 2780
2781/* Make FACE on frame F ready to use the font opened for FACE. */
2782
c2f5bfd6
KH		 2783void
2784font_prepare_for_face (f, face)
2785 FRAME_PTR f;
2786 struct face *face;
2787{
2788 struct font *font = (struct font *) face->font_info;
2789
2790 if (font->driver->prepare_face)
2791 font->driver->prepare_face (f, face);
2792}
2793
45eb10fb
KH		 2794
2795/* Make FACE on frame F stop using the font opened for FACE. */
2796
c2f5bfd6
KH		 2797void
2798font_done_for_face (f, face)
2799 FRAME_PTR f;
2800 struct face *face;
2801{
2802 struct font *font = (struct font *) face->font_info;
2803
2804 if (font->driver->done_face)
2805 font->driver->done_face (f, face);
2806 face->extra = NULL;
2807}
2808
45eb10fb
KH		 2809
2810/* Open a font best matching with NAME on frame F. If no proper font
2811 is found, return Qnil. */
2812
c2f5bfd6
KH		 2813Lisp_Object
2814font_open_by_name (f, name)
2815 FRAME_PTR f;
2816 char *name;
2817{
ef18374f 2818 Lisp_Object args[2];
e950d6f1 2819 Lisp_Object spec, prefer, size, entity, entity_list;
c2f5bfd6 2820 Lisp_Object frame;
a9262bb8 2821 int i;
ef18374f 2822 int pixel_size;
c2f5bfd6
KH		 2823
2824 XSETFRAME (frame, f);
a9262bb8 2825
ef18374f
KH		 2826 args[0] = QCname;
2827 args[1] = make_unibyte_string (name, strlen (name));
2828 spec = Ffont_spec (2, args);
a9262bb8
KH		 2829 prefer = scratch_font_prefer;
2830 for (i = FONT_WEIGHT_INDEX; i < FONT_SIZE_INDEX; i++)
2831 if (NILP (AREF (spec, i)))
2832 ASET (prefer, i, make_number (100));
2833 size = AREF (spec, FONT_SIZE_INDEX);
2834 if (NILP (size))
2835 pixel_size = 0;
2836 else if (INTEGERP (size))
2837 pixel_size = XINT (size);
2838 else /* FLOATP (size) */
ef18374f 2839 {
9331887d 2840 double pt = XFLOAT_DATA (size);
a9262bb8
KH		 2841
2842 pixel_size = POINT_TO_PIXEL (pt, f->resy);
2843 size = make_number (pixel_size);
2844 ASET (spec, FONT_SIZE_INDEX, size);
ef18374f 2845 }
a9262bb8 2846 if (pixel_size == 0)
ef18374f 2847 {
9331887d 2848 pixel_size = POINT_TO_PIXEL (12.0, f->resy);
a9262bb8 2849 size = make_number (pixel_size);
ef18374f 2850 }
a9262bb8 2851 ASET (prefer, FONT_SIZE_INDEX, size);
9331887d
KH		 2852 if (NILP (AREF (spec, FONT_REGISTRY_INDEX)))
2853 ASET (spec, FONT_REGISTRY_INDEX, Qiso8859_1);
a9262bb8 2854
e950d6f1
KH		 2855 entity_list = Flist_fonts (spec, frame, make_number (1), prefer);
2856 if (NILP (entity_list))
2857 entity = font_matching_entity (frame, spec);
2858 else
2859 entity = XCAR (entity_list);
2860 return (NILP (entity)
a9262bb8 2861 ? Qnil
e950d6f1 2862 : font_open_entity (f, entity, pixel_size));
c2f5bfd6
KH		 2863}
2864
2865
2866/* Register font-driver DRIVER. This function is used in two ways.
2867
417a1b10
KH		 2868 The first is with frame F non-NULL. In this case, make DRIVER
2869 available (but not yet activated) on F. All frame creaters
2870 (e.g. Fx_create_frame) must call this function at least once with
2871 an available font-driver.
c2f5bfd6
KH		 2872
2873 The second is with frame F NULL. In this case, DRIVER is globally
2874 registered in the variable `font_driver_list'. All font-driver
2875 implementations must call this function in its syms_of_XXXX
2876 (e.g. syms_of_xfont). */
2877
2878void
2879register_font_driver (driver, f)
2880 struct font_driver *driver;
2881 FRAME_PTR f;
2882{
2883 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
2884 struct font_driver_list *prev, *list;
2885
2886 if (f && ! driver->draw)
2887 error ("Unsable font driver for a frame: %s",
2888 SDATA (SYMBOL_NAME (driver->type)));
2889
2890 for (prev = NULL, list = root; list; prev = list, list = list->next)
cf23b845 2891 if (EQ (list->driver->type, driver->type))
c2f5bfd6
KH		 2892 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
2893
2894 list = malloc (sizeof (struct font_driver_list));
417a1b10 2895 list->on = 0;
c2f5bfd6
KH		 2896 list->driver = driver;
2897 list->next = NULL;
2898 if (prev)
2899 prev->next = list;
2900 else if (f)
2901 f->font_driver_list = list;
2902 else
2903 font_driver_list = list;
2904 num_font_drivers++;
2905}
2906
45eb10fb 2907
c2f5bfd6
KH		 2908/* Free font-driver list on frame F. It doesn't free font-drivers
2909 themselves. */
2910
2911void
2912free_font_driver_list (f)
2913 FRAME_PTR f;
2914{
2915 while (f->font_driver_list)
2916 {
2917 struct font_driver_list *next = f->font_driver_list->next;
2918
2919 free (f->font_driver_list);
2920 f->font_driver_list = next;
2921 }
2922}
2923
45eb10fb 2924
f697fff0 2925/* Make the frame F use font backends listed in NEW_DRIVERS (list of
ca4da08a
KH		 2926 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
2927 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
417a1b10 2928
ca4da08a
KH		 2929 A caller must free all realized faces if any in advance. The
2930 return value is a list of font backends actually made used on
2931 F. */
e950d6f1
KH		 2932
2933Lisp_Object
2934font_update_drivers (f, new_drivers)
417a1b10
KH		 2935 FRAME_PTR f;
2936 Lisp_Object new_drivers;
417a1b10
KH		 2937{
2938 Lisp_Object active_drivers = Qnil;
417a1b10
KH		 2939 struct font_driver_list *list;
2940
f697fff0
KH		 2941 for (list = f->font_driver_list; list; list = list->next)
2942 if (list->on)
2943 {
ca4da08a
KH		 2944 if (! EQ (new_drivers, Qt)
2945 && NILP (Fmemq (list->driver->type, new_drivers)))
2946 {
2947 if (list->driver->end_for_frame)
2948 list->driver->end_for_frame (f);
2949 font_finish_cache (f, list->driver);
2950 list->on = 0;
2951 }
f697fff0 2952 }
ca4da08a 2953 else
e950d6f1 2954 {
ca4da08a
KH		 2955 if (EQ (new_drivers, Qt)
2956 || ! NILP (Fmemq (list->driver->type, new_drivers)))
2957 {
2958 if (! list->driver->start_for_frame
2959 || list->driver->start_for_frame (f) == 0)
2960 {
2961 font_prepare_cache (f, list->driver);
2962 list->on = 1;
2963 active_drivers = nconc2 (active_drivers,
2964 Fcons (list->driver->type, Qnil));
2965 }
2966 }
e950d6f1 2967 }
417a1b10 2968
e950d6f1 2969 return active_drivers;
417a1b10
KH		 2970}
2971
f697fff0
KH		 2972int
2973font_put_frame_data (f, driver, data)
2974 FRAME_PTR f;
2975 struct font_driver *driver;
2976 void *data;
2977{
2978 struct font_data_list *list, *prev;
2979
2980 for (prev = NULL, list = f->font_data_list; list;
2981 prev = list, list = list->next)
2982 if (list->driver == driver)
2983 break;
2984 if (! data)
2985 {
2986 if (list)
2987 {
2988 if (prev)
2989 prev->next = list->next;
2990 else
2991 f->font_data_list = list->next;
2992 free (list);
2993 }
2994 return 0;
2995 }
2996
2997 if (! list)
2998 {
2999 list = malloc (sizeof (struct font_data_list));
3000 if (! list)
3001 return -1;
3002 list->driver = driver;
3003 list->next = f->font_data_list;
3004 f->font_data_list = list;
3005 }
3006 list->data = data;
3007 return 0;
3008}
3009
3010
3011void *
3012font_get_frame_data (f, driver)
3013 FRAME_PTR f;
3014 struct font_driver *driver;
3015{
3016 struct font_data_list *list;
3017
3018 for (list = f->font_data_list; list; list = list->next)
3019 if (list->driver == driver)
3020 break;
3021 if (! list)
3022 return NULL;
3023 return list->data;
3024}
3025
417a1b10 3026
45eb10fb 3027/* Return the font used to draw character C by FACE at buffer position
e3ee0340
KH		 3028 POS in window W. If STRING is non-nil, it is a string containing C
3029 at index POS. If C is negative, get C from the current buffer or
3030 STRING. */
45eb10fb 3031
10d16101 3032Lisp_Object
e3ee0340 3033font_at (c, pos, face, w, string)
10d16101
KH		 3034 int c;
3035 EMACS_INT pos;
3036 struct face *face;
3037 struct window *w;
e3ee0340 3038 Lisp_Object string;
10d16101
KH		 3039{
3040 FRAME_PTR f;
e3ee0340
KH		 3041 int multibyte;
3042
3043 if (c < 0)
3044 {
3045 if (NILP (string))
3046 {
3047 multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3048 if (multibyte)
3049 {
3050 EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
3051
3052 c = FETCH_CHAR (pos_byte);
3053 }
3054 else
3055 c = FETCH_BYTE (pos);
3056 }
3057 else
3058 {
3059 unsigned char *str;
3060
3061 multibyte = STRING_MULTIBYTE (string);
3062 if (multibyte)
3063 {
3064 EMACS_INT pos_byte = string_char_to_byte (string, pos);
3065
3066 str = SDATA (string) + pos_byte;
3067 c = STRING_CHAR (str, 0);
3068 }
3069 else
3070 c = SDATA (string)[pos];
3071 }
3072 }
10d16101
KH		 3073
3074 f = XFRAME (w->frame);
1385a806
KH		 3075 if (! FRAME_WINDOW_P (f))
3076 return Qnil;
10d16101
KH		 3077 if (! face)
3078 {
e3ee0340
KH		 3079 int face_id;
3080 int endptr;
3081
3082 if (STRINGP (string))
3083 face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
10d16101
KH		 3084 DEFAULT_FACE_ID, 0);
3085 else
e3ee0340 3086 face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
10d16101
KH		 3087 pos + 100, 0);
3088 face = FACE_FROM_ID (f, face_id);
3089 }
e3ee0340
KH		 3090 if (multibyte)
3091 {
3092 int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
3093 face = FACE_FROM_ID (f, face_id);
3094 }
10d16101
KH		 3095 if (! face->font_info)
3096 return Qnil;
45eb10fb 3097 return font_find_object ((struct font *) face->font_info);
10d16101
KH		 3098}
3099
c2f5bfd6
KH		 3100\f
3101/* Lisp API */
3102
3103DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0,
45eb10fb
KH		 3104 doc: /* Return t if OBJECT is a font-spec or font-entity.
3105Return nil otherwise. */)
c2f5bfd6
KH		 3106 (object)
3107 Lisp_Object object;
3108{
3109 return (FONTP (object) ? Qt : Qnil);
3110}
3111
3112DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
45eb10fb
KH		 3113 doc: /* Return a newly created font-spec with arguments as properties.
3114
3115ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3116valid font property name listed below:
3117
3118`:family', `:weight', `:slant', `:width'
3119
3120They are the same as face attributes of the same name. See
3121`set-face-attribute.
3122
3123`:foundry'
3124
3125VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3126
3127`:adstyle'
3128
3129VALUE must be a string or a symbol specifying the additional
3130typographic style information of a font, e.g. ``sans''. Usually null.
3131
3132`:registry'
3133
3134VALUE must be a string or a symbol specifying the charset registry and
3135encoding of a font, e.g. ``iso8859-1''.
3136
3137`:size'
3138
3139VALUE must be a non-negative integer or a floating point number
3140specifying the font size. It specifies the font size in 1/10 pixels
f697fff0
KH		 3141(if VALUE is an integer), or in points (if VALUE is a float).
3142usage: (font-spec ARGS ...) */)
c2f5bfd6
KH		 3143 (nargs, args)
3144 int nargs;
3145 Lisp_Object *args;
3146{
3147 Lisp_Object spec = Fmake_vector (make_number (FONT_SPEC_MAX), Qnil);
c2f5bfd6
KH		 3148 int i;
3149
3150 for (i = 0; i < nargs; i += 2)
3151 {
3152 enum font_property_index prop;
3153 Lisp_Object key = args[i], val = args[i + 1];
3154
ec6fe57c 3155 prop = get_font_prop_index (key, 0);
c2f5bfd6 3156 if (prop < FONT_EXTRA_INDEX)
ec6fe57c 3157 ASET (spec, prop, val);
c2f5bfd6 3158 else
4485a28e
KH		 3159 {
3160 if (EQ (key, QCname))
ec6fe57c
KH		 3161 {
3162 CHECK_STRING (val);
3163 font_parse_name ((char *) SDATA (val), spec);
3164 }
e950d6f1 3165 font_put_extra (spec, key, val);
4485a28e 3166 }
e950d6f1 3167 }
ec6fe57c 3168 CHECK_VALIDATE_FONT_SPEC (spec);
c2f5bfd6
KH		 3169 return spec;
3170}
3171
3172
3173DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
45eb10fb 3174 doc: /* Return the value of FONT's property KEY.
e950d6f1 3175FONT is a font-spec, a font-entity, or a font-object. */)
45eb10fb
KH		 3176 (font, key)
3177 Lisp_Object font, key;
c2f5bfd6
KH		 3178{
3179 enum font_property_index idx;
3180
10d16101 3181 if (FONT_OBJECT_P (font))
e80e09b4
KH		 3182 {
3183 struct font *fontp = XSAVE_VALUE (font)->pointer;
3184
45eb10fb 3185 if (EQ (key, QCotf))
e950d6f1 3186 {
771bd479
JR		 3187 if (fontp->driver->otf_capability)
3188 return fontp->driver->otf_capability (fontp);
3189 else
3190 return Qnil;
e950d6f1 3191 }
e80e09b4
KH		 3192 font = fontp->entity;
3193 }
10d16101
KH		 3194 else
3195 CHECK_FONT (font);
45eb10fb 3196 idx = get_font_prop_index (key, 0);
c2f5bfd6
KH		 3197 if (idx < FONT_EXTRA_INDEX)
3198 return AREF (font, idx);
3199 if (FONT_ENTITY_P (font))
3200 return Qnil;
e670e827 3201 return Fcdr (Fassoc (key, AREF (font, FONT_EXTRA_INDEX)));
c2f5bfd6
KH		 3202}
3203
3204
3205DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
45eb10fb 3206 doc: /* Set one property of FONT-SPEC: give property KEY value VALUE. */)
c2f5bfd6
KH		 3207 (font_spec, prop, val)
3208 Lisp_Object font_spec, prop, val;
3209{
3210 enum font_property_index idx;
3211 Lisp_Object extra, slot;
3212
3213 CHECK_FONT_SPEC (font_spec);
ec6fe57c 3214 idx = get_font_prop_index (prop, 0);
c2f5bfd6
KH		 3215 if (idx < FONT_EXTRA_INDEX)
3216 return ASET (font_spec, idx, val);
3217 extra = AREF (font_spec, FONT_EXTRA_INDEX);
3218 slot = Fassoc (extra, prop);
3219 if (NILP (slot))
3220 extra = Fcons (Fcons (prop, val), extra);
3221 else
3222 Fsetcdr (slot, val);
3223 return val;
3224}
3225
3226DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
3227 doc: /* List available fonts matching FONT-SPEC on the current frame.
3228Optional 2nd argument FRAME specifies the target frame.
3229Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
45eb10fb
KH		 3230Optional 4th argument PREFER, if non-nil, is a font-spec to
3231control the order of the returned list. Fonts are sorted by
3232how they are close to PREFER. */)
c2f5bfd6
KH		 3233 (font_spec, frame, num, prefer)
3234 Lisp_Object font_spec, frame, num, prefer;
3235{
3236 Lisp_Object vec, list, tail;
3237 int n = 0, i, len;
3238
3239 if (NILP (frame))
3240 frame = selected_frame;
3241 CHECK_LIVE_FRAME (frame);
3242 CHECK_VALIDATE_FONT_SPEC (font_spec);
3243 if (! NILP (num))
3244 {
3245 CHECK_NUMBER (num);
3246 n = XINT (num);
3247 if (n <= 0)
3248 return Qnil;
3249 }
3250 if (! NILP (prefer))
3251 CHECK_FONT (prefer);
3252
3253 vec = font_list_entities (frame, font_spec);
3254 len = ASIZE (vec);
3255 if (len == 0)
3256 return Qnil;
3257 if (len == 1)
3258 return Fcons (AREF (vec, 0), Qnil);
3259
3260 if (! NILP (prefer))
3261 vec = font_sort_entites (vec, prefer, frame, font_spec);
3262
3263 list = tail = Fcons (AREF (vec, 0), Qnil);
3264 if (n == 0 || n > len)
3265 n = len;
3266 for (i = 1; i < n; i++)
3267 {
3268 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
3269
3270 XSETCDR (tail, val);
3271 tail = val;
3272 }
3273 return list;
3274}
3275
3276DEFUN ("list-families", Flist_families, Slist_families, 0, 1, 0,
3277 doc: /* List available font families on the current frame.
3278Optional 2nd argument FRAME specifies the target frame. */)
3279 (frame)
3280 Lisp_Object frame;
3281{
3282 FRAME_PTR f;
3283 struct font_driver_list *driver_list;
3284 Lisp_Object list;
3285
3286 if (NILP (frame))
3287 frame = selected_frame;
3288 CHECK_LIVE_FRAME (frame);
3289 f = XFRAME (frame);
3290 list = Qnil;
3291 for (driver_list = f->font_driver_list; driver_list;
3292 driver_list = driver_list->next)
3293 if (driver_list->driver->list_family)
3294 {
3295 Lisp_Object val = driver_list->driver->list_family (frame);
3296
3297 if (NILP (list))
3298 list = val;
3299 else
3300 {
3301 Lisp_Object tail = list;
3302
3303 for (; CONSP (val); val = XCDR (val))
3304 if (NILP (Fmemq (XCAR (val), tail)))
3305 list = Fcons (XCAR (val), list);
3306 }
3307 }
3308 return list;
3309}
3310
3311DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
3312 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
3313Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3314 (font_spec, frame)
3315 Lisp_Object font_spec, frame;
3316{
3317 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
3318
3319 if (CONSP (val))
3320 val = XCAR (val);
3321 return val;
3322}
3323
3324DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 1, 0,
3325 doc: /* Return XLFD name of FONT.
3326FONT is a font-spec, font-entity, or font-object.
3327If the name is too long for XLFD (maximum 255 chars), return nil. */)
3328 (font)
3329 Lisp_Object font;
3330{
3331 char name[256];
3332 int pixel_size = 0;
3333
3334 if (FONT_SPEC_P (font))
3335 CHECK_VALIDATE_FONT_SPEC (font);
3336 else if (FONT_ENTITY_P (font))
3337 CHECK_FONT (font);
3338 else
3339 {
3340 struct font *fontp;
3341
3342 CHECK_FONT_GET_OBJECT (font, fontp);
3343 font = fontp->entity;
3344 pixel_size = fontp->pixel_size;
3345 }
3346
3347 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
3348 return Qnil;
3349 return build_string (name);
3350}
3351
3352DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
3353 doc: /* Clear font cache. */)
3354 ()
3355{
3356 Lisp_Object list, frame;
3357
3358 FOR_EACH_FRAME (list, frame)
3359 {
3360 FRAME_PTR f = XFRAME (frame);
3361 struct font_driver_list *driver_list = f->font_driver_list;
3362
3363 for (; driver_list; driver_list = driver_list->next)
417a1b10
KH		 3364 if (driver_list->on)
3365 {
ca4da08a
KH		 3366 Lisp_Object cache = driver_list->driver->get_cache (f);
3367 Lisp_Object val;
c2f5bfd6 3368
ca4da08a
KH		 3369 val = XCDR (cache);
3370 while (! EQ (XCAR (val), driver_list->driver->type))
3371 val = XCDR (val);
3372 val = XCDR (XCAR (val));
3373 if (XINT (XCAR (val)) == 0)
417a1b10 3374 {
ca4da08a
KH		 3375 font_clear_cache (f, XCAR (val), driver_list->driver);
3376 XSETCDR (cache, XCDR (val));
417a1b10 3377 }
417a1b10 3378 }
c2f5bfd6
KH		 3379 }
3380
3381 return Qnil;
3382}
3383
3384DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table,
3385 Sinternal_set_font_style_table, 2, 2, 0,
3386 doc: /* Set font style table for PROP to TABLE.
3387PROP must be `:weight', `:slant', or `:width'.
3388TABLE must be an alist of symbols vs the corresponding numeric values
3389sorted by numeric values. */)
3390 (prop, table)
3391 Lisp_Object prop, table;
3392{
3393 int table_index;
3394 int numeric;
3395 Lisp_Object tail, val;
3396
3397 CHECK_SYMBOL (prop);
3398 table_index = (EQ (prop, QCweight) ? 0
3399 : EQ (prop, QCslant) ? 1
3400 : EQ (prop, QCwidth) ? 2
3401 : 3);
3402 if (table_index >= ASIZE (font_style_table))
3403 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop)));
3404 table = Fcopy_sequence (table);
3405 numeric = -1;
3406 for (tail = table; ! NILP (tail); tail = Fcdr (tail))
3407 {
3408 prop = Fcar (Fcar (tail));
3409 val = Fcdr (Fcar (tail));
3410 CHECK_SYMBOL (prop);
3411 CHECK_NATNUM (val);
3412 if (numeric > XINT (val))
3413 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop)));
3414 numeric = XINT (val);
3415 XSETCAR (tail, Fcons (prop, val));
3416 }
3417 ASET (font_style_table, table_index, table);
3418 return Qnil;
3419}
3420
45eb10fb
KH		 3421/* The following three functions are still expremental. */
3422
c2f5bfd6 3423DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0,
e80e09b4
KH		 3424 doc: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3425FONT-OBJECT may be nil if it is not yet known.
3426
3427G-string is sequence of glyphs of a specific font,
3428and is a vector of this form:
3429 [ HEADER GLYPH ... ]
3430HEADER is a vector of this form:
1701724c 3431 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
e80e09b4 3432where
733fd013 3433 FONT-OBJECT is a font-object for all glyphs in the g-string,
1701724c 3434 WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string.
e80e09b4 3435GLYPH is a vector of this form:
1701724c
KH		 3436 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3437 [ [X-OFF Y-OFF WADJUST] | nil] ]
e80e09b4
KH		 3438where
3439 FROM-IDX and TO-IDX are used internally and should not be touched.
3440 C is the character of the glyph.
3441 CODE is the glyph-code of C in FONT-OBJECT.
1701724c 3442 WIDTH thry DESCENT are the metrics (in pixels) of the glyph.
e80e09b4 3443 X-OFF and Y-OFF are offests to the base position for the glyph.
e80e09b4 3444 WADJUST is the adjustment to the normal width of the glyph. */)
c2f5bfd6
KH		 3445 (font_object, num)
3446 Lisp_Object font_object, num;
3447{
3448 Lisp_Object gstring, g;
3449 int len;
3450 int i;
3451
3452 if (! NILP (font_object))
3453 CHECK_FONT_OBJECT (font_object);
3454 CHECK_NATNUM (num);
3455
3456 len = XINT (num) + 1;
3457 gstring = Fmake_vector (make_number (len), Qnil);
3458 g = Fmake_vector (make_number (6), Qnil);
3459 ASET (g, 0, font_object);
3460 ASET (gstring, 0, g);
3461 for (i = 1; i < len; i++)
1701724c 3462 ASET (gstring, i, Fmake_vector (make_number (10), Qnil));
c2f5bfd6
KH		 3463 return gstring;
3464}
3465
3466DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
3467 doc: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3468START and END specifies the region to extract characters.
3469If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3470where to extract characters.
3471FONT-OBJECT may be nil if GSTRING already already contains one. */)
3472 (gstring, font_object, start, end, object)
3473 Lisp_Object gstring, font_object, start, end, object;
3474{
3475 int len, i, c;
3476 unsigned code;
3477 struct font *font;
3478
3479 CHECK_VECTOR (gstring);
3480 if (NILP (font_object))
10d16101 3481 font_object = LGSTRING_FONT (gstring);
c2f5bfd6
KH		 3482 CHECK_FONT_GET_OBJECT (font_object, font);
3483
3484 if (STRINGP (object))
3485 {
3486 const unsigned char *p;
3487
3488 CHECK_NATNUM (start);
3489 CHECK_NATNUM (end);
3490 if (XINT (start) > XINT (end)
3491 || XINT (end) > ASIZE (object)
10d16101 3492 || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
1701724c 3493 args_out_of_range_3 (object, start, end);
c2f5bfd6
KH		 3494
3495 len = XINT (end) - XINT (start);
3496 p = SDATA (object) + string_char_to_byte (object, XINT (start));
3497 for (i = 0; i < len; i++)
3498 {
3499 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
3500
3501 c = STRING_CHAR_ADVANCE (p);
3502 code = font->driver->encode_char (font, c);
40fb53d6
KH		 3503 if (code > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE)
3504 break;
1701724c
KH		 3505 LGLYPH_SET_FROM (g, i);
3506 LGLYPH_SET_TO (g, i);
3507 LGLYPH_SET_CHAR (g, c);
3508 LGLYPH_SET_CODE (g, code);
c2f5bfd6
KH		 3509 }
3510 }
3511 else
3512 {
3513 int pos, pos_byte;
3514
3515 if (! NILP (object))
3516 Fset_buffer (object);
3517 validate_region (&start, &end);
10d16101 3518 if (XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
c2f5bfd6
KH		 3519 args_out_of_range (start, end);
3520 len = XINT (end) - XINT (start);
3521 pos = XINT (start);
3522 pos_byte = CHAR_TO_BYTE (pos);
3523 for (i = 0; i < len; i++)
3524 {
3525 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
3526
3527 FETCH_CHAR_ADVANCE (c, pos, pos_byte);
3528 code = font->driver->encode_char (font, c);
40fb53d6
KH		 3529 if (code > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE)
3530 break;
1701724c
KH		 3531 LGLYPH_SET_FROM (g, i);
3532 LGLYPH_SET_TO (g, i);
3533 LGLYPH_SET_CHAR (g, c);
3534 LGLYPH_SET_CODE (g, code);
c2f5bfd6
KH		 3535 }
3536 }
40fb53d6 3537 for (; i < LGSTRING_LENGTH (gstring); i++)
1701724c
KH		 3538 LGSTRING_SET_GLYPH (gstring, i, Qnil);
3539 return Qnil;
3540}
3541
3542DEFUN ("font-shape-text", Ffont_shape_text, Sfont_shape_text, 3, 4, 0,
3543 doc: /* Shape text between FROM and TO by FONT-OBJECT.
3544If optional 4th argument STRING is non-nil, it is a string to shape,
3545and FROM and TO are indices to the string.
40fb53d6
KH		 3546The value is the end position of the text that can be shaped by
3547FONT-OBJECT. */)
1701724c
KH		 3548 (from, to, font_object, string)
3549 Lisp_Object from, to, font_object, string;
3550{
3551 struct font *font;
3552 struct font_metrics metrics;
3553 EMACS_INT start, end;
3554 Lisp_Object gstring, n;
40fb53d6 3555 int len, i, j;
1701724c
KH		 3556
3557 if (NILP (string))
3558 {
3559 validate_region (&from, &to);
3560 start = XFASTINT (from);
3561 end = XFASTINT (to);
3562 modify_region (current_buffer, start, end, 0);
3563 }
3564 else
3565 {
3566 CHECK_STRING (string);
3567 start = XINT (from);
3568 end = XINT (to);
3569 if (start < 0 || start > end || end > SCHARS (string))
3570 args_out_of_range_3 (string, from, to);
3571 }
3572
3573 CHECK_FONT_GET_OBJECT (font_object, font);
40fb53d6
KH		 3574 len = end - start;
3575 gstring = Ffont_make_gstring (font_object, make_number (len));
1701724c 3576 Ffont_fill_gstring (gstring, font_object, from, to, string);
e8912e41
KH		 3577 if (! font->driver->shape)
3578 {
3579 /* Make zero-width glyphs to have one pixel width to make the
3580 display routine not lose the cursor. */
3581 for (i = 0; i < len; i++)
3582 {
3583 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
0a16d567 3584 unsigned code;
e8912e41
KH		 3585 struct font_metrics metrics;
3586
0a16d567
KH		 3587 if (NILP (g))
3588 break;
3589 code = LGLYPH_CODE (g);
e8912e41
KH		 3590 if (font->driver->text_extents (font, &code, 1, &metrics) == 0)
3591 {
3592 Lisp_Object gstr = Ffont_make_gstring (font_object,
3593 make_number (1));
3594 LGSTRING_SET_WIDTH (gstr, 1);
3595 LGSTRING_SET_LBEARING (gstr, metrics.lbearing);
3596 LGSTRING_SET_RBEARING (gstr, metrics.rbearing + 1);
3597 LGSTRING_SET_ASCENT (gstr, metrics.ascent);
3598 LGSTRING_SET_DESCENT (gstr, metrics.descent);
3599 LGLYPH_SET_FROM (g, 0);
3600 LGLYPH_SET_TO (g, 1);
3601 LGSTRING_SET_GLYPH (gstr, 0, g);
3602 from = make_number (start + i);
3603 to = make_number (start + i + 1);
3604 if (NILP (string))
3605 Fcompose_region_internal (from, to, gstr, Qnil);
3606 else
3607 Fcompose_region_internal (string, from, to, gstr, Qnil);
3608 }
3609 }
3610 return make_number (end);
3611 }
3612
40fb53d6
KH		 3613
3614 /* Try at most three times with larger gstring each time. */
3615 for (i = 0; i < 3; i++)
3616 {
3617 Lisp_Object args[2];
3618
3619 n = font->driver->shape (gstring);
3620 if (INTEGERP (n))
3621 break;
3622 args[0] = gstring;
3623 args[1] = Fmake_vector (make_number (len), Qnil);
3624 gstring = Fvconcat (2, args);
3625 }
3626 if (! INTEGERP (n) || XINT (n) == 0)
1701724c 3627 return Qnil;
40fb53d6
KH		 3628 len = XINT (n);
3629
3630 for (i = 0; i < len;)
10d16101 3631 {
1701724c 3632 Lisp_Object gstr;
10d16101 3633 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
1701724c
KH		 3634 EMACS_INT this_from = LGLYPH_FROM (g);
3635 EMACS_INT this_to = LGLYPH_TO (g) + 1;
3636 int j, k;
b2937119 3637 int need_composition = 0;
1701724c
KH		 3638
3639 metrics.lbearing = LGLYPH_LBEARING (g);
3640 metrics.rbearing = LGLYPH_RBEARING (g);
3641 metrics.ascent = LGLYPH_ASCENT (g);
3642 metrics.descent = LGLYPH_DESCENT (g);
3643 if (NILP (LGLYPH_ADJUSTMENT (g)))
b2937119
KH		 3644 {
3645 metrics.width = LGLYPH_WIDTH (g);
3646 if (XINT (LGLYPH_CHAR (g)) == 0 || metrics.width == 0)
3647 need_composition = 1;
3648 }
1701724c
KH		 3649 else
3650 {
3651 metrics.width = LGLYPH_WADJUST (g);
3652 metrics.lbearing += LGLYPH_XOFF (g);
3653 metrics.rbearing += LGLYPH_XOFF (g);
3654 metrics.ascent -= LGLYPH_YOFF (g);
3655 metrics.descent += LGLYPH_YOFF (g);
b2937119 3656 need_composition = 1;
1701724c 3657 }
40fb53d6 3658 for (j = i + 1; j < len; j++)
1701724c
KH		 3659 {
3660 int x;
3661
3662 g = LGSTRING_GLYPH (gstring, j);
3663 if (this_from != LGLYPH_FROM (g))
3664 break;
b2937119 3665 need_composition = 1;
1701724c
KH		 3666 x = metrics.width + LGLYPH_LBEARING (g) + LGLYPH_XOFF (g);
3667 if (metrics.lbearing > x)
3668 metrics.lbearing = x;
3669 x = metrics.width + LGLYPH_RBEARING (g) + LGLYPH_XOFF (g);
3670 if (metrics.rbearing < x)
3671 metrics.rbearing = x;
3672 x = LGLYPH_ASCENT (g) - LGLYPH_YOFF (g);
3673 if (metrics.ascent < x)
3674 metrics.ascent = x;
3675 x = LGLYPH_DESCENT (g) - LGLYPH_YOFF (g);
3676 if (metrics.descent < x)
3677 metrics.descent = x;
3678 if (NILP (LGLYPH_ADJUSTMENT (g)))
3679 metrics.width += LGLYPH_WIDTH (g);
3680 else
3681 metrics.width += LGLYPH_WADJUST (g);
3682 }
10d16101 3683
b2937119
KH		 3684 if (need_composition)
3685 {
3686 gstr = Ffont_make_gstring (font_object, make_number (j - i));
3687 LGSTRING_SET_WIDTH (gstr, metrics.width);
3688 LGSTRING_SET_LBEARING (gstr, metrics.lbearing);
3689 LGSTRING_SET_RBEARING (gstr, metrics.rbearing);
3690 LGSTRING_SET_ASCENT (gstr, metrics.ascent);
3691 LGSTRING_SET_DESCENT (gstr, metrics.descent);
3692 for (k = i; i < j; i++)
e8912e41
KH		 3693 {
3694 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
3695
3696 LGLYPH_SET_FROM (g, LGLYPH_FROM (g) - this_from);
95d0a340 3697 LGLYPH_SET_TO (g, LGLYPH_TO (g) - this_from);
e8912e41
KH		 3698 LGSTRING_SET_GLYPH (gstr, i - k, LGSTRING_GLYPH (gstring, i));
3699 }
b2937119
KH		 3700 from = make_number (start + this_from);
3701 to = make_number (start + this_to);
3702 if (NILP (string))
3703 Fcompose_region_internal (from, to, gstr, Qnil);
3704 else
3705 Fcompose_string_internal (string, from, to, gstr, Qnil);
3706 }
1701724c 3707 else
b2937119 3708 i = j;
10d16101 3709 }
1701724c 3710
14065d35 3711 return to;
c2f5bfd6
KH		 3712}
3713
733fd013
KH		 3714DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
3715 doc: /* Apply OpenType features on glyph-string GSTRING-IN.
3716OTF-SPEC specifies which featuress to apply in this format:
3717 (SCRIPT LANGSYS GSUB GPOS)
e80e09b4
KH		 3718where
3719 SCRIPT is a symbol specifying a script tag of OpenType,
3720 LANGSYS is a symbol specifying a langsys tag of OpenType,
733fd013 3721 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
e80e09b4
KH		 3722
3723If LANGYS is nil, the default langsys is selected.
3724
733fd013
KH		 3725The features are applied in the order appeared in the list. The
3726symbol `*' means to apply all available features not appeared in this
3727list, and the remaining features are ignored. For instance, (vatu
3728pstf * haln) is to apply vatu and pstf in this order, then to apply
3729all available features other than vatu, pstf, and haln.
e80e09b4
KH		 3730
3731The features are applied to the glyphs in the range FROM and TO of
733fd013 3732the glyph-string GSTRING-IN.
e80e09b4
KH		 3733
3734If some of a feature is actually applicable, the resulting glyphs are
3735produced in the glyph-string GSTRING-OUT from the index INDEX. In
3736this case, the value is the number of produced glyphs.
3737
3738If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3739the value is 0.
3740
3741If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
3742produced in GSTRING-OUT, and the value is nil.
3743
3744See the documentation of `font-make-gstring' for the format of
3745glyph-string. */)
733fd013
KH		 3746 (otf_features, gstring_in, from, to, gstring_out, index)
3747 Lisp_Object otf_features, gstring_in, from, to, gstring_out, index;
e80e09b4
KH		 3748{
3749 Lisp_Object font_object = LGSTRING_FONT (gstring_in);
733fd013
KH		 3750 Lisp_Object val;
3751 struct font *font;
e80e09b4
KH		 3752 int len, num;
3753
733fd013 3754 check_otf_features (otf_features);
e80e09b4 3755 CHECK_FONT_GET_OBJECT (font_object, font);
733fd013 3756 if (! font->driver->otf_drive)
e80e09b4
KH		 3757 error ("Font backend %s can't drive OpenType GSUB table",
3758 SDATA (SYMBOL_NAME (font->driver->type)));
733fd013
KH		 3759 CHECK_CONS (otf_features);
3760 CHECK_SYMBOL (XCAR (otf_features));
3761 val = XCDR (otf_features);
3762 CHECK_SYMBOL (XCAR (val));
3763 val = XCDR (otf_features);
3764 if (! NILP (val))
3765 CHECK_CONS (val);
e80e09b4
KH		 3766 len = check_gstring (gstring_in);
3767 CHECK_VECTOR (gstring_out);
3768 CHECK_NATNUM (from);
3769 CHECK_NATNUM (to);
3770 CHECK_NATNUM (index);
3771
3772 if (XINT (from) >= XINT (to) || XINT (to) > len)
3773 args_out_of_range_3 (from, to, make_number (len));
3774 if (XINT (index) >= ASIZE (gstring_out))
3775 args_out_of_range (index, make_number (ASIZE (gstring_out)));
733fd013
KH		 3776 num = font->driver->otf_drive (font, otf_features,
3777 gstring_in, XINT (from), XINT (to),
3778 gstring_out, XINT (index), 0);
e80e09b4
KH		 3779 if (num < 0)
3780 return Qnil;
3781 return make_number (num);
3782}
3783
e80e09b4
KH		 3784DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
3785 3, 3, 0,
3786 doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
3787FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
3788in this format:
3789 (SCRIPT LANGSYS FEATURE ...)
3790See the documentation of `font-otf-gsub' for more detail.
3791
3792The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
3793where GLYPH-ID is a glyph index of the font, and CHARACTER is a
3794character code corresponding to the glyph or nil if there's no
3795corresponding character. */)
733fd013
KH		 3796 (font_object, character, otf_features)
3797 Lisp_Object font_object, character, otf_features;
e80e09b4
KH		 3798{
3799 struct font *font;
3800 Lisp_Object gstring_in, gstring_out, g;
3801 Lisp_Object alternates;
3802 int i, num;
3803
3804 CHECK_FONT_GET_OBJECT (font_object, font);
733fd013 3805 if (! font->driver->otf_drive)
e950d6f1
KH		 3806 error ("Font backend %s can't drive OpenType GSUB table",
3807 SDATA (SYMBOL_NAME (font->driver->type)));
e80e09b4 3808 CHECK_CHARACTER (character);
733fd013 3809 CHECK_CONS (otf_features);
e80e09b4
KH		 3810
3811 gstring_in = Ffont_make_gstring (font_object, make_number (1));
3812 g = LGSTRING_GLYPH (gstring_in, 0);
3813 LGLYPH_SET_CHAR (g, character);
3814 gstring_out = Ffont_make_gstring (font_object, make_number (10));
733fd013
KH		 3815 while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
3816 gstring_out, 0, 1)) < 0)
e80e09b4
KH		 3817 gstring_out = Ffont_make_gstring (font_object,
3818 make_number (ASIZE (gstring_out) * 2));
3819 alternates = Qnil;
3820 for (i = 0; i < num; i++)
3821 {
3822 Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
3823 int c = XINT (LGLYPH_CHAR (g));
3824 unsigned code = XUINT (LGLYPH_CODE (g));
e80e09b4
KH		 3825
3826 alternates = Fcons (Fcons (make_number (code),
3827 c > 0 ? make_number (c) : Qnil),
3828 alternates);
3829 }
3830 return Fnreverse (alternates);
3831}
3832
c2f5bfd6
KH		 3833
3834#ifdef FONT_DEBUG
3835
3836DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
3837 doc: /* Open FONT-ENTITY. */)
3838 (font_entity, size, frame)
3839 Lisp_Object font_entity;
3840 Lisp_Object size;
3841 Lisp_Object frame;
3842{
3843 int isize;
3844
3845 CHECK_FONT_ENTITY (font_entity);
3846 if (NILP (size))
3847 size = AREF (font_entity, FONT_SIZE_INDEX);
3848 CHECK_NUMBER (size);
3849 if (NILP (frame))
3850 frame = selected_frame;
3851 CHECK_LIVE_FRAME (frame);
3852
3853 isize = XINT (size);
1701724c
KH		 3854 if (isize == 0)
3855 isize = 120;
c2f5bfd6
KH		 3856 if (isize < 0)
3857 isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
3858
3859 return font_open_entity (XFRAME (frame), font_entity, isize);
3860}
3861
3862DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
3863 doc: /* Close FONT-OBJECT. */)
3864 (font_object, frame)
3865 Lisp_Object font_object, frame;
3866{
3867 CHECK_FONT_OBJECT (font_object);
3868 if (NILP (frame))
3869 frame = selected_frame;
3870 CHECK_LIVE_FRAME (frame);
3871 font_close_object (XFRAME (frame), font_object);
3872 return Qnil;
3873}
3874
3875DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
e80e09b4
KH		 3876 doc: /* Return information about FONT-OBJECT.
3877The value is a vector:
3878 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
e0708580 3879 CAPABILITY ]
e80e09b4
KH		 3880
3881NAME is a string of the font name (or nil if the font backend doesn't
3882provide a name).
3883
3884FILENAME is a string of the font file (or nil if the font backend
3885doesn't provide a file name).
3886
3887PIXEL-SIZE is a pixel size by which the font is opened.
3888
3889SIZE is a maximum advance width of the font in pixel.
3890
3891ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
3892pixel.
3893
e0708580
KH		 3894CAPABILITY is a list whose first element is a symbol representing the
3895font format \(x, opentype, truetype, type1, pcf, or bdf) and the
3896remaining elements describes a detail of the font capability.
3897
3898If the font is OpenType font, the form of the list is
3899 \(opentype GSUB GPOS)
3900where GSUB shows which "GSUB" features the font supports, and GPOS
3901shows which "GPOS" features the font supports. Both GSUB and GPOS are
3902lists of the format:
3903 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3904
3905If the font is not OpenType font, currently the length of the form is
3906one.
e80e09b4
KH		 3907
3908SCRIPT is a symbol representing OpenType script tag.
3909
3910LANGSYS is a symbol representing OpenType langsys tag, or nil
3911representing the default langsys.
3912
3913FEATURE is a symbol representing OpenType feature tag.
3914
3915If the font is not OpenType font, OTF-CAPABILITY is nil. */)
c2f5bfd6
KH		 3916 (font_object)
3917 Lisp_Object font_object;
3918{
3919 struct font *font;
3920 Lisp_Object val;
3921
3922 CHECK_FONT_GET_OBJECT (font_object, font);
3923
3924 val = Fmake_vector (make_number (9), Qnil);
e80e09b4
KH		 3925 if (font->font.full_name)
3926 ASET (val, 0, make_unibyte_string (font->font.full_name,
3927 strlen (font->font.full_name)));
c2f5bfd6
KH		 3928 if (font->file_name)
3929 ASET (val, 1, make_unibyte_string (font->file_name,
3930 strlen (font->file_name)));
3931 ASET (val, 2, make_number (font->pixel_size));
3932 ASET (val, 3, make_number (font->font.size));
3933 ASET (val, 4, make_number (font->ascent));
3934 ASET (val, 5, make_number (font->descent));
3935 ASET (val, 6, make_number (font->font.space_width));
3936 ASET (val, 7, make_number (font->font.average_width));
3937 if (font->driver->otf_capability)
e0708580
KH		 3938 ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
3939 else
3940 ASET (val, 8, Fcons (font->format, Qnil));
c2f5bfd6
KH		 3941 return val;
3942}
3943
3944DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
3945 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3946Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3947 (font_object, string)
3948 Lisp_Object font_object, string;
3949{
3950 struct font *font;
3951 int i, len;
3952 Lisp_Object vec;
3953
3954 CHECK_FONT_GET_OBJECT (font_object, font);
3955 CHECK_STRING (string);
3956 len = SCHARS (string);
3957 vec = Fmake_vector (make_number (len), Qnil);
3958 for (i = 0; i < len; i++)
3959 {
3960 Lisp_Object ch = Faref (string, make_number (i));
3961 Lisp_Object val;
3962 int c = XINT (ch);
3963 unsigned code;
3964 struct font_metrics metrics;
3965
3966 code = font->driver->encode_char (font, c);
3967 if (code == FONT_INVALID_CODE)
3968 continue;
3969 val = Fmake_vector (make_number (6), Qnil);
3970 if (code <= MOST_POSITIVE_FIXNUM)
3971 ASET (val, 0, make_number (code));
3972 else
3973 ASET (val, 0, Fcons (make_number (code >> 16),
3974 make_number (code & 0xFFFF)));
3975 font->driver->text_extents (font, &code, 1, &metrics);
3976 ASET (val, 1, make_number (metrics.lbearing));
3977 ASET (val, 2, make_number (metrics.rbearing));
3978 ASET (val, 3, make_number (metrics.width));
3979 ASET (val, 4, make_number (metrics.ascent));
3980 ASET (val, 5, make_number (metrics.descent));
3981 ASET (vec, i, val);
3982 }
3983 return vec;
3984}
3985
ec6fe57c
KH		 3986DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
3987 doc: /* Return t iff font-spec SPEC matches with FONT.
3988FONT is a font-spec, font-entity, or font-object. */)
3989 (spec, font)
3990 Lisp_Object spec, font;
3991{
3992 CHECK_FONT_SPEC (spec);
3993 if (FONT_OBJECT_P (font))
3994 font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity;
3995 else if (! FONT_ENTITY_P (font))
3996 CHECK_FONT_SPEC (font);
3997
3998 return (font_match_p (spec, font) ? Qt : Qnil);
3999}
4000
1701724c 4001DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
10d16101
KH		 4002 doc: /* Return a font-object for displaying a character at POSISTION.
4003Optional second arg WINDOW, if non-nil, is a window displaying
4004the current buffer. It defaults to the currently selected window. */)
1701724c
KH		 4005 (position, window, string)
4006 Lisp_Object position, window, string;
10d16101
KH		 4007{
4008 struct window *w;
e3ee0340 4009 EMACS_INT pos;
10d16101 4010
1701724c
KH		 4011 if (NILP (string))
4012 {
4013 CHECK_NUMBER_COERCE_MARKER (position);
4014 pos = XINT (position);
4015 if (pos < BEGV || pos >= ZV)
4016 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1701724c
KH		 4017 }
4018 else
4019 {
4020 EMACS_INT len;
4021 unsigned char *str;
4022
4023 CHECK_NUMBER (position);
4024 CHECK_STRING (string);
4025 pos = XINT (position);
4026 if (pos < 0 || pos >= SCHARS (string))
4027 args_out_of_range (string, position);
1701724c 4028 }
10d16101
KH		 4029 if (NILP (window))
4030 window = selected_window;
4031 CHECK_LIVE_WINDOW (window);
40fb53d6 4032 w = XWINDOW (window);
10d16101 4033
40fb53d6 4034 return font_at (-1, pos, NULL, w, string);
10d16101
KH		 4035}
4036
c2f5bfd6
KH		 4037#if 0
4038DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
4039 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4040The value is a number of glyphs drawn.
4041Type C-l to recover what previously shown. */)
4042 (font_object, string)
4043 Lisp_Object font_object, string;
4044{
4045 Lisp_Object frame = selected_frame;
4046 FRAME_PTR f = XFRAME (frame);
4047 struct font *font;
4048 struct face *face;
4049 int i, len, width;
4050 unsigned *code;
4051
4052 CHECK_FONT_GET_OBJECT (font_object, font);
4053 CHECK_STRING (string);
4054 len = SCHARS (string);
4055 code = alloca (sizeof (unsigned) * len);
4056 for (i = 0; i < len; i++)
4057 {
4058 Lisp_Object ch = Faref (string, make_number (i));
4059 Lisp_Object val;
4060 int c = XINT (ch);
4061
4062 code[i] = font->driver->encode_char (font, c);
4063 if (code[i] == FONT_INVALID_CODE)
4064 break;
4065 }
4066 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4067 face->fontp = font;
4068 if (font->driver->prepare_face)
4069 font->driver->prepare_face (f, face);
4070 width = font->driver->text_extents (font, code, i, NULL);
4071 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
4072 if (font->driver->done_face)
4073 font->driver->done_face (f, face);
4074 face->fontp = NULL;
4075 return make_number (len);
4076}
4077#endif
4078
4079#endif /* FONT_DEBUG */
4080
4081\f
4082extern void syms_of_ftfont P_ (());
4083extern void syms_of_xfont P_ (());
4084extern void syms_of_xftfont P_ (());
4085extern void syms_of_ftxfont P_ (());
4086extern void syms_of_bdffont P_ (());
4087extern void syms_of_w32font P_ (());
4088extern void syms_of_atmfont P_ (());
4089
4090void
4091syms_of_font ()
4092{
4093 sort_shift_bits[FONT_SLANT_INDEX] = 0;
4094 sort_shift_bits[FONT_WEIGHT_INDEX] = 7;
4095 sort_shift_bits[FONT_SIZE_INDEX] = 14;
4096 sort_shift_bits[FONT_WIDTH_INDEX] = 21;
4097 sort_shift_bits[FONT_ADSTYLE_INDEX] = 28;
4098 sort_shift_bits[FONT_FOUNDRY_INDEX] = 29;
4099 sort_shift_bits[FONT_FAMILY_INDEX] = 30;
4100 sort_shift_bits[FONT_REGISTRY_INDEX] = 31;
fe5ddfbc 4101 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
c2f5bfd6
KH		 4102
4103 staticpro (&font_style_table);
4104 font_style_table = Fmake_vector (make_number (3), Qnil);
4105
4106 staticpro (&font_family_alist);
4107 font_family_alist = Qnil;
4108
1701724c
KH		 4109 staticpro (&font_charset_alist);
4110 font_charset_alist = Qnil;
4111
e0708580 4112 DEFSYM (Qopentype, "opentype");
c2f5bfd6 4113
1bb1d99b
KH		 4114 DEFSYM (Qiso8859_1, "iso8859-1");
4115 DEFSYM (Qiso10646_1, "iso10646-1");
4116 DEFSYM (Qunicode_bmp, "unicode-bmp");
cf96c5c2 4117 DEFSYM (Qunicode_sip, "unicode-sip");
1bb1d99b 4118
c2f5bfd6
KH		 4119 DEFSYM (QCotf, ":otf");
4120 DEFSYM (QClanguage, ":language");
4121 DEFSYM (QCscript, ":script");
4c496d0d 4122 DEFSYM (QCantialias, ":antialias");
c2f5bfd6
KH		 4123
4124 DEFSYM (QCfoundry, ":foundry");
4125 DEFSYM (QCadstyle, ":adstyle");
4126 DEFSYM (QCregistry, ":registry");
9331887d
KH		 4127 DEFSYM (QCspacing, ":spacing");
4128 DEFSYM (QCdpi, ":dpi");
ec6fe57c 4129 DEFSYM (QCscalable, ":scalable");
c2f5bfd6
KH		 4130 DEFSYM (QCextra, ":extra");
4131
ec6fe57c
KH		 4132 DEFSYM (Qc, "c");
4133 DEFSYM (Qm, "m");
4134 DEFSYM (Qp, "p");
4135 DEFSYM (Qd, "d");
4136
c2f5bfd6
KH		 4137 staticpro (&null_string);
4138 null_string = build_string ("");
4139 staticpro (&null_vector);
4140 null_vector = Fmake_vector (make_number (0), Qnil);
4141
4142 staticpro (&scratch_font_spec);
4143 scratch_font_spec = Ffont_spec (0, NULL);
4144 staticpro (&scratch_font_prefer);
4145 scratch_font_prefer = Ffont_spec (0, NULL);
4146
733fd013
KH		 4147#ifdef HAVE_LIBOTF
4148 staticpro (&otf_list);
4149 otf_list = Qnil;
4150#endif
4151
c2f5bfd6
KH		 4152 defsubr (&Sfontp);
4153 defsubr (&Sfont_spec);
4154 defsubr (&Sfont_get);
4155 defsubr (&Sfont_put);
4156 defsubr (&Slist_fonts);
4157 defsubr (&Slist_families);
4158 defsubr (&Sfind_font);
4159 defsubr (&Sfont_xlfd_name);
4160 defsubr (&Sclear_font_cache);
4161 defsubr (&Sinternal_set_font_style_table);
4162 defsubr (&Sfont_make_gstring);
4163 defsubr (&Sfont_fill_gstring);
1701724c 4164 defsubr (&Sfont_shape_text);
733fd013 4165 defsubr (&Sfont_drive_otf);
e80e09b4 4166 defsubr (&Sfont_otf_alternates);
c2f5bfd6
KH		 4167
4168#ifdef FONT_DEBUG
4169 defsubr (&Sopen_font);
4170 defsubr (&Sclose_font);
4171 defsubr (&Squery_font);
4172 defsubr (&Sget_font_glyphs);
ec6fe57c 4173 defsubr (&Sfont_match_p);
10d16101 4174 defsubr (&Sfont_at);
c2f5bfd6
KH		 4175#if 0
4176 defsubr (&Sdraw_string);
4177#endif
4178#endif /* FONT_DEBUG */
4179
1701724c
KH		 4180#ifdef USE_FONT_BACKEND
4181 if (enable_font_backend)
4182 {
c2f5bfd6 4183#ifdef HAVE_FREETYPE
1701724c 4184 syms_of_ftfont ();
c2f5bfd6 4185#ifdef HAVE_X_WINDOWS
1701724c
KH		 4186 syms_of_xfont ();
4187 syms_of_ftxfont ();
c2f5bfd6 4188#ifdef HAVE_XFT
1701724c 4189 syms_of_xftfont ();
c2f5bfd6
KH		 4190#endif /* HAVE_XFT */
4191#endif /* HAVE_X_WINDOWS */
4192#else /* not HAVE_FREETYPE */
4193#ifdef HAVE_X_WINDOWS
1701724c 4194 syms_of_xfont ();
c2f5bfd6
KH		 4195#endif /* HAVE_X_WINDOWS */
4196#endif /* not HAVE_FREETYPE */
4197#ifdef HAVE_BDFFONT
1701724c 4198 syms_of_bdffont ();
c2f5bfd6
KH		 4199#endif /* HAVE_BDFFONT */
4200#ifdef WINDOWSNT
1701724c 4201 syms_of_w32font ();
c2f5bfd6
KH		 4202#endif /* WINDOWSNT */
4203#ifdef MAC_OS
1701724c 4204 syms_of_atmfont ();
c2f5bfd6 4205#endif /* MAC_OS */
1701724c
KH		 4206 }
4207#endif /* USE_FONT_BACKEND */
c2f5bfd6 4208}
885b7d09
MB		 4209
4210/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4211 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.