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