HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Merge from emacs--devo--0
[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;
ef18374f 1251
ec6fe57c
KH		 1252 if (len == 0)
1253 return -1;
ef18374f
KH		 1254 /* It is assured that (name[0] && name[0] != '-'). */
1255 if (name[0] == ':')
1256 p0 = name;
1257 else
1258 {
ec6fe57c
KH		 1259 Lisp_Object family;
1260 double point_size;
1261
1262 for (p0 = name + 1; *p0 && (*p0 != '-' && *p0 != ':'); p0++)
1263 if (*p0 == '\\' && p0[1])
1264 p0++;
1265 family = intern_font_field (name, p0 - name);
1266 if (*p0 == '-')
ef18374f 1267 {
ec6fe57c
KH		 1268 if (! isdigit (p0[1]))
1269 return -1;
1270 point_size = strtod (p0 + 1, &p1);
1271 if (*p1 && *p1 != ':')
1272 return -1;
1273 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
1274 p0 = p1;
ef18374f 1275 }
ec6fe57c 1276 ASET (font, FONT_FAMILY_INDEX, family);
ef18374f 1277 }
9331887d
KH		 1278
1279 len -= p0 - name;
1280 copy = alloca (len + 1);
1281 if (! copy)
1282 return -1;
1283 name = copy;
1284
1285 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1286 extra, copy unknown ones to COPY. */
ef18374f
KH		 1287 while (*p0)
1288 {
1289 Lisp_Object key, val;
ec6fe57c 1290 int prop;
ef18374f 1291
ec6fe57c 1292 for (p1 = p0 + 1; *p1 && *p1 != '=' && *p1 != ':'; p1++);
9331887d 1293 if (*p1 != '=')
ef18374f 1294 {
9331887d
KH		 1295 /* Must be an enumerated value. */
1296 val = intern_font_field (p0 + 1, p1 - p0 - 1);
9331887d
KH		 1297 if (memcmp (p0 + 1, "light", 5) == 0
1298 || memcmp (p0 + 1, "medium", 6) == 0
1299 || memcmp (p0 + 1, "demibold", 8) == 0
1300 || memcmp (p0 + 1, "bold", 4) == 0
1301 || memcmp (p0 + 1, "black", 5) == 0)
1302 {
ec6fe57c 1303 ASET (font, FONT_WEIGHT_INDEX, val);
9331887d
KH		 1304 }
1305 else if (memcmp (p0 + 1, "roman", 5) == 0
1306 || memcmp (p0 + 1, "italic", 6) == 0
1307 || memcmp (p0 + 1, "oblique", 7) == 0)
1308 {
ec6fe57c 1309 ASET (font, FONT_SLANT_INDEX, val);
9331887d
KH		 1310 }
1311 else if (memcmp (p0 + 1, "charcell", 8) == 0
1312 || memcmp (p0 + 1, "mono", 4) == 0
1313 || memcmp (p0 + 1, "proportional", 12) == 0)
1314 {
1315 font_put_extra (font, QCspacing,
ec6fe57c 1316 (p0[1] == 'c' ? Qc : p0[1] == 'm' ? Qm : Qp));
9331887d
KH		 1317 }
1318 else
1319 {
1320 /* unknown key */
1321 bcopy (p0, copy, p1 - p0);
1322 copy += p1 - p0;
1323 }
ef18374f
KH		 1324 }
1325 else
1326 {
9331887d
KH		 1327 if (memcmp (p0 + 1, "pixelsize=", 10) == 0)
1328 prop = FONT_SIZE_INDEX;
1329 else
1330 {
1331 key = intern_font_field (p0, p1 - p0);
ec6fe57c 1332 prop = get_font_prop_index (key, 0);
9331887d
KH		 1333 }
1334 p0 = p1 + 1;
1335 for (p1 = p0; *p1 && *p1 != ':'; p1++);
ec6fe57c
KH		 1336 val = intern_font_field (p0, p1 - p0);
1337 if (! NILP (val))
9331887d 1338 {
ec6fe57c 1339 if (prop >= 0 && prop < FONT_EXTRA_INDEX)
ef18374f 1340 {
ec6fe57c
KH		 1341 ASET (font, prop, val);
1342 }
ec6fe57c 1343 else
e950d6f1 1344 font_put_extra (font, key, val);
ef18374f
KH		 1345 }
1346 }
1347 p0 = p1;
1348 }
9331887d 1349
9331887d 1350 return 0;
ef18374f
KH		 1351}
1352
1353/* Store fontconfig's font name of FONT (font-spec or font-entity) in
1354 NAME (NBYTES length), and return the name length. If
1355 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1356
1357int
1358font_unparse_fcname (font, pixel_size, name, nbytes)
1359 Lisp_Object font;
1360 int pixel_size;
1361 char *name;
1362 int nbytes;
1363{
ec6fe57c
KH		 1364 Lisp_Object val;
1365 int point_size;
1366 int dpi, spacing, scalable;
1367 int i, len = 1;
ef18374f 1368 char *p;
a9262bb8 1369 Lisp_Object styles[3];
417a1b10 1370 char *style_names[3] = { "weight", "slant", "width" };
ef18374f 1371
ec6fe57c
KH		 1372 val = AREF (font, FONT_FAMILY_INDEX);
1373 if (SYMBOLP (val) && ! NILP (val))
1374 len += SBYTES (SYMBOL_NAME (val));
1375
1376 val = AREF (font, FONT_SIZE_INDEX);
1377 if (INTEGERP (val))
ef18374f 1378 {
ec6fe57c
KH		 1379 if (XINT (val) != 0)
1380 pixel_size = XINT (val);
1381 point_size = -1;
1382 len += 21; /* for ":pixelsize=NUM" */
ef18374f 1383 }
ec6fe57c 1384 else if (FLOATP (val))
ef18374f 1385 {
ec6fe57c
KH		 1386 pixel_size = -1;
1387 point_size = (int) XFLOAT_DATA (val);
1388 len += 11; /* for "-NUM" */
ef18374f 1389 }
ec6fe57c
KH		 1390
1391 val = AREF (font, FONT_FOUNDRY_INDEX);
8e1ef8fd 1392 if (SYMBOLP (val) && ! NILP (val))
ef18374f 1393 /* ":foundry=NAME" */
ec6fe57c
KH		 1394 len += 9 + SBYTES (SYMBOL_NAME (val));
1395
a9262bb8
KH		 1396 for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
1397 {
1398 val = AREF (font, i);
1399 if (INTEGERP (val))
1400 {
1401 val = prop_numeric_to_name (i, XINT (val));
1402 len += (strlen (style_names[i - FONT_WEIGHT_INDEX])
1403 + 2 + SBYTES (SYMBOL_NAME (val))); /* :xxx=NAME */
1404 }
1405 styles[i - FONT_WEIGHT_INDEX] = val;
1406 }
ec6fe57c
KH		 1407
1408 val = AREF (font, FONT_EXTRA_INDEX);
1409 if (FONT_ENTITY_P (font)
1410 && EQ (AREF (font, FONT_TYPE_INDEX), Qx))
1411 {
1412 char *p;
1413
1414 /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
1415 p = (char *) SDATA (SYMBOL_NAME (val));
1416 dpi = atoi (p);
1417 for (p++; *p != '-'; p++); /* skip RESX */
1418 for (p++; *p != '-'; p++); /* skip RESY */
1419 spacing = (*p == 'c' ? FONT_SPACING_CHARCELL
1420 : *p == 'm' ? FONT_SPACING_MONO
1421 : FONT_SPACING_PROPORTIONAL);
1422 for (p++; *p != '-'; p++); /* skip SPACING */
1423 scalable = (atoi (p) == 0);
1424 /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
1425 len += 42;
1426 }
1427 else
1428 {
1429 Lisp_Object elt;
1430
1431 dpi = spacing = scalable = -1;
1432 elt = assq_no_quit (QCdpi, val);
1433 if (CONSP (elt))
1434 dpi = XINT (XCDR (elt)), len += 15; /* for ":dpi=NUM" */
1435 elt = assq_no_quit (QCspacing, val);
1436 if (CONSP (elt))
1437 spacing = XINT (XCDR (elt)), len += 12; /* for ":spacing=100" */
1438 elt = assq_no_quit (QCscalable, val);
1439 if (CONSP (elt))
1440 scalable = ! NILP (XCDR (elt)), len += 15; /* for ":scalable=False" */
1441 }
1442
ef18374f
KH		 1443 if (len > nbytes)
1444 return -1;
1445 p = name;
1446 if (! NILP (AREF (font, FONT_FAMILY_INDEX)))
a9262bb8
KH		 1447 p += sprintf(p, "%s",
1448 SDATA (SYMBOL_NAME (AREF (font, FONT_FAMILY_INDEX))));
ec6fe57c
KH		 1449 if (point_size > 0)
1450 {
1451 if (p == name)
1452 p += sprintf (p, "%d", point_size);
1453 else
1454 p += sprintf (p, "-%d", point_size);
1455 }
ef18374f
KH		 1456 else if (pixel_size > 0)
1457 p += sprintf (p, ":pixelsize=%d", pixel_size);
a9262bb8
KH		 1458 if (SYMBOLP (AREF (font, FONT_FOUNDRY_INDEX))
1459 && ! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
1460 p += sprintf (p, ":foundry=%s",
1461 SDATA (SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX))));
1462 for (i = 0; i < 3; i++)
f73891b0 1463 if (SYMBOLP (styles[i]) && ! NILP (styles [i]))
a9262bb8
KH		 1464 p += sprintf (p, ":%s=%s", style_names[i],
1465 SDATA (SYMBOL_NAME (styles [i])));
ec6fe57c
KH		 1466 if (dpi >= 0)
1467 p += sprintf (p, ":dpi=%d", dpi);
1468 if (spacing >= 0)
1469 p += sprintf (p, ":spacing=%d", spacing);
1470 if (scalable > 0)
1471 p += sprintf (p, ":scalable=True");
1472 else if (scalable == 0)
1473 p += sprintf (p, ":scalable=False");
ef18374f
KH		 1474 return (p - name);
1475}
1476
1477/* Parse NAME (null terminated) and store information in FONT
1478 (font-spec or font-entity). If NAME is successfully parsed, return
ec6fe57c 1479 0. Otherwise return -1.
ef18374f
KH		 1480
1481 If NAME is XLFD and FONT is a font-entity, store
ec6fe57c
KH		 1482 RESX-RESY-SPACING-AVWIDTH information as a symbol in
1483 FONT_EXTRA_INDEX. */
ef18374f
KH		 1484
1485static int
ec6fe57c 1486font_parse_name (name, font)
ef18374f
KH		 1487 char *name;
1488 Lisp_Object font;
ef18374f
KH		 1489{
1490 if (name[0] == '-' || index (name, '*'))
e950d6f1 1491 return font_parse_xlfd (name, font);
ec6fe57c 1492 return font_parse_fcname (name, font);
ef18374f
KH		 1493}
1494
45eb10fb
KH		 1495/* Merge old style font specification (either a font name NAME or a
1496 combination of a family name FAMILY and a registry name REGISTRY
1497 into the font specification SPEC. */
1498
c2f5bfd6
KH		 1499void
1500font_merge_old_spec (name, family, registry, spec)
1501 Lisp_Object name, family, registry, spec;
1502{
1503 if (STRINGP (name))
1504 {
ec6fe57c 1505 if (font_parse_xlfd ((char *) SDATA (name), spec) < 0)
c2f5bfd6
KH		 1506 {
1507 Lisp_Object extra = Fcons (Fcons (QCname, name), Qnil);
1508
1509 ASET (spec, FONT_EXTRA_INDEX, extra);
1510 }
1511 }
1512 else
1513 {
1514 if (! NILP (family))
1515 {
1516 int len;
1517 char *p0, *p1;
1518
1519 xassert (STRINGP (family));
1520 len = SBYTES (family);
1521 p0 = (char *) SDATA (family);
1522 p1 = index (p0, '-');
1523 if (p1)
1524 {
0c363472
KH		 1525 if ((*p0 != '*' || p1 - p0 > 1)
1526 && NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
c2f5bfd6
KH		 1527 ASET (spec, FONT_FOUNDRY_INDEX,
1528 intern_downcase (p0, p1 - p0));
1529 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
1530 ASET (spec, FONT_FAMILY_INDEX,
1531 intern_downcase (p1 + 1, len - (p1 + 1 - p0)));
1532 }
1533 else if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
1534 ASET (spec, FONT_FAMILY_INDEX, intern_downcase (p0, len));
1535 }
1536 if (! NILP (registry)
1537 && NILP (AREF (spec, FONT_REGISTRY_INDEX)))
1538 ASET (spec, FONT_REGISTRY_INDEX,
1539 intern_downcase ((char *) SDATA (registry), SBYTES (registry)));
1540 }
1541}
1542
45eb10fb
KH		 1543\f
1544/* This part (through the next ^L) is still experimental and never
1545 tested. We may drastically change codes. */
10d16101 1546
45eb10fb 1547/* OTF handler */
10d16101 1548
e950d6f1
KH		 1549#define LGSTRING_HEADER_SIZE 6
1550#define LGSTRING_GLYPH_SIZE 8
1551
1552static int
1553check_gstring (gstring)
1554 Lisp_Object gstring;
1555{
1556 Lisp_Object val;
1557 int i, j;
1558
1559 CHECK_VECTOR (gstring);
1560 val = AREF (gstring, 0);
1561 CHECK_VECTOR (val);
1562 if (ASIZE (val) < LGSTRING_HEADER_SIZE)
1563 goto err;
1564 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
1565 if (! NILP (LGSTRING_LBEARING (gstring)))
1566 CHECK_NUMBER (LGSTRING_LBEARING (gstring));
1567 if (! NILP (LGSTRING_RBEARING (gstring)))
1568 CHECK_NUMBER (LGSTRING_RBEARING (gstring));
1569 if (! NILP (LGSTRING_WIDTH (gstring)))
1570 CHECK_NATNUM (LGSTRING_WIDTH (gstring));
1571 if (! NILP (LGSTRING_ASCENT (gstring)))
1572 CHECK_NUMBER (LGSTRING_ASCENT (gstring));
1573 if (! NILP (LGSTRING_DESCENT (gstring)))
1574 CHECK_NUMBER (LGSTRING_DESCENT(gstring));
1575
1576 for (i = 0; i < LGSTRING_LENGTH (gstring); i++)
1577 {
1578 val = LGSTRING_GLYPH (gstring, i);
1579 CHECK_VECTOR (val);
1580 if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
1581 goto err;
1582 if (NILP (LGLYPH_CHAR (val)))
1583 break;
1584 CHECK_NATNUM (LGLYPH_FROM (val));
1585 CHECK_NATNUM (LGLYPH_TO (val));
1586 CHECK_CHARACTER (LGLYPH_CHAR (val));
1587 if (! NILP (LGLYPH_CODE (val)))
1588 CHECK_NATNUM (LGLYPH_CODE (val));
1589 if (! NILP (LGLYPH_WIDTH (val)))
1590 CHECK_NATNUM (LGLYPH_WIDTH (val));
1591 if (! NILP (LGLYPH_ADJUSTMENT (val)))
1592 {
1593 val = LGLYPH_ADJUSTMENT (val);
1594 CHECK_VECTOR (val);
1595 if (ASIZE (val) < 3)
1596 goto err;
1597 for (j = 0; j < 3; j++)
1598 CHECK_NUMBER (AREF (val, j));
1599 }
1600 }
1601 return i;
1602 err:
1603 error ("Invalid glyph-string format");
1604 return -1;
1605}
1606
cf385d93
KH		 1607static void
1608check_otf_features (otf_features)
1609 Lisp_Object otf_features;
1610{
1611 Lisp_Object val, elt;
1612
1613 CHECK_CONS (otf_features);
1614 CHECK_SYMBOL (XCAR (otf_features));
1615 otf_features = XCDR (otf_features);
1616 CHECK_CONS (otf_features);
1617 CHECK_SYMBOL (XCAR (otf_features));
1618 otf_features = XCDR (otf_features);
1619 for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
1620 {
1621 CHECK_SYMBOL (Fcar (val));
1622 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1623 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val)));
1624 }
1625 otf_features = XCDR (otf_features);
1626 for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
1627 {
1628 CHECK_SYMBOL (Fcar (val));
1629 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1630 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val)));
1631 }
1632}
1633
c2f5bfd6
KH		 1634#ifdef HAVE_LIBOTF
1635#include <otf.h>
1636
733fd013 1637Lisp_Object otf_list;
c2f5bfd6
KH		 1638
1639static Lisp_Object
1640otf_tag_symbol (tag)
1641 OTF_Tag tag;
1642{
1643 char name[5];
1644
1645 OTF_tag_name (tag, name);
1646 return Fintern (make_unibyte_string (name, 4), Qnil);
1647}
1648
1649static OTF *
1650otf_open (entity, file)
1651 Lisp_Object entity;
1652 char *file;
1653{
733fd013
KH		 1654 Lisp_Object val = Fassoc (entity, otf_list);
1655 OTF *otf;
1656
1657 if (! NILP (val))
1658 otf = XSAVE_VALUE (XCDR (val))->pointer;
1659 else
c2f5bfd6 1660 {
733fd013
KH		 1661 otf = file ? OTF_open (file) : NULL;
1662 val = make_save_value (otf, 0);
1663 otf_list = Fcons (Fcons (entity, val), otf_list);
c2f5bfd6 1664 }
733fd013 1665 return otf;
c2f5bfd6
KH		 1666}
1667
1668
1669/* Return a list describing which scripts/languages FONT supports by
1670 which GSUB/GPOS features of OpenType tables. See the comment of
1671 (sturct font_driver).otf_capability. */
1672
1673Lisp_Object
1674font_otf_capability (font)
1675 struct font *font;
1676{
1677 OTF *otf;
1678 Lisp_Object capability = Fcons (Qnil, Qnil);
1679 int i;
1680
1681 otf = otf_open (font->entity, font->file_name);
1682 if (! otf)
1683 return Qnil;
1684 for (i = 0; i < 2; i++)
1685 {
1686 OTF_GSUB_GPOS *gsub_gpos;
1687 Lisp_Object script_list = Qnil;
1688 int j;
1689
1690 if (OTF_get_features (otf, i == 0) < 0)
1691 continue;
1692 gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
1693 for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
1694 {
1695 OTF_Script *script = gsub_gpos->ScriptList.Script + j;
1696 Lisp_Object langsys_list = Qnil;
1697 Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
1698 int k;
1699
1700 for (k = script->LangSysCount; k >= 0; k--)
1701 {
1702 OTF_LangSys *langsys;
1703 Lisp_Object feature_list = Qnil;
1704 Lisp_Object langsys_tag;
1705 int l;
1706
e80e09b4 1707 if (k == script->LangSysCount)
c2f5bfd6
KH		 1708 {
1709 langsys = &script->DefaultLangSys;
1710 langsys_tag = Qnil;
1711 }
1712 else
1713 {
1714 langsys = script->LangSys + k;
1715 langsys_tag
1716 = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
1717 }
e80e09b4 1718 for (l = langsys->FeatureCount - 1; l >= 0; l--)
c2f5bfd6
KH		 1719 {
1720 OTF_Feature *feature
1721 = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
1722 Lisp_Object feature_tag
1723 = otf_tag_symbol (feature->FeatureTag);
1724
1725 feature_list = Fcons (feature_tag, feature_list);
1726 }
1727 langsys_list = Fcons (Fcons (langsys_tag, feature_list),
1728 langsys_list);
1729 }
1730 script_list = Fcons (Fcons (script_tag, langsys_list),
1731 script_list);
1732 }
1733
1734 if (i == 0)
1735 XSETCAR (capability, script_list);
1736 else
1737 XSETCDR (capability, script_list);
1738 }
1739
1740 return capability;
1741}
1742
733fd013
KH		 1743/* Parse OTF features in SPEC and write a proper features spec string
1744 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1745 assured that the sufficient memory has already allocated for
1746 FEATURES. */
1747
e80e09b4 1748static void
733fd013 1749generate_otf_features (spec, features)
c2f5bfd6 1750 Lisp_Object spec;
733fd013 1751 char *features;
c2f5bfd6
KH		 1752{
1753 Lisp_Object val;
e80e09b4 1754 char *p, *pend;
c2f5bfd6
KH		 1755 int asterisk;
1756
733fd013 1757 p = features;
e80e09b4 1758 *p = '\0';
c2f5bfd6
KH		 1759 for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
1760 {
1761 val = XCAR (spec);
e80e09b4
KH		 1762 CHECK_SYMBOL (val);
1763 if (p > features)
733fd013 1764 *p++ = ',';
c2f5bfd6
KH		 1765 if (SREF (SYMBOL_NAME (val), 0) == '*')
1766 {
1767 asterisk = 1;
e80e09b4 1768 *p++ = '*';
c2f5bfd6
KH		 1769 }
1770 else if (! asterisk)
e80e09b4
KH		 1771 {
1772 val = SYMBOL_NAME (val);
e80e09b4
KH		 1773 p += sprintf (p, "%s", SDATA (val));
1774 }
c2f5bfd6 1775 else
e80e09b4
KH		 1776 {
1777 val = SYMBOL_NAME (val);
e80e09b4
KH		 1778 p += sprintf (p, "~%s", SDATA (val));
1779 }
c2f5bfd6 1780 }
e80e09b4
KH		 1781 if (CONSP (spec))
1782 error ("OTF spec too long");
1783}
1784
c2f5bfd6 1785
733fd013
KH		 1786Lisp_Object
1787font_otf_DeviceTable (device_table)
1788 OTF_DeviceTable *device_table;
1789{
1790 int len = device_table->StartSize - device_table->EndSize + 1;
1791
1792 return Fcons (make_number (len),
1793 make_unibyte_string (device_table->DeltaValue, len));
1794}
1795
1796Lisp_Object
1797font_otf_ValueRecord (value_format, value_record)
1798 int value_format;
1799 OTF_ValueRecord *value_record;
1800{
1801 Lisp_Object val = Fmake_vector (make_number (8), Qnil);
1802
1803 if (value_format & OTF_XPlacement)
1804 ASET (val, 0, value_record->XPlacement);
1805 if (value_format & OTF_YPlacement)
1806 ASET (val, 1, value_record->YPlacement);
1807 if (value_format & OTF_XAdvance)
1808 ASET (val, 2, value_record->XAdvance);
1809 if (value_format & OTF_YAdvance)
1810 ASET (val, 3, value_record->YAdvance);
1811 if (value_format & OTF_XPlaDevice)
1812 ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
1813 if (value_format & OTF_YPlaDevice)
1814 ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
1815 if (value_format & OTF_XAdvDevice)
1816 ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
1817 if (value_format & OTF_YAdvDevice)
1818 ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
1819 return val;
1820}
1821
1822Lisp_Object
1823font_otf_Anchor (anchor)
1824 OTF_Anchor *anchor;
1825{
1826 Lisp_Object val;
1827
1828 val = Fmake_vector (make_number (anchor->AnchorFormat + 1), Qnil);
1829 ASET (val, 0, make_number (anchor->XCoordinate));
1830 ASET (val, 1, make_number (anchor->YCoordinate));
1831 if (anchor->AnchorFormat == 2)
1832 ASET (val, 2, make_number (anchor->f.f1.AnchorPoint));
1833 else
1834 {
1835 ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
1836 ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
1837 }
1838 return val;
1839}
1840
c2f5bfd6
KH		 1841#endif /* HAVE_LIBOTF */
1842
e80e09b4
KH		 1843/* G-string (glyph string) handler */
1844
1845/* G-string is a vector of the form [HEADER GLYPH ...].
1846 See the docstring of `font-make-gstring' for more detail. */
c2f5bfd6
KH		 1847
1848struct font *
1701724c 1849font_prepare_composition (cmp, f)
c2f5bfd6 1850 struct composition *cmp;
1701724c 1851 FRAME_PTR f;
c2f5bfd6
KH		 1852{
1853 Lisp_Object gstring
1854 = AREF (XHASH_TABLE (composition_hash_table)->key_and_value,
1855 cmp->hash_index * 2);
c2f5bfd6 1856
1701724c
KH		 1857 cmp->font = XSAVE_VALUE (LGSTRING_FONT (gstring))->pointer;
1858 cmp->glyph_len = LGSTRING_LENGTH (gstring);
1859 cmp->pixel_width = LGSTRING_WIDTH (gstring);
1860 cmp->lbearing = LGSTRING_LBEARING (gstring);
1861 cmp->rbearing = LGSTRING_RBEARING (gstring);
1862 cmp->ascent = LGSTRING_ASCENT (gstring);
1863 cmp->descent = LGSTRING_DESCENT (gstring);
1864 cmp->width = cmp->pixel_width / FRAME_COLUMN_WIDTH (f);
1865 if (cmp->width == 0)
1866 cmp->width = 1;
c2f5bfd6 1867
1701724c 1868 return cmp->font;
c2f5bfd6
KH		 1869}
1870
c2f5bfd6
KH		 1871\f
1872/* Font sorting */
1873
9331887d 1874static unsigned font_score P_ ((Lisp_Object, Lisp_Object *));
c2f5bfd6
KH		 1875static int font_compare P_ ((const void *, const void *));
1876static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object,
1877 Lisp_Object, Lisp_Object));
1878
1879/* We sort fonts by scoring each of them against a specified
1880 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1881 the value is, the closer the font is to the font-spec.
1882
45eb10fb 1883 Each 1-bit of the highest 4 bits of the score is used for atomic
c2f5bfd6
KH		 1884 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
1885
1886 Each 7-bit in the lowest 28 bits are used for numeric properties
1887 WEIGHT, SLANT, WIDTH, and SIZE. */
1888
1889/* How many bits to shift to store the difference value of each font
1890 property in a score. */
1891static int sort_shift_bits[FONT_SIZE_INDEX + 1];
1892
9331887d
KH		 1893/* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1894 The return value indicates how different ENTITY is compared with
1895 SPEC_PROP. */
c2f5bfd6
KH		 1896
1897static unsigned
9331887d
KH		 1898font_score (entity, spec_prop)
1899 Lisp_Object entity, *spec_prop;
c2f5bfd6
KH		 1900{
1901 unsigned score = 0;
1902 int i;
9331887d 1903 /* Score four atomic fields. Maximum difference is 1. */
c2f5bfd6 1904 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
9331887d
KH		 1905 if (! NILP (spec_prop[i])
1906 && ! EQ (spec_prop[i], AREF (entity, i)))
1907 score |= 1 << sort_shift_bits[i];
c2f5bfd6 1908
9331887d 1909 /* Score four numeric fields. Maximum difference is 127. */
c2f5bfd6
KH		 1910 for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
1911 {
c2f5bfd6
KH		 1912 Lisp_Object entity_val = AREF (entity, i);
1913
9331887d 1914 if (! NILP (spec_prop[i]) && ! EQ (spec_prop[i], entity_val))
c2f5bfd6
KH		 1915 {
1916 if (! INTEGERP (entity_val))
1917 score |= 127 << sort_shift_bits[i];
9331887d 1918 else
c2f5bfd6 1919 {
9331887d 1920 int diff = XINT (entity_val) - XINT (spec_prop[i]);
c2f5bfd6
KH		 1921
1922 if (diff < 0)
1923 diff = - diff;
9331887d
KH		 1924 if (i == FONT_SIZE_INDEX)
1925 {
1926 if (XINT (entity_val) > 0
1927 && diff > FONT_PIXEL_SIZE_QUANTUM)
1928 score |= min (diff, 127) << sort_shift_bits[i];
1929 }
1930 else
1931 score |= min (diff, 127) << sort_shift_bits[i];
c2f5bfd6
KH		 1932 }
1933 }
1934 }
1935
1936 return score;
1937}
1938
1939
1940/* The comparison function for qsort. */
1941
1942static int
1943font_compare (d1, d2)
1944 const void *d1, *d2;
1945{
1946 return (*(unsigned *) d1 < *(unsigned *) d2
1947 ? -1 : *(unsigned *) d1 > *(unsigned *) d2);
1948}
1949
1950
1951/* The structure for elements being sorted by qsort. */
1952struct font_sort_data
1953{
1954 unsigned score;
1955 Lisp_Object entity;
1956};
1957
1958
1959/* Sort font-entities in vector VEC by closeness to font-spec PREFER.
1960 If PREFER specifies a point-size, calculate the corresponding
9331887d
KH		 1961 pixel-size from QCdpi property of PREFER or from the Y-resolution
1962 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
1963 get the font-entities in VEC. */
c2f5bfd6
KH		 1964
1965static Lisp_Object
1966font_sort_entites (vec, prefer, frame, spec)
1967 Lisp_Object vec, prefer, frame, spec;
1968{
9331887d 1969 Lisp_Object prefer_prop[FONT_SPEC_MAX];
c2f5bfd6
KH		 1970 int len, i;
1971 struct font_sort_data *data;
c2f5bfd6
KH		 1972 USE_SAFE_ALLOCA;
1973
1974 len = ASIZE (vec);
1975 if (len <= 1)
1976 return vec;
1977
9331887d
KH		 1978 for (i = FONT_FOUNDRY_INDEX; i <= FONT_SIZE_INDEX; i++)
1979 prefer_prop[i] = AREF (prefer, i);
c2f5bfd6
KH		 1980
1981 if (! NILP (spec))
1982 {
1983 /* As it is assured that all fonts in VEC match with SPEC, we
1984 should ignore properties specified in SPEC. So, set the
9331887d 1985 corresponding properties in PREFER_PROP to nil. */
c2f5bfd6 1986 for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
9331887d
KH		 1987 if (! NILP (AREF (spec, i)))
1988 prefer_prop[i++] = Qnil;
c2f5bfd6
KH		 1989 }
1990
9331887d
KH		 1991 if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
1992 prefer_prop[FONT_SIZE_INDEX]
1993 = make_number (font_pixel_size (XFRAME (frame), prefer));
1994
c2f5bfd6
KH		 1995 /* Scoring and sorting. */
1996 SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len);
1997 for (i = 0; i < len; i++)
1998 {
1999 data[i].entity = AREF (vec, i);
9331887d 2000 data[i].score = font_score (data[i].entity, prefer_prop);
c2f5bfd6
KH		 2001 }
2002 qsort (data, len, sizeof *data, font_compare);
2003 for (i = 0; i < len; i++)
2004 ASET (vec, i, data[i].entity);
2005 SAFE_FREE ();
2006
2007 return vec;
2008}
2009
2010\f
2011/* API of Font Service Layer. */
2012
45eb10fb
KH		 2013/* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2014 sort_shift_bits. Finternal_set_font_selection_order calls this
2015 function with font_sort_order after setting up it. */
2016
c2f5bfd6
KH		 2017void
2018font_update_sort_order (order)
2019 int *order;
2020{
2021 int i, shift_bits = 21;
2022
2023 for (i = 0; i < 4; i++, shift_bits -= 7)
2024 {
2025 int xlfd_idx = order[i];
2026
2027 if (xlfd_idx == XLFD_WEIGHT_INDEX)
2028 sort_shift_bits[FONT_WEIGHT_INDEX] = shift_bits;
2029 else if (xlfd_idx == XLFD_SLANT_INDEX)
2030 sort_shift_bits[FONT_SLANT_INDEX] = shift_bits;
2031 else if (xlfd_idx == XLFD_SWIDTH_INDEX)
2032 sort_shift_bits[FONT_WIDTH_INDEX] = shift_bits;
2033 else
2034 sort_shift_bits[FONT_SIZE_INDEX] = shift_bits;
2035 }
2036}
2037
45eb10fb
KH		 2038
2039/* Return weight property of FONT as symbol. */
2040
c2f5bfd6
KH		 2041Lisp_Object
2042font_symbolic_weight (font)
2043 Lisp_Object font;
2044{
2045 Lisp_Object weight = AREF (font, FONT_WEIGHT_INDEX);
2046
2047 if (INTEGERP (weight))
2048 weight = prop_numeric_to_name (FONT_WEIGHT_INDEX, XINT (weight));
2049 return weight;
2050}
2051
45eb10fb
KH		 2052
2053/* Return slant property of FONT as symbol. */
2054
c2f5bfd6
KH		 2055Lisp_Object
2056font_symbolic_slant (font)
2057 Lisp_Object font;
2058{
2059 Lisp_Object slant = AREF (font, FONT_SLANT_INDEX);
2060
2061 if (INTEGERP (slant))
2062 slant = prop_numeric_to_name (FONT_SLANT_INDEX, XINT (slant));
2063 return slant;
2064}
2065
45eb10fb
KH		 2066
2067/* Return width property of FONT as symbol. */
2068
c2f5bfd6
KH		 2069Lisp_Object
2070font_symbolic_width (font)
2071 Lisp_Object font;
2072{
2073 Lisp_Object width = AREF (font, FONT_WIDTH_INDEX);
2074
2075 if (INTEGERP (width))
2076 width = prop_numeric_to_name (FONT_WIDTH_INDEX, XINT (width));
2077 return width;
2078}
2079
45eb10fb
KH		 2080
2081/* Check if ENTITY matches with the font specification SPEC. */
2082
ef18374f
KH		 2083int
2084font_match_p (spec, entity)
2085 Lisp_Object spec, entity;
2086{
2087 int i;
2088
2089 for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++)
2090 if (! NILP (AREF (spec, i))
2091 && ! EQ (AREF (spec, i), AREF (entity, i)))
2092 return 0;
2093 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX))
2094 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0
2095 && (XINT (AREF (spec, FONT_SIZE_INDEX))
2096 != XINT (AREF (entity, FONT_SIZE_INDEX))))
2097 return 0;
2098 return 1;
2099}
2100
45eb10fb
KH		 2101
2102/* Return a lispy font object corresponding to FONT. */
2103
c2f5bfd6
KH		 2104Lisp_Object
2105font_find_object (font)
2106 struct font *font;
2107{
2108 Lisp_Object tail, elt;
2109
2110 for (tail = AREF (font->entity, FONT_OBJLIST_INDEX); CONSP (tail);
2111 tail = XCDR (tail))
2112 {
2113 elt = XCAR (tail);
2114 if (font == XSAVE_VALUE (elt)->pointer
2115 && XSAVE_VALUE (elt)->integer > 0)
2116 return elt;
2117 }
2118 abort ();
2119 return Qnil;
2120}
2121
2122static Lisp_Object scratch_font_spec, scratch_font_prefer;
2123
45eb10fb 2124
c2f5bfd6
KH		 2125/* Return a vector of font-entities matching with SPEC on frame F. */
2126
2127static Lisp_Object
2128font_list_entities (frame, spec)
2129 Lisp_Object frame, spec;
2130{
2131 FRAME_PTR f = XFRAME (frame);
2132 struct font_driver_list *driver_list = f->font_driver_list;
a9262bb8 2133 Lisp_Object ftype, family, size, alternate_familes;
c2f5bfd6
KH		 2134 Lisp_Object *vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
2135 int i;
2136
2137 if (! vec)
2138 return null_vector;
2139
2140 family = AREF (spec, FONT_FAMILY_INDEX);
2141 if (NILP (family))
2142 alternate_familes = Qnil;
2143 else
2144 {
2145 if (NILP (font_family_alist)
2146 && !NILP (Vface_alternative_font_family_alist))
2147 build_font_family_alist ();
2148 alternate_familes = assq_no_quit (family, font_family_alist);
2149 if (! NILP (alternate_familes))
2150 alternate_familes = XCDR (alternate_familes);
2151 }
a9262bb8
KH		 2152 size = AREF (spec, FONT_SIZE_INDEX);
2153 if (FLOATP (size))
9331887d 2154 ASET (spec, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
a9262bb8 2155
c2f5bfd6
KH		 2156 xassert (ASIZE (spec) == FONT_SPEC_MAX);
2157 ftype = AREF (spec, FONT_TYPE_INDEX);
2158
2159 for (i = 0; driver_list; driver_list = driver_list->next)
417a1b10
KH		 2160 if (driver_list->on
2161 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
c2f5bfd6
KH		 2162 {
2163 Lisp_Object cache = driver_list->driver->get_cache (frame);
2164 Lisp_Object tail = alternate_familes;
2165 Lisp_Object val;
2166
2167 xassert (CONSP (cache));
2168 ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type);
2169 ASET (spec, FONT_FAMILY_INDEX, family);
2170
2171 while (1)
2172 {
2173 val = assoc_no_quit (spec, XCDR (cache));
2174 if (CONSP (val))
2175 val = XCDR (val);
2176 else
2177 {
2178 val = driver_list->driver->list (frame, spec);
2179 if (VECTORP (val))
2180 XSETCDR (cache, Fcons (Fcons (Fcopy_sequence (spec), val),
2181 XCDR (cache)));
2182 }
2183 if (VECTORP (val) && ASIZE (val) > 0)
2184 {
2185 vec[i++] = val;
2186 break;
2187 }
2188 if (NILP (tail))
2189 break;
2190 ASET (spec, FONT_FAMILY_INDEX, XCAR (tail));
2191 tail = XCDR (tail);
2192 }
2193 }
2194 ASET (spec, FONT_TYPE_INDEX, ftype);
2195 ASET (spec, FONT_FAMILY_INDEX, family);
a9262bb8 2196 ASET (spec, FONT_SIZE_INDEX, size);
c2f5bfd6
KH		 2197 return (i > 0 ? Fvconcat (i, vec) : null_vector);
2198}
2199
45eb10fb
KH		 2200
2201/* Return a font entity matching with SPEC on FRAME. */
2202
e950d6f1
KH		 2203static Lisp_Object
2204font_matching_entity (frame, spec)
2205 Lisp_Object frame, spec;
2206{
2207 FRAME_PTR f = XFRAME (frame);
2208 struct font_driver_list *driver_list = f->font_driver_list;
2209 Lisp_Object ftype, size, entity;
2210
2211 ftype = AREF (spec, FONT_TYPE_INDEX);
2212 size = AREF (spec, FONT_SIZE_INDEX);
2213 if (FLOATP (size))
2214 ASET (spec, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
2215 entity = Qnil;
2216 for (; driver_list; driver_list = driver_list->next)
2217 if (driver_list->on
2218 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
2219 {
2220 Lisp_Object cache = driver_list->driver->get_cache (frame);
7c8f6ffd 2221 Lisp_Object key;
e950d6f1
KH		 2222
2223 xassert (CONSP (cache));
2224 ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type);
2225 key = Fcons (spec, Qnil);
2226 entity = assoc_no_quit (key, XCDR (cache));
2227 if (CONSP (entity))
2228 entity = XCDR (entity);
2229 else
2230 {
2231 entity = driver_list->driver->match (frame, spec);
2232 if (! NILP (entity))
2233 {
2234 XSETCAR (key, Fcopy_sequence (spec));
2235 XSETCDR (cache, Fcons (Fcons (key, entity), XCDR (cache)));
2236 }
2237 }
2238 if (! NILP (entity))
2239 break;
2240 }
2241 ASET (spec, FONT_TYPE_INDEX, ftype);
2242 ASET (spec, FONT_SIZE_INDEX, size);
2243 return entity;
2244}
2245
c2f5bfd6
KH		 2246static int num_fonts;
2247
45eb10fb
KH		 2248
2249/* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2250 opened font object. */
2251
c2f5bfd6
KH		 2252static Lisp_Object
2253font_open_entity (f, entity, pixel_size)
2254 FRAME_PTR f;
2255 Lisp_Object entity;
2256 int pixel_size;
2257{
2258 struct font_driver_list *driver_list;
2259 Lisp_Object objlist, size, val;
2260 struct font *font;
2261
2262 size = AREF (entity, FONT_SIZE_INDEX);
2263 xassert (NATNUMP (size));
2264 if (XINT (size) != 0)
2265 pixel_size = XINT (size);
2266
2267 for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
2268 objlist = XCDR (objlist))
2269 {
2270 font = XSAVE_VALUE (XCAR (objlist))->pointer;
2271 if (font->pixel_size == pixel_size)
2272 {
2273 XSAVE_VALUE (XCAR (objlist))->integer++;
2274 return XCAR (objlist);
2275 }
2276 }
2277
2278 xassert (FONT_ENTITY_P (entity));
2279 val = AREF (entity, FONT_TYPE_INDEX);
2280 for (driver_list = f->font_driver_list;
2281 driver_list && ! EQ (driver_list->driver->type, val);
2282 driver_list = driver_list->next);
2283 if (! driver_list)
2284 return Qnil;
2285
2286 font = driver_list->driver->open (f, entity, pixel_size);
2287 if (! font)
2288 return Qnil;
e80e09b4
KH		 2289 font->scalable = XINT (size) == 0;
2290
c2f5bfd6
KH		 2291 val = make_save_value (font, 1);
2292 ASET (entity, FONT_OBJLIST_INDEX,
2293 Fcons (val, AREF (entity, FONT_OBJLIST_INDEX)));
2294 num_fonts++;
2295 return val;
2296}
2297
45eb10fb
KH		 2298
2299/* Close FONT_OBJECT that is opened on frame F. */
2300
c2f5bfd6
KH		 2301void
2302font_close_object (f, font_object)
2303 FRAME_PTR f;
2304 Lisp_Object font_object;
2305{
10d16101
KH		 2306 struct font *font = XSAVE_VALUE (font_object)->pointer;
2307 Lisp_Object objlist;
c2f5bfd6
KH		 2308 Lisp_Object tail, prev = Qnil;
2309
10d16101
KH		 2310 XSAVE_VALUE (font_object)->integer--;
2311 xassert (XSAVE_VALUE (font_object)->integer >= 0);
2312 if (XSAVE_VALUE (font_object)->integer > 0)
2313 return;
2314
2315 objlist = AREF (font->entity, FONT_OBJLIST_INDEX);
c2f5bfd6
KH		 2316 for (prev = Qnil, tail = objlist; CONSP (tail);
2317 prev = tail, tail = XCDR (tail))
2318 if (EQ (font_object, XCAR (tail)))
2319 {
10d16101
KH		 2320 if (font->driver->close)
2321 font->driver->close (f, font);
2322 XSAVE_VALUE (font_object)->pointer = NULL;
2323 if (NILP (prev))
2324 ASET (font->entity, FONT_OBJLIST_INDEX, XCDR (objlist));
2325 else
2326 XSETCDR (prev, XCDR (objlist));
2327 return;
c2f5bfd6 2328 }
10d16101 2329 abort ();
c2f5bfd6
KH		 2330}
2331
45eb10fb 2332
1701724c
KH		 2333/* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2334 FONT is a font-entity and it must be opened to check. */
45eb10fb 2335
c2f5bfd6 2336int
1b834a8d 2337font_has_char (f, font, c)
c2f5bfd6 2338 FRAME_PTR f;
1b834a8d 2339 Lisp_Object font;
c2f5bfd6
KH		 2340 int c;
2341{
1b834a8d 2342 struct font *fontp;
c2f5bfd6 2343
1b834a8d
KH		 2344 if (FONT_ENTITY_P (font))
2345 {
2346 Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
2347 struct font_driver_list *driver_list;
2348
2349 for (driver_list = f->font_driver_list;
2350 driver_list && ! EQ (driver_list->driver->type, type);
2351 driver_list = driver_list->next);
2352 if (! driver_list)
2353 return 0;
2354 if (! driver_list->driver->has_char)
2355 return -1;
2356 return driver_list->driver->has_char (font, c);
2357 }
2358
2359 xassert (FONT_OBJECT_P (font));
2360 fontp = XSAVE_VALUE (font)->pointer;
2361
2362 if (fontp->driver->has_char)
2363 {
2364 int result = fontp->driver->has_char (fontp->entity, c);
2365
2366 if (result >= 0)
2367 return result;
2368 }
2369 return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
c2f5bfd6
KH		 2370}
2371
45eb10fb
KH		 2372
2373/* Return the glyph ID of FONT_OBJECT for character C. */
2374
c2f5bfd6
KH		 2375unsigned
2376font_encode_char (font_object, c)
2377 Lisp_Object font_object;
2378 int c;
2379{
2380 struct font *font = XSAVE_VALUE (font_object)->pointer;
2381
2382 return font->driver->encode_char (font, c);
2383}
2384
45eb10fb
KH		 2385
2386/* Return the name of FONT_OBJECT. */
2387
ef18374f 2388Lisp_Object
c2f5bfd6
KH		 2389font_get_name (font_object)
2390 Lisp_Object font_object;
2391{
2392 struct font *font = XSAVE_VALUE (font_object)->pointer;
ef18374f
KH		 2393 char *name = (font->font.full_name ? font->font.full_name
2394 : font->font.name ? font->font.name
2395 : NULL);
c2f5bfd6 2396
ef18374f
KH		 2397 return (name ? make_unibyte_string (name, strlen (name)) : null_string);
2398}
2399
45eb10fb
KH		 2400
2401/* Return the specification of FONT_OBJECT. */
2402
ef18374f
KH		 2403Lisp_Object
2404font_get_spec (font_object)
2405 Lisp_Object font_object;
2406{
2407 struct font *font = XSAVE_VALUE (font_object)->pointer;
2408 Lisp_Object spec = Ffont_spec (0, NULL);
2409 int i;
2410
2411 for (i = 0; i < FONT_SIZE_INDEX; i++)
2412 ASET (spec, i, AREF (font->entity, i));
2413 ASET (spec, FONT_SIZE_INDEX, make_number (font->pixel_size));
2414 return spec;
c2f5bfd6
KH		 2415}
2416
45eb10fb
KH		 2417
2418/* Return the frame on which FONT exists. FONT is a font object or a
2419 font entity. */
2420
c2f5bfd6
KH		 2421Lisp_Object
2422font_get_frame (font)
2423 Lisp_Object font;
2424{
2425 if (FONT_OBJECT_P (font))
2426 font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity;
2427 xassert (FONT_ENTITY_P (font));
2428 return AREF (font, FONT_FRAME_INDEX);
2429}
2430
45eb10fb 2431
ef18374f 2432/* Find a font entity best matching with LFACE. If SPEC is non-nil,
1701724c
KH		 2433 the font must exactly match with it. C, if not negative, is a
2434 character that the entity must support. */
c2f5bfd6
KH		 2435
2436Lisp_Object
1701724c 2437font_find_for_lface (f, lface, spec, c)
c2f5bfd6
KH		 2438 FRAME_PTR f;
2439 Lisp_Object *lface;
2440 Lisp_Object spec;
1701724c 2441 int c;
c2f5bfd6 2442{
ef18374f 2443 Lisp_Object frame, entities;
c2f5bfd6 2444 int i;
c2f5bfd6 2445
fe5ddfbc 2446 XSETFRAME (frame, f);
c2f5bfd6 2447
fe5ddfbc 2448 if (NILP (spec))
1b834a8d 2449 {
1701724c
KH		 2450 if (c >= 0x100)
2451 return Qnil;
fe5ddfbc
KH		 2452 for (i = 0; i < FONT_SPEC_MAX; i++)
2453 ASET (scratch_font_spec, i, Qnil);
2454 ASET (scratch_font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
1b834a8d 2455
fe5ddfbc
KH		 2456 if (! NILP (lface[LFACE_FAMILY_INDEX]))
2457 font_merge_old_spec (Qnil, lface[LFACE_FAMILY_INDEX], Qnil,
2458 scratch_font_spec);
2459 entities = font_list_entities (frame, scratch_font_spec);
2460 while (ASIZE (entities) == 0)
c2f5bfd6 2461 {
fe5ddfbc
KH		 2462 /* Try without FOUNDRY or FAMILY. */
2463 if (! NILP (AREF (scratch_font_spec, FONT_FOUNDRY_INDEX)))
2464 {
2465 ASET (scratch_font_spec, FONT_FOUNDRY_INDEX, Qnil);
2466 entities = font_list_entities (frame, scratch_font_spec);
2467 }
2468 else if (! NILP (AREF (scratch_font_spec, FONT_FAMILY_INDEX)))
2469 {
2470 ASET (scratch_font_spec, FONT_FAMILY_INDEX, Qnil);
2471 entities = font_list_entities (frame, scratch_font_spec);
2472 }
2473 else
2474 break;
c2f5bfd6 2475 }
fe5ddfbc
KH		 2476 }
2477 else
2478 {
1701724c
KH		 2479 Lisp_Object registry = AREF (spec, FONT_REGISTRY_INDEX);
2480
2481 if (NILP (registry))
2482 registry = Qiso8859_1;
2483
2484 if (c >= 0)
2485 {
2486 struct charset *repertory;
2487
2488 if (font_registry_charsets (registry, NULL, &repertory) < 0)
2489 return Qnil;
2490 if (repertory)
2491 {
2492 if (ENCODE_CHAR (repertory, c)
2493 == CHARSET_INVALID_CODE (repertory))
2494 return Qnil;
2495 /* Any font of this registry support C. So, let's
2496 suppress the further checking. */
2497 c = -1;
2498 }
2499 else if (c > MAX_UNICODE_CHAR)
2500 return Qnil;
2501 }
fe5ddfbc
KH		 2502 for (i = 0; i < FONT_SPEC_MAX; i++)
2503 ASET (scratch_font_spec, i, AREF (spec, i));
1701724c 2504 ASET (scratch_font_spec, FONT_REGISTRY_INDEX, registry);
fe5ddfbc 2505 entities = font_list_entities (frame, scratch_font_spec);
c2f5bfd6
KH		 2506 }
2507
fe5ddfbc
KH		 2508 if (ASIZE (entities) == 0)
2509 return Qnil;
c2f5bfd6
KH		 2510 if (ASIZE (entities) > 1)
2511 {
fe5ddfbc 2512 /* Sort fonts by properties specified in LFACE. */
ec6fe57c 2513 Lisp_Object prefer = scratch_font_prefer;
9331887d 2514 double pt;
ef18374f 2515
fe5ddfbc
KH		 2516 if (! NILP (lface[LFACE_FAMILY_INDEX]))
2517 font_merge_old_spec (Qnil, lface[LFACE_FAMILY_INDEX], Qnil, prefer);
ef18374f 2518 ASET (prefer, FONT_WEIGHT_INDEX,
45eb10fb 2519 font_prop_validate_style (QCweight, lface[LFACE_WEIGHT_INDEX]));
ef18374f 2520 ASET (prefer, FONT_SLANT_INDEX,
45eb10fb 2521 font_prop_validate_style (QCslant, lface[LFACE_SLANT_INDEX]));
ef18374f 2522 ASET (prefer, FONT_WIDTH_INDEX,
45eb10fb 2523 font_prop_validate_style (QCwidth, lface[LFACE_SWIDTH_INDEX]));
9331887d
KH		 2524 pt = XINT (lface[LFACE_HEIGHT_INDEX]);
2525 ASET (prefer, FONT_SIZE_INDEX, make_float (pt / 10));
c2f5bfd6 2526
c2f5bfd6
KH		 2527 font_sort_entites (entities, prefer, frame, spec);
2528 }
2529
1701724c
KH		 2530 if (c < 0)
2531 return AREF (entities, 0);
2532 for (i = 0; i < ASIZE (entities); i++)
2533 {
2534 int result = font_has_char (f, AREF (entities, i), c);
2535 Lisp_Object font_object;
45eb10fb 2536
1701724c
KH		 2537 if (result > 0)
2538 return AREF (entities, i);
2539 if (result <= 0)
2540 continue;
2541 font_object = font_open_for_lface (f, AREF (entities, i), lface, spec);
2542 if (NILP (font_object))
2543 continue;
2544 result = font_has_char (f, font_object, c);
2545 font_close_object (f, font_object);
2546 if (result > 0)
2547 return AREF (entities, i);
2548 }
2549 return Qnil;
2550}
45eb10fb
KH		 2551
2552
c2f5bfd6 2553Lisp_Object
733fd013 2554font_open_for_lface (f, entity, lface, spec)
c2f5bfd6 2555 FRAME_PTR f;
c2f5bfd6 2556 Lisp_Object entity;
733fd013
KH		 2557 Lisp_Object *lface;
2558 Lisp_Object spec;
c2f5bfd6 2559{
9331887d 2560 int size;
c2f5bfd6 2561
733fd013
KH		 2562 if (FONT_SPEC_P (spec) && INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
2563 size = XINT (AREF (spec, FONT_SIZE_INDEX));
2564 else
2565 {
2566 double pt = XINT (lface[LFACE_HEIGHT_INDEX]);
2567
2568 pt /= 10;
2569 size = POINT_TO_PIXEL (pt, f->resy);
2570 }
c2f5bfd6
KH		 2571 return font_open_entity (f, entity, size);
2572}
2573
45eb10fb
KH		 2574
2575/* Load a font best matching with FACE's font-related properties into
2576 FACE on frame F. If no proper font is found, record that FACE has
2577 no font. */
2578
c2f5bfd6
KH		 2579void
2580font_load_for_face (f, face)
2581 FRAME_PTR f;
2582 struct face *face;
2583{
ef18374f 2584 Lisp_Object font_object = face->lface[LFACE_FONT_INDEX];
c2f5bfd6 2585
ef18374f 2586 if (NILP (font_object))
c2f5bfd6 2587 {
1701724c 2588 Lisp_Object entity = font_find_for_lface (f, face->lface, Qnil, -1);
c2f5bfd6 2589
ef18374f 2590 if (! NILP (entity))
733fd013 2591 font_object = font_open_for_lface (f, entity, face->lface, Qnil);
ef18374f 2592 }
c2f5bfd6 2593
ef18374f
KH		 2594 if (! NILP (font_object))
2595 {
2596 struct font *font = XSAVE_VALUE (font_object)->pointer;
2597
2598 face->font = font->font.font;
2599 face->font_info = (struct font_info *) font;
2600 face->font_info_id = 0;
2601 face->font_name = font->font.full_name;
2602 }
2603 else
2604 {
2605 face->font = NULL;
2606 face->font_info = NULL;
2607 face->font_info_id = -1;
2608 face->font_name = NULL;
2609 add_to_log ("Unable to load font for a face%s", null_string, Qnil);
c2f5bfd6 2610 }
c2f5bfd6
KH		 2611}
2612
45eb10fb
KH		 2613
2614/* Make FACE on frame F ready to use the font opened for FACE. */
2615
c2f5bfd6
KH		 2616void
2617font_prepare_for_face (f, face)
2618 FRAME_PTR f;
2619 struct face *face;
2620{
2621 struct font *font = (struct font *) face->font_info;
2622
2623 if (font->driver->prepare_face)
2624 font->driver->prepare_face (f, face);
2625}
2626
45eb10fb
KH		 2627
2628/* Make FACE on frame F stop using the font opened for FACE. */
2629
c2f5bfd6
KH		 2630void
2631font_done_for_face (f, face)
2632 FRAME_PTR f;
2633 struct face *face;
2634{
2635 struct font *font = (struct font *) face->font_info;
2636
2637 if (font->driver->done_face)
2638 font->driver->done_face (f, face);
2639 face->extra = NULL;
2640}
2641
45eb10fb
KH		 2642
2643/* Open a font best matching with NAME on frame F. If no proper font
2644 is found, return Qnil. */
2645
c2f5bfd6
KH		 2646Lisp_Object
2647font_open_by_name (f, name)
2648 FRAME_PTR f;
2649 char *name;
2650{
ef18374f 2651 Lisp_Object args[2];
e950d6f1 2652 Lisp_Object spec, prefer, size, entity, entity_list;
c2f5bfd6 2653 Lisp_Object frame;
a9262bb8 2654 int i;
ef18374f 2655 int pixel_size;
c2f5bfd6
KH		 2656
2657 XSETFRAME (frame, f);
a9262bb8 2658
ef18374f
KH		 2659 args[0] = QCname;
2660 args[1] = make_unibyte_string (name, strlen (name));
2661 spec = Ffont_spec (2, args);
a9262bb8
KH		 2662 prefer = scratch_font_prefer;
2663 for (i = FONT_WEIGHT_INDEX; i < FONT_SIZE_INDEX; i++)
2664 if (NILP (AREF (spec, i)))
2665 ASET (prefer, i, make_number (100));
2666 size = AREF (spec, FONT_SIZE_INDEX);
2667 if (NILP (size))
2668 pixel_size = 0;
2669 else if (INTEGERP (size))
2670 pixel_size = XINT (size);
2671 else /* FLOATP (size) */
ef18374f 2672 {
9331887d 2673 double pt = XFLOAT_DATA (size);
a9262bb8
KH		 2674
2675 pixel_size = POINT_TO_PIXEL (pt, f->resy);
2676 size = make_number (pixel_size);
2677 ASET (spec, FONT_SIZE_INDEX, size);
ef18374f 2678 }
a9262bb8 2679 if (pixel_size == 0)
ef18374f 2680 {
9331887d 2681 pixel_size = POINT_TO_PIXEL (12.0, f->resy);
a9262bb8 2682 size = make_number (pixel_size);
ef18374f 2683 }
a9262bb8 2684 ASET (prefer, FONT_SIZE_INDEX, size);
9331887d
KH		 2685 if (NILP (AREF (spec, FONT_REGISTRY_INDEX)))
2686 ASET (spec, FONT_REGISTRY_INDEX, Qiso8859_1);
a9262bb8 2687
e950d6f1
KH		 2688 entity_list = Flist_fonts (spec, frame, make_number (1), prefer);
2689 if (NILP (entity_list))
2690 entity = font_matching_entity (frame, spec);
2691 else
2692 entity = XCAR (entity_list);
2693 return (NILP (entity)
a9262bb8 2694 ? Qnil
e950d6f1 2695 : font_open_entity (f, entity, pixel_size));
c2f5bfd6
KH		 2696}
2697
2698
2699/* Register font-driver DRIVER. This function is used in two ways.
2700
417a1b10
KH		 2701 The first is with frame F non-NULL. In this case, make DRIVER
2702 available (but not yet activated) on F. All frame creaters
2703 (e.g. Fx_create_frame) must call this function at least once with
2704 an available font-driver.
c2f5bfd6
KH		 2705
2706 The second is with frame F NULL. In this case, DRIVER is globally
2707 registered in the variable `font_driver_list'. All font-driver
2708 implementations must call this function in its syms_of_XXXX
2709 (e.g. syms_of_xfont). */
2710
2711void
2712register_font_driver (driver, f)
2713 struct font_driver *driver;
2714 FRAME_PTR f;
2715{
2716 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
2717 struct font_driver_list *prev, *list;
2718
2719 if (f && ! driver->draw)
2720 error ("Unsable font driver for a frame: %s",
2721 SDATA (SYMBOL_NAME (driver->type)));
2722
2723 for (prev = NULL, list = root; list; prev = list, list = list->next)
cf23b845 2724 if (EQ (list->driver->type, driver->type))
c2f5bfd6
KH		 2725 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
2726
2727 list = malloc (sizeof (struct font_driver_list));
417a1b10 2728 list->on = 0;
c2f5bfd6
KH		 2729 list->driver = driver;
2730 list->next = NULL;
2731 if (prev)
2732 prev->next = list;
2733 else if (f)
2734 f->font_driver_list = list;
2735 else
2736 font_driver_list = list;
2737 num_font_drivers++;
2738}
2739
45eb10fb 2740
c2f5bfd6
KH		 2741/* Free font-driver list on frame F. It doesn't free font-drivers
2742 themselves. */
2743
2744void
2745free_font_driver_list (f)
2746 FRAME_PTR f;
2747{
2748 while (f->font_driver_list)
2749 {
2750 struct font_driver_list *next = f->font_driver_list->next;
2751
2752 free (f->font_driver_list);
2753 f->font_driver_list = next;
2754 }
2755}
2756
45eb10fb 2757
f697fff0
KH		 2758/* Make the frame F use font backends listed in NEW_DRIVERS (list of
2759 symbols, e.g. xft, x). If NEW_DRIVERS is nil, make F use all
2760 available font drivers. If no backend is available, dont't alter
2761 F->font_driver_list.
417a1b10 2762
e950d6f1
KH		 2763 A caller must free all realized faces and clear all font caches if
2764 any in advance. The return value is a list of font backends
f697fff0 2765 actually made used on F. */
e950d6f1
KH		 2766
2767Lisp_Object
2768font_update_drivers (f, new_drivers)
417a1b10
KH		 2769 FRAME_PTR f;
2770 Lisp_Object new_drivers;
417a1b10
KH		 2771{
2772 Lisp_Object active_drivers = Qnil;
417a1b10
KH		 2773 struct font_driver_list *list;
2774
f697fff0
KH		 2775 /* At first, finialize all font drivers for F. */
2776 for (list = f->font_driver_list; list; list = list->next)
2777 if (list->on)
2778 {
2779 if (list->driver->end_for_frame)
2780 list->driver->end_for_frame (f);
2781 list->on = 0;
2782 }
2783
2784 /* Then start the requested drivers. */
417a1b10 2785 for (list = f->font_driver_list; list; list = list->next)
e950d6f1
KH		 2786 if (NILP (new_drivers)
2787 || ! NILP (Fmemq (list->driver->type, new_drivers)))
2788 {
f697fff0
KH		 2789 if (! list->driver->start_for_frame
2790 || list->driver->start_for_frame (f) == 0);
2791 {
2792 list->on = 1;
2793 active_drivers = nconc2 (active_drivers,
2794 Fcons (list->driver->type, Qnil));
2795 }
e950d6f1 2796 }
417a1b10 2797
e950d6f1 2798 return active_drivers;
417a1b10
KH		 2799}
2800
f697fff0
KH		 2801int
2802font_put_frame_data (f, driver, data)
2803 FRAME_PTR f;
2804 struct font_driver *driver;
2805 void *data;
2806{
2807 struct font_data_list *list, *prev;
2808
2809 for (prev = NULL, list = f->font_data_list; list;
2810 prev = list, list = list->next)
2811 if (list->driver == driver)
2812 break;
2813 if (! data)
2814 {
2815 if (list)
2816 {
2817 if (prev)
2818 prev->next = list->next;
2819 else
2820 f->font_data_list = list->next;
2821 free (list);
2822 }
2823 return 0;
2824 }
2825
2826 if (! list)
2827 {
2828 list = malloc (sizeof (struct font_data_list));
2829 if (! list)
2830 return -1;
2831 list->driver = driver;
2832 list->next = f->font_data_list;
2833 f->font_data_list = list;
2834 }
2835 list->data = data;
2836 return 0;
2837}
2838
2839
2840void *
2841font_get_frame_data (f, driver)
2842 FRAME_PTR f;
2843 struct font_driver *driver;
2844{
2845 struct font_data_list *list;
2846
2847 for (list = f->font_data_list; list; list = list->next)
2848 if (list->driver == driver)
2849 break;
2850 if (! list)
2851 return NULL;
2852 return list->data;
2853}
2854
417a1b10 2855
45eb10fb 2856/* Return the font used to draw character C by FACE at buffer position
e3ee0340
KH		 2857 POS in window W. If STRING is non-nil, it is a string containing C
2858 at index POS. If C is negative, get C from the current buffer or
2859 STRING. */
45eb10fb 2860
10d16101 2861Lisp_Object
e3ee0340 2862font_at (c, pos, face, w, string)
10d16101
KH		 2863 int c;
2864 EMACS_INT pos;
2865 struct face *face;
2866 struct window *w;
e3ee0340 2867 Lisp_Object string;
10d16101
KH		 2868{
2869 FRAME_PTR f;
e3ee0340
KH		 2870 int multibyte;
2871
2872 if (c < 0)
2873 {
2874 if (NILP (string))
2875 {
2876 multibyte = ! NILP (current_buffer->enable_multibyte_characters);
2877 if (multibyte)
2878 {
2879 EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
2880
2881 c = FETCH_CHAR (pos_byte);
2882 }
2883 else
2884 c = FETCH_BYTE (pos);
2885 }
2886 else
2887 {
2888 unsigned char *str;
2889
2890 multibyte = STRING_MULTIBYTE (string);
2891 if (multibyte)
2892 {
2893 EMACS_INT pos_byte = string_char_to_byte (string, pos);
2894
2895 str = SDATA (string) + pos_byte;
2896 c = STRING_CHAR (str, 0);
2897 }
2898 else
2899 c = SDATA (string)[pos];
2900 }
2901 }
10d16101
KH		 2902
2903 f = XFRAME (w->frame);
1385a806
KH		 2904 if (! FRAME_WINDOW_P (f))
2905 return Qnil;
10d16101
KH		 2906 if (! face)
2907 {
e3ee0340
KH		 2908 int face_id;
2909 int endptr;
2910
2911 if (STRINGP (string))
2912 face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
10d16101
KH		 2913 DEFAULT_FACE_ID, 0);
2914 else
e3ee0340 2915 face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
10d16101
KH		 2916 pos + 100, 0);
2917 face = FACE_FROM_ID (f, face_id);
2918 }
e3ee0340
KH		 2919 if (multibyte)
2920 {
2921 int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
2922 face = FACE_FROM_ID (f, face_id);
2923 }
10d16101
KH		 2924 if (! face->font_info)
2925 return Qnil;
45eb10fb 2926 return font_find_object ((struct font *) face->font_info);
10d16101
KH		 2927}
2928
c2f5bfd6
KH		 2929\f
2930/* Lisp API */
2931
2932DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0,
45eb10fb
KH		 2933 doc: /* Return t if OBJECT is a font-spec or font-entity.
2934Return nil otherwise. */)
c2f5bfd6
KH		 2935 (object)
2936 Lisp_Object object;
2937{
2938 return (FONTP (object) ? Qt : Qnil);
2939}
2940
2941DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
45eb10fb
KH		 2942 doc: /* Return a newly created font-spec with arguments as properties.
2943
2944ARGS must come in pairs KEY VALUE of font properties. KEY must be a
2945valid font property name listed below:
2946
2947`:family', `:weight', `:slant', `:width'
2948
2949They are the same as face attributes of the same name. See
2950`set-face-attribute.
2951
2952`:foundry'
2953
2954VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
2955
2956`:adstyle'
2957
2958VALUE must be a string or a symbol specifying the additional
2959typographic style information of a font, e.g. ``sans''. Usually null.
2960
2961`:registry'
2962
2963VALUE must be a string or a symbol specifying the charset registry and
2964encoding of a font, e.g. ``iso8859-1''.
2965
2966`:size'
2967
2968VALUE must be a non-negative integer or a floating point number
2969specifying the font size. It specifies the font size in 1/10 pixels
f697fff0
KH		 2970(if VALUE is an integer), or in points (if VALUE is a float).
2971usage: (font-spec ARGS ...) */)
c2f5bfd6
KH		 2972 (nargs, args)
2973 int nargs;
2974 Lisp_Object *args;
2975{
2976 Lisp_Object spec = Fmake_vector (make_number (FONT_SPEC_MAX), Qnil);
c2f5bfd6
KH		 2977 int i;
2978
2979 for (i = 0; i < nargs; i += 2)
2980 {
2981 enum font_property_index prop;
2982 Lisp_Object key = args[i], val = args[i + 1];
2983
ec6fe57c 2984 prop = get_font_prop_index (key, 0);
c2f5bfd6 2985 if (prop < FONT_EXTRA_INDEX)
ec6fe57c 2986 ASET (spec, prop, val);
c2f5bfd6 2987 else
4485a28e
KH		 2988 {
2989 if (EQ (key, QCname))
ec6fe57c
KH		 2990 {
2991 CHECK_STRING (val);
2992 font_parse_name ((char *) SDATA (val), spec);
2993 }
e950d6f1 2994 font_put_extra (spec, key, val);
4485a28e 2995 }
e950d6f1 2996 }
ec6fe57c 2997 CHECK_VALIDATE_FONT_SPEC (spec);
c2f5bfd6
KH		 2998 return spec;
2999}
3000
3001
3002DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
45eb10fb 3003 doc: /* Return the value of FONT's property KEY.
e950d6f1 3004FONT is a font-spec, a font-entity, or a font-object. */)
45eb10fb
KH		 3005 (font, key)
3006 Lisp_Object font, key;
c2f5bfd6
KH		 3007{
3008 enum font_property_index idx;
3009
10d16101 3010 if (FONT_OBJECT_P (font))
e80e09b4
KH		 3011 {
3012 struct font *fontp = XSAVE_VALUE (font)->pointer;
3013
45eb10fb 3014 if (EQ (key, QCotf))
e950d6f1 3015 {
771bd479
JR		 3016 if (fontp->driver->otf_capability)
3017 return fontp->driver->otf_capability (fontp);
3018 else
3019 return Qnil;
e950d6f1 3020 }
e80e09b4
KH		 3021 font = fontp->entity;
3022 }
10d16101
KH		 3023 else
3024 CHECK_FONT (font);
45eb10fb 3025 idx = get_font_prop_index (key, 0);
c2f5bfd6
KH		 3026 if (idx < FONT_EXTRA_INDEX)
3027 return AREF (font, idx);
3028 if (FONT_ENTITY_P (font))
3029 return Qnil;
45eb10fb 3030 return Fcdr (Fassoc (AREF (font, FONT_EXTRA_INDEX), key));
c2f5bfd6
KH		 3031}
3032
3033
3034DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
45eb10fb 3035 doc: /* Set one property of FONT-SPEC: give property KEY value VALUE. */)
c2f5bfd6
KH		 3036 (font_spec, prop, val)
3037 Lisp_Object font_spec, prop, val;
3038{
3039 enum font_property_index idx;
3040 Lisp_Object extra, slot;
3041
3042 CHECK_FONT_SPEC (font_spec);
ec6fe57c 3043 idx = get_font_prop_index (prop, 0);
c2f5bfd6
KH		 3044 if (idx < FONT_EXTRA_INDEX)
3045 return ASET (font_spec, idx, val);
3046 extra = AREF (font_spec, FONT_EXTRA_INDEX);
3047 slot = Fassoc (extra, prop);
3048 if (NILP (slot))
3049 extra = Fcons (Fcons (prop, val), extra);
3050 else
3051 Fsetcdr (slot, val);
3052 return val;
3053}
3054
3055DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
3056 doc: /* List available fonts matching FONT-SPEC on the current frame.
3057Optional 2nd argument FRAME specifies the target frame.
3058Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
45eb10fb
KH		 3059Optional 4th argument PREFER, if non-nil, is a font-spec to
3060control the order of the returned list. Fonts are sorted by
3061how they are close to PREFER. */)
c2f5bfd6
KH		 3062 (font_spec, frame, num, prefer)
3063 Lisp_Object font_spec, frame, num, prefer;
3064{
3065 Lisp_Object vec, list, tail;
3066 int n = 0, i, len;
3067
3068 if (NILP (frame))
3069 frame = selected_frame;
3070 CHECK_LIVE_FRAME (frame);
3071 CHECK_VALIDATE_FONT_SPEC (font_spec);
3072 if (! NILP (num))
3073 {
3074 CHECK_NUMBER (num);
3075 n = XINT (num);
3076 if (n <= 0)
3077 return Qnil;
3078 }
3079 if (! NILP (prefer))
3080 CHECK_FONT (prefer);
3081
3082 vec = font_list_entities (frame, font_spec);
3083 len = ASIZE (vec);
3084 if (len == 0)
3085 return Qnil;
3086 if (len == 1)
3087 return Fcons (AREF (vec, 0), Qnil);
3088
3089 if (! NILP (prefer))
3090 vec = font_sort_entites (vec, prefer, frame, font_spec);
3091
3092 list = tail = Fcons (AREF (vec, 0), Qnil);
3093 if (n == 0 || n > len)
3094 n = len;
3095 for (i = 1; i < n; i++)
3096 {
3097 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
3098
3099 XSETCDR (tail, val);
3100 tail = val;
3101 }
3102 return list;
3103}
3104
3105DEFUN ("list-families", Flist_families, Slist_families, 0, 1, 0,
3106 doc: /* List available font families on the current frame.
3107Optional 2nd argument FRAME specifies the target frame. */)
3108 (frame)
3109 Lisp_Object frame;
3110{
3111 FRAME_PTR f;
3112 struct font_driver_list *driver_list;
3113 Lisp_Object list;
3114
3115 if (NILP (frame))
3116 frame = selected_frame;
3117 CHECK_LIVE_FRAME (frame);
3118 f = XFRAME (frame);
3119 list = Qnil;
3120 for (driver_list = f->font_driver_list; driver_list;
3121 driver_list = driver_list->next)
3122 if (driver_list->driver->list_family)
3123 {
3124 Lisp_Object val = driver_list->driver->list_family (frame);
3125
3126 if (NILP (list))
3127 list = val;
3128 else
3129 {
3130 Lisp_Object tail = list;
3131
3132 for (; CONSP (val); val = XCDR (val))
3133 if (NILP (Fmemq (XCAR (val), tail)))
3134 list = Fcons (XCAR (val), list);
3135 }
3136 }
3137 return list;
3138}
3139
3140DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
3141 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
3142Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3143 (font_spec, frame)
3144 Lisp_Object font_spec, frame;
3145{
3146 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
3147
3148 if (CONSP (val))
3149 val = XCAR (val);
3150 return val;
3151}
3152
3153DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 1, 0,
3154 doc: /* Return XLFD name of FONT.
3155FONT is a font-spec, font-entity, or font-object.
3156If the name is too long for XLFD (maximum 255 chars), return nil. */)
3157 (font)
3158 Lisp_Object font;
3159{
3160 char name[256];
3161 int pixel_size = 0;
3162
3163 if (FONT_SPEC_P (font))
3164 CHECK_VALIDATE_FONT_SPEC (font);
3165 else if (FONT_ENTITY_P (font))
3166 CHECK_FONT (font);
3167 else
3168 {
3169 struct font *fontp;
3170
3171 CHECK_FONT_GET_OBJECT (font, fontp);
3172 font = fontp->entity;
3173 pixel_size = fontp->pixel_size;
3174 }
3175
3176 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
3177 return Qnil;
3178 return build_string (name);
3179}
3180
3181DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
3182 doc: /* Clear font cache. */)
3183 ()
3184{
3185 Lisp_Object list, frame;
3186
3187 FOR_EACH_FRAME (list, frame)
3188 {
3189 FRAME_PTR f = XFRAME (frame);
3190 struct font_driver_list *driver_list = f->font_driver_list;
3191
3192 for (; driver_list; driver_list = driver_list->next)
417a1b10
KH		 3193 if (driver_list->on)
3194 {
3195 Lisp_Object cache = driver_list->driver->get_cache (frame);
3196 Lisp_Object tail, elt;
c2f5bfd6 3197
417a1b10
KH		 3198 for (tail = XCDR (cache); CONSP (tail); tail = XCDR (tail))
3199 {
3200 elt = XCAR (tail);
3201 if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
3202 {
3203 Lisp_Object vec = XCDR (elt);
3204 int i;
3205
3206 for (i = 0; i < ASIZE (vec); i++)
3207 {
3208 Lisp_Object entity = AREF (vec, i);
3209
3210 if (EQ (driver_list->driver->type,
3211 AREF (entity, FONT_TYPE_INDEX)))
3212 {
3213 Lisp_Object objlist
3214 = AREF (entity, FONT_OBJLIST_INDEX);
3215
3216 for (; CONSP (objlist); objlist = XCDR (objlist))
3217 {
3218 Lisp_Object val = XCAR (objlist);
3219 struct Lisp_Save_Value *p = XSAVE_VALUE (val);
3220 struct font *font = p->pointer;
3221
3222 xassert (font && (driver_list->driver
3223 == font->driver));
3224 driver_list->driver->close (f, font);
3225 p->pointer = NULL;
3226 p->integer = 0;
3227 }
3228 if (driver_list->driver->free_entity)
3229 driver_list->driver->free_entity (entity);
3230 }
3231 }
3232 }
3233 }
3234 XSETCDR (cache, Qnil);
3235 }
c2f5bfd6
KH		 3236 }
3237
3238 return Qnil;
3239}
3240
3241DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table,
3242 Sinternal_set_font_style_table, 2, 2, 0,
3243 doc: /* Set font style table for PROP to TABLE.
3244PROP must be `:weight', `:slant', or `:width'.
3245TABLE must be an alist of symbols vs the corresponding numeric values
3246sorted by numeric values. */)
3247 (prop, table)
3248 Lisp_Object prop, table;
3249{
3250 int table_index;
3251 int numeric;
3252 Lisp_Object tail, val;
3253
3254 CHECK_SYMBOL (prop);
3255 table_index = (EQ (prop, QCweight) ? 0
3256 : EQ (prop, QCslant) ? 1
3257 : EQ (prop, QCwidth) ? 2
3258 : 3);
3259 if (table_index >= ASIZE (font_style_table))
3260 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop)));
3261 table = Fcopy_sequence (table);
3262 numeric = -1;
3263 for (tail = table; ! NILP (tail); tail = Fcdr (tail))
3264 {
3265 prop = Fcar (Fcar (tail));
3266 val = Fcdr (Fcar (tail));
3267 CHECK_SYMBOL (prop);
3268 CHECK_NATNUM (val);
3269 if (numeric > XINT (val))
3270 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop)));
3271 numeric = XINT (val);
3272 XSETCAR (tail, Fcons (prop, val));
3273 }
3274 ASET (font_style_table, table_index, table);
3275 return Qnil;
3276}
3277
45eb10fb
KH		 3278/* The following three functions are still expremental. */
3279
c2f5bfd6 3280DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0,
e80e09b4
KH		 3281 doc: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3282FONT-OBJECT may be nil if it is not yet known.
3283
3284G-string is sequence of glyphs of a specific font,
3285and is a vector of this form:
3286 [ HEADER GLYPH ... ]
3287HEADER is a vector of this form:
1701724c 3288 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
e80e09b4 3289where
733fd013 3290 FONT-OBJECT is a font-object for all glyphs in the g-string,
1701724c 3291 WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string.
e80e09b4 3292GLYPH is a vector of this form:
1701724c
KH		 3293 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3294 [ [X-OFF Y-OFF WADJUST] | nil] ]
e80e09b4
KH		 3295where
3296 FROM-IDX and TO-IDX are used internally and should not be touched.
3297 C is the character of the glyph.
3298 CODE is the glyph-code of C in FONT-OBJECT.
1701724c 3299 WIDTH thry DESCENT are the metrics (in pixels) of the glyph.
e80e09b4 3300 X-OFF and Y-OFF are offests to the base position for the glyph.
e80e09b4 3301 WADJUST is the adjustment to the normal width of the glyph. */)
c2f5bfd6
KH		 3302 (font_object, num)
3303 Lisp_Object font_object, num;
3304{
3305 Lisp_Object gstring, g;
3306 int len;
3307 int i;
3308
3309 if (! NILP (font_object))
3310 CHECK_FONT_OBJECT (font_object);
3311 CHECK_NATNUM (num);
3312
3313 len = XINT (num) + 1;
3314 gstring = Fmake_vector (make_number (len), Qnil);
3315 g = Fmake_vector (make_number (6), Qnil);
3316 ASET (g, 0, font_object);
3317 ASET (gstring, 0, g);
3318 for (i = 1; i < len; i++)
1701724c 3319 ASET (gstring, i, Fmake_vector (make_number (10), Qnil));
c2f5bfd6
KH		 3320 return gstring;
3321}
3322
3323DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
3324 doc: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3325START and END specifies the region to extract characters.
3326If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3327where to extract characters.
3328FONT-OBJECT may be nil if GSTRING already already contains one. */)
3329 (gstring, font_object, start, end, object)
3330 Lisp_Object gstring, font_object, start, end, object;
3331{
3332 int len, i, c;
3333 unsigned code;
3334 struct font *font;
3335
3336 CHECK_VECTOR (gstring);
3337 if (NILP (font_object))
10d16101 3338 font_object = LGSTRING_FONT (gstring);
c2f5bfd6
KH		 3339 CHECK_FONT_GET_OBJECT (font_object, font);
3340
3341 if (STRINGP (object))
3342 {
3343 const unsigned char *p;
3344
3345 CHECK_NATNUM (start);
3346 CHECK_NATNUM (end);
3347 if (XINT (start) > XINT (end)
3348 || XINT (end) > ASIZE (object)
10d16101 3349 || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
1701724c 3350 args_out_of_range_3 (object, start, end);
c2f5bfd6
KH		 3351
3352 len = XINT (end) - XINT (start);
3353 p = SDATA (object) + string_char_to_byte (object, XINT (start));
3354 for (i = 0; i < len; i++)
3355 {
3356 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
3357
3358 c = STRING_CHAR_ADVANCE (p);
3359 code = font->driver->encode_char (font, c);
3360 if (code > MOST_POSITIVE_FIXNUM)
3361 error ("Glyph code 0x%X is too large", code);
1701724c
KH		 3362 LGLYPH_SET_FROM (g, i);
3363 LGLYPH_SET_TO (g, i);
3364 LGLYPH_SET_CHAR (g, c);
3365 LGLYPH_SET_CODE (g, code);
c2f5bfd6
KH		 3366 }
3367 }
3368 else
3369 {
3370 int pos, pos_byte;
3371
3372 if (! NILP (object))
3373 Fset_buffer (object);
3374 validate_region (&start, &end);
10d16101 3375 if (XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
c2f5bfd6
KH		 3376 args_out_of_range (start, end);
3377 len = XINT (end) - XINT (start);
3378 pos = XINT (start);
3379 pos_byte = CHAR_TO_BYTE (pos);
3380 for (i = 0; i < len; i++)
3381 {
3382 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
3383
3384 FETCH_CHAR_ADVANCE (c, pos, pos_byte);
3385 code = font->driver->encode_char (font, c);
3386 if (code > MOST_POSITIVE_FIXNUM)
3387 error ("Glyph code 0x%X is too large", code);
1701724c
KH		 3388 LGLYPH_SET_FROM (g, i);
3389 LGLYPH_SET_TO (g, i);
3390 LGLYPH_SET_CHAR (g, c);
3391 LGLYPH_SET_CODE (g, code);
c2f5bfd6
KH		 3392 }
3393 }
10d16101 3394 for (i = LGSTRING_LENGTH (gstring) - 1; i >= len; i--)
1701724c
KH		 3395 LGSTRING_SET_GLYPH (gstring, i, Qnil);
3396 return Qnil;
3397}
3398
3399DEFUN ("font-shape-text", Ffont_shape_text, Sfont_shape_text, 3, 4, 0,
3400 doc: /* Shape text between FROM and TO by FONT-OBJECT.
3401If optional 4th argument STRING is non-nil, it is a string to shape,
3402and FROM and TO are indices to the string.
3403The value is the end position of the shaped text. */)
3404 (from, to, font_object, string)
3405 Lisp_Object from, to, font_object, string;
3406{
3407 struct font *font;
3408 struct font_metrics metrics;
3409 EMACS_INT start, end;
3410 Lisp_Object gstring, n;
3411 int i;
3412
3413 if (NILP (string))
3414 {
3415 validate_region (&from, &to);
3416 start = XFASTINT (from);
3417 end = XFASTINT (to);
3418 modify_region (current_buffer, start, end, 0);
3419 }
3420 else
3421 {
3422 CHECK_STRING (string);
3423 start = XINT (from);
3424 end = XINT (to);
3425 if (start < 0 || start > end || end > SCHARS (string))
3426 args_out_of_range_3 (string, from, to);
3427 }
3428
3429 CHECK_FONT_GET_OBJECT (font_object, font);
3430 if (! font->driver->shape)
3431 return from;
3432
3433 gstring = Ffont_make_gstring (font_object, make_number (end - start));
3434 Ffont_fill_gstring (gstring, font_object, from, to, string);
3435 n = font->driver->shape (gstring);
3436 if (NILP (n))
3437 return Qnil;
3438 for (i = 0; i < XINT (n);)
10d16101 3439 {
1701724c 3440 Lisp_Object gstr;
10d16101 3441 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
1701724c
KH		 3442 EMACS_INT this_from = LGLYPH_FROM (g);
3443 EMACS_INT this_to = LGLYPH_TO (g) + 1;
3444 int j, k;
3445
3446 metrics.lbearing = LGLYPH_LBEARING (g);
3447 metrics.rbearing = LGLYPH_RBEARING (g);
3448 metrics.ascent = LGLYPH_ASCENT (g);
3449 metrics.descent = LGLYPH_DESCENT (g);
3450 if (NILP (LGLYPH_ADJUSTMENT (g)))
3451 metrics.width = LGLYPH_WIDTH (g);
3452 else
3453 {
3454 metrics.width = LGLYPH_WADJUST (g);
3455 metrics.lbearing += LGLYPH_XOFF (g);
3456 metrics.rbearing += LGLYPH_XOFF (g);
3457 metrics.ascent -= LGLYPH_YOFF (g);
3458 metrics.descent += LGLYPH_YOFF (g);
3459 }
3460 for (j = i + 1; j < XINT (n); j++)
3461 {
3462 int x;
3463
3464 g = LGSTRING_GLYPH (gstring, j);
3465 if (this_from != LGLYPH_FROM (g))
3466 break;
3467 x = metrics.width + LGLYPH_LBEARING (g) + LGLYPH_XOFF (g);
3468 if (metrics.lbearing > x)
3469 metrics.lbearing = x;
3470 x = metrics.width + LGLYPH_RBEARING (g) + LGLYPH_XOFF (g);
3471 if (metrics.rbearing < x)
3472 metrics.rbearing = x;
3473 x = LGLYPH_ASCENT (g) - LGLYPH_YOFF (g);
3474 if (metrics.ascent < x)
3475 metrics.ascent = x;
3476 x = LGLYPH_DESCENT (g) - LGLYPH_YOFF (g);
3477 if (metrics.descent < x)
3478 metrics.descent = x;
3479 if (NILP (LGLYPH_ADJUSTMENT (g)))
3480 metrics.width += LGLYPH_WIDTH (g);
3481 else
3482 metrics.width += LGLYPH_WADJUST (g);
3483 }
10d16101 3484
1701724c
KH		 3485 gstr = Ffont_make_gstring (font_object, make_number (j - i));
3486 LGSTRING_SET_WIDTH (gstr, metrics.width);
3487 LGSTRING_SET_LBEARING (gstr, metrics.lbearing);
3488 LGSTRING_SET_RBEARING (gstr, metrics.rbearing);
3489 LGSTRING_SET_ASCENT (gstr, metrics.ascent);
3490 LGSTRING_SET_DESCENT (gstr, metrics.descent);
3491 for (k = i; i < j; i++)
3492 LGSTRING_SET_GLYPH (gstr, i - k, LGSTRING_GLYPH (gstring, i));
14065d35
KH		 3493 from = make_number (start + this_from);
3494 to = make_number (start + this_to);
1701724c 3495 if (NILP (string))
14065d35 3496 Fcompose_region_internal (from, to, gstr, Qnil);
1701724c 3497 else
14065d35 3498 Fcompose_string_internal (string, from, to, gstr, Qnil);
10d16101 3499 }
1701724c 3500
14065d35 3501 return to;
c2f5bfd6
KH		 3502}
3503
733fd013
KH		 3504DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
3505 doc: /* Apply OpenType features on glyph-string GSTRING-IN.
3506OTF-SPEC specifies which featuress to apply in this format:
3507 (SCRIPT LANGSYS GSUB GPOS)
e80e09b4
KH		 3508where
3509 SCRIPT is a symbol specifying a script tag of OpenType,
3510 LANGSYS is a symbol specifying a langsys tag of OpenType,
733fd013 3511 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
e80e09b4
KH		 3512
3513If LANGYS is nil, the default langsys is selected.
3514
733fd013
KH		 3515The features are applied in the order appeared in the list. The
3516symbol `*' means to apply all available features not appeared in this
3517list, and the remaining features are ignored. For instance, (vatu
3518pstf * haln) is to apply vatu and pstf in this order, then to apply
3519all available features other than vatu, pstf, and haln.
e80e09b4
KH		 3520
3521The features are applied to the glyphs in the range FROM and TO of
733fd013 3522the glyph-string GSTRING-IN.
e80e09b4
KH		 3523
3524If some of a feature is actually applicable, the resulting glyphs are
3525produced in the glyph-string GSTRING-OUT from the index INDEX. In
3526this case, the value is the number of produced glyphs.
3527
3528If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3529the value is 0.
3530
3531If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
3532produced in GSTRING-OUT, and the value is nil.
3533
3534See the documentation of `font-make-gstring' for the format of
3535glyph-string. */)
733fd013
KH		 3536 (otf_features, gstring_in, from, to, gstring_out, index)
3537 Lisp_Object otf_features, gstring_in, from, to, gstring_out, index;
e80e09b4
KH		 3538{
3539 Lisp_Object font_object = LGSTRING_FONT (gstring_in);
733fd013
KH		 3540 Lisp_Object val;
3541 struct font *font;
e80e09b4
KH		 3542 int len, num;
3543
733fd013 3544 check_otf_features (otf_features);
e80e09b4 3545 CHECK_FONT_GET_OBJECT (font_object, font);
733fd013 3546 if (! font->driver->otf_drive)
e80e09b4
KH		 3547 error ("Font backend %s can't drive OpenType GSUB table",
3548 SDATA (SYMBOL_NAME (font->driver->type)));
733fd013
KH		 3549 CHECK_CONS (otf_features);
3550 CHECK_SYMBOL (XCAR (otf_features));
3551 val = XCDR (otf_features);
3552 CHECK_SYMBOL (XCAR (val));
3553 val = XCDR (otf_features);
3554 if (! NILP (val))
3555 CHECK_CONS (val);
e80e09b4
KH		 3556 len = check_gstring (gstring_in);
3557 CHECK_VECTOR (gstring_out);
3558 CHECK_NATNUM (from);
3559 CHECK_NATNUM (to);
3560 CHECK_NATNUM (index);
3561
3562 if (XINT (from) >= XINT (to) || XINT (to) > len)
3563 args_out_of_range_3 (from, to, make_number (len));
3564 if (XINT (index) >= ASIZE (gstring_out))
3565 args_out_of_range (index, make_number (ASIZE (gstring_out)));
733fd013
KH		 3566 num = font->driver->otf_drive (font, otf_features,
3567 gstring_in, XINT (from), XINT (to),
3568 gstring_out, XINT (index), 0);
e80e09b4
KH		 3569 if (num < 0)
3570 return Qnil;
3571 return make_number (num);
3572}
3573
e80e09b4
KH		 3574DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
3575 3, 3, 0,
3576 doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
3577FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
3578in this format:
3579 (SCRIPT LANGSYS FEATURE ...)
3580See the documentation of `font-otf-gsub' for more detail.
3581
3582The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
3583where GLYPH-ID is a glyph index of the font, and CHARACTER is a
3584character code corresponding to the glyph or nil if there's no
3585corresponding character. */)
733fd013
KH		 3586 (font_object, character, otf_features)
3587 Lisp_Object font_object, character, otf_features;
e80e09b4
KH		 3588{
3589 struct font *font;
3590 Lisp_Object gstring_in, gstring_out, g;
3591 Lisp_Object alternates;
3592 int i, num;
3593
3594 CHECK_FONT_GET_OBJECT (font_object, font);
733fd013 3595 if (! font->driver->otf_drive)
e950d6f1
KH		 3596 error ("Font backend %s can't drive OpenType GSUB table",
3597 SDATA (SYMBOL_NAME (font->driver->type)));
e80e09b4 3598 CHECK_CHARACTER (character);
733fd013 3599 CHECK_CONS (otf_features);
e80e09b4
KH		 3600
3601 gstring_in = Ffont_make_gstring (font_object, make_number (1));
3602 g = LGSTRING_GLYPH (gstring_in, 0);
3603 LGLYPH_SET_CHAR (g, character);
3604 gstring_out = Ffont_make_gstring (font_object, make_number (10));
733fd013
KH		 3605 while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
3606 gstring_out, 0, 1)) < 0)
e80e09b4
KH		 3607 gstring_out = Ffont_make_gstring (font_object,
3608 make_number (ASIZE (gstring_out) * 2));
3609 alternates = Qnil;
3610 for (i = 0; i < num; i++)
3611 {
3612 Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
3613 int c = XINT (LGLYPH_CHAR (g));
3614 unsigned code = XUINT (LGLYPH_CODE (g));
e80e09b4
KH		 3615
3616 alternates = Fcons (Fcons (make_number (code),
3617 c > 0 ? make_number (c) : Qnil),
3618 alternates);
3619 }
3620 return Fnreverse (alternates);
3621}
3622
c2f5bfd6
KH		 3623
3624#ifdef FONT_DEBUG
3625
3626DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
3627 doc: /* Open FONT-ENTITY. */)
3628 (font_entity, size, frame)
3629 Lisp_Object font_entity;
3630 Lisp_Object size;
3631 Lisp_Object frame;
3632{
3633 int isize;
3634
3635 CHECK_FONT_ENTITY (font_entity);
3636 if (NILP (size))
3637 size = AREF (font_entity, FONT_SIZE_INDEX);
3638 CHECK_NUMBER (size);
3639 if (NILP (frame))
3640 frame = selected_frame;
3641 CHECK_LIVE_FRAME (frame);
3642
3643 isize = XINT (size);
1701724c
KH		 3644 if (isize == 0)
3645 isize = 120;
c2f5bfd6
KH		 3646 if (isize < 0)
3647 isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
3648
3649 return font_open_entity (XFRAME (frame), font_entity, isize);
3650}
3651
3652DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
3653 doc: /* Close FONT-OBJECT. */)
3654 (font_object, frame)
3655 Lisp_Object font_object, frame;
3656{
3657 CHECK_FONT_OBJECT (font_object);
3658 if (NILP (frame))
3659 frame = selected_frame;
3660 CHECK_LIVE_FRAME (frame);
3661 font_close_object (XFRAME (frame), font_object);
3662 return Qnil;
3663}
3664
3665DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
e80e09b4
KH		 3666 doc: /* Return information about FONT-OBJECT.
3667The value is a vector:
3668 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
e0708580 3669 CAPABILITY ]
e80e09b4
KH		 3670
3671NAME is a string of the font name (or nil if the font backend doesn't
3672provide a name).
3673
3674FILENAME is a string of the font file (or nil if the font backend
3675doesn't provide a file name).
3676
3677PIXEL-SIZE is a pixel size by which the font is opened.
3678
3679SIZE is a maximum advance width of the font in pixel.
3680
3681ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
3682pixel.
3683
e0708580
KH		 3684CAPABILITY is a list whose first element is a symbol representing the
3685font format \(x, opentype, truetype, type1, pcf, or bdf) and the
3686remaining elements describes a detail of the font capability.
3687
3688If the font is OpenType font, the form of the list is
3689 \(opentype GSUB GPOS)
3690where GSUB shows which "GSUB" features the font supports, and GPOS
3691shows which "GPOS" features the font supports. Both GSUB and GPOS are
3692lists of the format:
3693 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3694
3695If the font is not OpenType font, currently the length of the form is
3696one.
e80e09b4
KH		 3697
3698SCRIPT is a symbol representing OpenType script tag.
3699
3700LANGSYS is a symbol representing OpenType langsys tag, or nil
3701representing the default langsys.
3702
3703FEATURE is a symbol representing OpenType feature tag.
3704
3705If the font is not OpenType font, OTF-CAPABILITY is nil. */)
c2f5bfd6
KH		 3706 (font_object)
3707 Lisp_Object font_object;
3708{
3709 struct font *font;
3710 Lisp_Object val;
3711
3712 CHECK_FONT_GET_OBJECT (font_object, font);
3713
3714 val = Fmake_vector (make_number (9), Qnil);
e80e09b4
KH		 3715 if (font->font.full_name)
3716 ASET (val, 0, make_unibyte_string (font->font.full_name,
3717 strlen (font->font.full_name)));
c2f5bfd6
KH		 3718 if (font->file_name)
3719 ASET (val, 1, make_unibyte_string (font->file_name,
3720 strlen (font->file_name)));
3721 ASET (val, 2, make_number (font->pixel_size));
3722 ASET (val, 3, make_number (font->font.size));
3723 ASET (val, 4, make_number (font->ascent));
3724 ASET (val, 5, make_number (font->descent));
3725 ASET (val, 6, make_number (font->font.space_width));
3726 ASET (val, 7, make_number (font->font.average_width));
3727 if (font->driver->otf_capability)
e0708580
KH		 3728 ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
3729 else
3730 ASET (val, 8, Fcons (font->format, Qnil));
c2f5bfd6
KH		 3731 return val;
3732}
3733
3734DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
3735 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3736Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3737 (font_object, string)
3738 Lisp_Object font_object, string;
3739{
3740 struct font *font;
3741 int i, len;
3742 Lisp_Object vec;
3743
3744 CHECK_FONT_GET_OBJECT (font_object, font);
3745 CHECK_STRING (string);
3746 len = SCHARS (string);
3747 vec = Fmake_vector (make_number (len), Qnil);
3748 for (i = 0; i < len; i++)
3749 {
3750 Lisp_Object ch = Faref (string, make_number (i));
3751 Lisp_Object val;
3752 int c = XINT (ch);
3753 unsigned code;
3754 struct font_metrics metrics;
3755
3756 code = font->driver->encode_char (font, c);
3757 if (code == FONT_INVALID_CODE)
3758 continue;
3759 val = Fmake_vector (make_number (6), Qnil);
3760 if (code <= MOST_POSITIVE_FIXNUM)
3761 ASET (val, 0, make_number (code));
3762 else
3763 ASET (val, 0, Fcons (make_number (code >> 16),
3764 make_number (code & 0xFFFF)));
3765 font->driver->text_extents (font, &code, 1, &metrics);
3766 ASET (val, 1, make_number (metrics.lbearing));
3767 ASET (val, 2, make_number (metrics.rbearing));
3768 ASET (val, 3, make_number (metrics.width));
3769 ASET (val, 4, make_number (metrics.ascent));
3770 ASET (val, 5, make_number (metrics.descent));
3771 ASET (vec, i, val);
3772 }
3773 return vec;
3774}
3775
ec6fe57c
KH		 3776DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
3777 doc: /* Return t iff font-spec SPEC matches with FONT.
3778FONT is a font-spec, font-entity, or font-object. */)
3779 (spec, font)
3780 Lisp_Object spec, font;
3781{
3782 CHECK_FONT_SPEC (spec);
3783 if (FONT_OBJECT_P (font))
3784 font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity;
3785 else if (! FONT_ENTITY_P (font))
3786 CHECK_FONT_SPEC (font);
3787
3788 return (font_match_p (spec, font) ? Qt : Qnil);
3789}
3790
1701724c 3791DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
10d16101
KH		 3792 doc: /* Return a font-object for displaying a character at POSISTION.
3793Optional second arg WINDOW, if non-nil, is a window displaying
3794the current buffer. It defaults to the currently selected window. */)
1701724c
KH		 3795 (position, window, string)
3796 Lisp_Object position, window, string;
10d16101
KH		 3797{
3798 struct window *w;
e3ee0340 3799 EMACS_INT pos;
10d16101 3800
1701724c
KH		 3801 if (NILP (string))
3802 {
3803 CHECK_NUMBER_COERCE_MARKER (position);
3804 pos = XINT (position);
3805 if (pos < BEGV || pos >= ZV)
3806 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1701724c
KH		 3807 }
3808 else
3809 {
3810 EMACS_INT len;
3811 unsigned char *str;
3812
3813 CHECK_NUMBER (position);
3814 CHECK_STRING (string);
3815 pos = XINT (position);
3816 if (pos < 0 || pos >= SCHARS (string))
3817 args_out_of_range (string, position);
1701724c 3818 }
10d16101
KH		 3819 if (NILP (window))
3820 window = selected_window;
3821 CHECK_LIVE_WINDOW (window);
3822 w = XWINDOW (selected_window);
3823
e3ee0340 3824 return font_at (-1, pos, NULL, w, Qnil);
10d16101
KH		 3825}
3826
c2f5bfd6
KH		 3827#if 0
3828DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
3829 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
3830The value is a number of glyphs drawn.
3831Type C-l to recover what previously shown. */)
3832 (font_object, string)
3833 Lisp_Object font_object, string;
3834{
3835 Lisp_Object frame = selected_frame;
3836 FRAME_PTR f = XFRAME (frame);
3837 struct font *font;
3838 struct face *face;
3839 int i, len, width;
3840 unsigned *code;
3841
3842 CHECK_FONT_GET_OBJECT (font_object, font);
3843 CHECK_STRING (string);
3844 len = SCHARS (string);
3845 code = alloca (sizeof (unsigned) * len);
3846 for (i = 0; i < len; i++)
3847 {
3848 Lisp_Object ch = Faref (string, make_number (i));
3849 Lisp_Object val;
3850 int c = XINT (ch);
3851
3852 code[i] = font->driver->encode_char (font, c);
3853 if (code[i] == FONT_INVALID_CODE)
3854 break;
3855 }
3856 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
3857 face->fontp = font;
3858 if (font->driver->prepare_face)
3859 font->driver->prepare_face (f, face);
3860 width = font->driver->text_extents (font, code, i, NULL);
3861 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
3862 if (font->driver->done_face)
3863 font->driver->done_face (f, face);
3864 face->fontp = NULL;
3865 return make_number (len);
3866}
3867#endif
3868
3869#endif /* FONT_DEBUG */
3870
3871\f
3872extern void syms_of_ftfont P_ (());
3873extern void syms_of_xfont P_ (());
3874extern void syms_of_xftfont P_ (());
3875extern void syms_of_ftxfont P_ (());
3876extern void syms_of_bdffont P_ (());
3877extern void syms_of_w32font P_ (());
3878extern void syms_of_atmfont P_ (());
3879
3880void
3881syms_of_font ()
3882{
3883 sort_shift_bits[FONT_SLANT_INDEX] = 0;
3884 sort_shift_bits[FONT_WEIGHT_INDEX] = 7;
3885 sort_shift_bits[FONT_SIZE_INDEX] = 14;
3886 sort_shift_bits[FONT_WIDTH_INDEX] = 21;
3887 sort_shift_bits[FONT_ADSTYLE_INDEX] = 28;
3888 sort_shift_bits[FONT_FOUNDRY_INDEX] = 29;
3889 sort_shift_bits[FONT_FAMILY_INDEX] = 30;
3890 sort_shift_bits[FONT_REGISTRY_INDEX] = 31;
fe5ddfbc 3891 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
c2f5bfd6
KH		 3892
3893 staticpro (&font_style_table);
3894 font_style_table = Fmake_vector (make_number (3), Qnil);
3895
3896 staticpro (&font_family_alist);
3897 font_family_alist = Qnil;
3898
1701724c
KH		 3899 staticpro (&font_charset_alist);
3900 font_charset_alist = Qnil;
3901
e0708580 3902 DEFSYM (Qopentype, "opentype");
c2f5bfd6 3903
1bb1d99b
KH		 3904 DEFSYM (Qiso8859_1, "iso8859-1");
3905 DEFSYM (Qiso10646_1, "iso10646-1");
3906 DEFSYM (Qunicode_bmp, "unicode-bmp");
cf96c5c2 3907 DEFSYM (Qunicode_sip, "unicode-sip");
1bb1d99b 3908
c2f5bfd6
KH		 3909 DEFSYM (QCotf, ":otf");
3910 DEFSYM (QClanguage, ":language");
3911 DEFSYM (QCscript, ":script");
4c496d0d 3912 DEFSYM (QCantialias, ":antialias");
c2f5bfd6
KH		 3913
3914 DEFSYM (QCfoundry, ":foundry");
3915 DEFSYM (QCadstyle, ":adstyle");
3916 DEFSYM (QCregistry, ":registry");
9331887d
KH		 3917 DEFSYM (QCspacing, ":spacing");
3918 DEFSYM (QCdpi, ":dpi");
ec6fe57c 3919 DEFSYM (QCscalable, ":scalable");
c2f5bfd6
KH		 3920 DEFSYM (QCextra, ":extra");
3921
ec6fe57c
KH		 3922 DEFSYM (Qc, "c");
3923 DEFSYM (Qm, "m");
3924 DEFSYM (Qp, "p");
3925 DEFSYM (Qd, "d");
3926
c2f5bfd6
KH		 3927 staticpro (&null_string);
3928 null_string = build_string ("");
3929 staticpro (&null_vector);
3930 null_vector = Fmake_vector (make_number (0), Qnil);
3931
3932 staticpro (&scratch_font_spec);
3933 scratch_font_spec = Ffont_spec (0, NULL);
3934 staticpro (&scratch_font_prefer);
3935 scratch_font_prefer = Ffont_spec (0, NULL);
3936
733fd013
KH		 3937#ifdef HAVE_LIBOTF
3938 staticpro (&otf_list);
3939 otf_list = Qnil;
3940#endif
3941
c2f5bfd6
KH		 3942 defsubr (&Sfontp);
3943 defsubr (&Sfont_spec);
3944 defsubr (&Sfont_get);
3945 defsubr (&Sfont_put);
3946 defsubr (&Slist_fonts);
3947 defsubr (&Slist_families);
3948 defsubr (&Sfind_font);
3949 defsubr (&Sfont_xlfd_name);
3950 defsubr (&Sclear_font_cache);
3951 defsubr (&Sinternal_set_font_style_table);
3952 defsubr (&Sfont_make_gstring);
3953 defsubr (&Sfont_fill_gstring);
1701724c 3954 defsubr (&Sfont_shape_text);
733fd013 3955 defsubr (&Sfont_drive_otf);
e80e09b4 3956 defsubr (&Sfont_otf_alternates);
c2f5bfd6
KH		 3957
3958#ifdef FONT_DEBUG
3959 defsubr (&Sopen_font);
3960 defsubr (&Sclose_font);
3961 defsubr (&Squery_font);
3962 defsubr (&Sget_font_glyphs);
ec6fe57c 3963 defsubr (&Sfont_match_p);
10d16101 3964 defsubr (&Sfont_at);
c2f5bfd6
KH		 3965#if 0
3966 defsubr (&Sdraw_string);
3967#endif
3968#endif /* FONT_DEBUG */
3969
1701724c
KH		 3970#ifdef USE_FONT_BACKEND
3971 if (enable_font_backend)
3972 {
c2f5bfd6 3973#ifdef HAVE_FREETYPE
1701724c 3974 syms_of_ftfont ();
c2f5bfd6 3975#ifdef HAVE_X_WINDOWS
1701724c
KH		 3976 syms_of_xfont ();
3977 syms_of_ftxfont ();
c2f5bfd6 3978#ifdef HAVE_XFT
1701724c 3979 syms_of_xftfont ();
c2f5bfd6
KH		 3980#endif /* HAVE_XFT */
3981#endif /* HAVE_X_WINDOWS */
3982#else /* not HAVE_FREETYPE */
3983#ifdef HAVE_X_WINDOWS
1701724c 3984 syms_of_xfont ();
c2f5bfd6
KH		 3985#endif /* HAVE_X_WINDOWS */
3986#endif /* not HAVE_FREETYPE */
3987#ifdef HAVE_BDFFONT
1701724c 3988 syms_of_bdffont ();
c2f5bfd6
KH		 3989#endif /* HAVE_BDFFONT */
3990#ifdef WINDOWSNT
1701724c 3991 syms_of_w32font ();
c2f5bfd6
KH		 3992#endif /* WINDOWSNT */
3993#ifdef MAC_OS
1701724c 3994 syms_of_atmfont ();
c2f5bfd6 3995#endif /* MAC_OS */
1701724c
KH		 3996 }
3997#endif /* USE_FONT_BACKEND */
c2f5bfd6 3998}
885b7d09
MB		 3999
4000/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4001 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.