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