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