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