HCoop / bpt / emacs.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
* fontset.c (fontset_get_font_group):
[bpt/emacs.git] / src / font.c
1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
6
7 This file is part of GNU Emacs.
8
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
13
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21
22 #include <config.h>
23 #include <stdio.h>
24 #include <stdlib.h>
25 #include <ctype.h>
26 #ifdef HAVE_M17N_FLT
27 #include <m17n-flt.h>
28 #endif
29
30 #include "lisp.h"
31 #include "buffer.h"
32 #include "frame.h"
33 #include "window.h"
34 #include "dispextern.h"
35 #include "charset.h"
36 #include "character.h"
37 #include "composite.h"
38 #include "fontset.h"
39 #include "font.h"
40
41 #ifdef HAVE_X_WINDOWS
42 #include "xterm.h"
43 #endif /* HAVE_X_WINDOWS */
44
45 #ifdef HAVE_NTGUI
46 #include "w32term.h"
47 #endif /* HAVE_NTGUI */
48
49 #ifdef MAC_OS
50 #include "macterm.h"
51 #endif /* MAC_OS */
52
53 Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
54
55 Lisp_Object Qopentype;
56
57 /* Important character set strings. */
58 Lisp_Object Qascii_0, Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip;
59
60 /* Special vector of zero length. This is repeatedly used by (struct
61 font_driver *)->list when a specified font is not found. */
62 static Lisp_Object null_vector;
63
64 static Lisp_Object Vfont_weight_table, Vfont_slant_table, Vfont_width_table;
65
66 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
67 static Lisp_Object font_style_table;
68
69 /* Structure used for tables mapping weight, slant, and width numeric
70 values and their names. */
71
72 struct table_entry
73 {
74 int numeric;
75 /* The first one is a valid name as a face attribute.
76 The second one (if any) is a typical name in XLFD field. */
77 char *names[5];
78 Lisp_Object *symbols;
79 };
80
81 /* Table of weight numeric values and their names. This table must be
82 sorted by numeric values in ascending order. */
83
84 static struct table_entry weight_table[] =
85 {
86 { 0, { "thin" }},
87 { 20, { "ultra-light", "ultralight" }},
88 { 40, { "extra-light", "extralight" }},
89 { 50, { "light" }},
90 { 75, { "semi-light", "semilight", "demilight", "book" }},
91 { 100, { "normal", "medium", "regular" }},
92 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
93 { 200, { "bold" }},
94 { 205, { "extra-bold", "extrabold" }},
95 { 210, { "ultra-bold", "ultrabold", "black" }}
96 };
97
98 /* Table of slant numeric values and their names. This table must be
99 sorted by numeric values in ascending order. */
100
101 static struct table_entry slant_table[] =
102 {
103 { 0, { "reverse-oblique", "ro" }},
104 { 10, { "reverse-italic", "ri" }},
105 { 100, { "normal", "r" }},
106 { 200, { "italic" ,"i", "ot" }},
107 { 210, { "oblique", "o" }}
108 };
109
110 /* Table of width numeric values and their names. This table must be
111 sorted by numeric values in ascending order. */
112
113 static struct table_entry width_table[] =
114 {
115 { 50, { "ultra-condensed", "ultracondensed" }},
116 { 63, { "extra-condensed", "extracondensed" }},
117 { 75, { "condensed", "compressed", "narrow" }},
118 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
119 { 100, { "normal", "medium", "regular" }},
120 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
121 { 125, { "expanded" }},
122 { 150, { "extra-expanded", "extraexpanded" }},
123 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
124 };
125
126 extern Lisp_Object Qnormal;
127
128 /* Symbols representing keys of normal font properties. */
129 extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth;
130 extern Lisp_Object QCheight, QCsize, QCname;
131
132 Lisp_Object QCfoundry, QCadstyle, QCregistry;
133 /* Symbols representing keys of font extra info. */
134 Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClang, QCscript, QCavgwidth;
135 Lisp_Object QCantialias, QCfont_entity, QCfc_unknown_spec;
136 /* Symbols representing values of font spacing property. */
137 Lisp_Object Qc, Qm, Qp, Qd;
138
139 Lisp_Object Vfont_encoding_alist;
140
141 /* Alist of font registry symbol and the corresponding charsets
142 information. The information is retrieved from
143 Vfont_encoding_alist on demand.
144
145 Eash element has the form:
146 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
147 or
148 (REGISTRY . nil)
149
150 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
151 encodes a character code to a glyph code of a font, and
152 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
153 character is supported by a font.
154
155 The latter form means that the information for REGISTRY couldn't be
156 retrieved. */
157 static Lisp_Object font_charset_alist;
158
159 /* List of all font drivers. Each font-backend (XXXfont.c) calls
160 register_font_driver in syms_of_XXXfont to register its font-driver
161 here. */
162 static struct font_driver_list *font_driver_list;
163
164 \f
165
166 /* Creaters of font-related Lisp object. */
167
168 Lisp_Object
169 font_make_spec ()
170 {
171 Lisp_Object font_spec;
172 struct font_spec *spec
173 = ((struct font_spec *)
174 allocate_pseudovector (VECSIZE (struct font_spec),
175 FONT_SPEC_MAX, PVEC_FONT));
176 XSETFONT (font_spec, spec);
177 return font_spec;
178 }
179
180 Lisp_Object
181 font_make_entity ()
182 {
183 Lisp_Object font_entity;
184 struct font_entity *entity
185 = ((struct font_entity *)
186 allocate_pseudovector (VECSIZE (struct font_entity),
187 FONT_ENTITY_MAX, PVEC_FONT));
188 XSETFONT (font_entity, entity);
189 return font_entity;
190 }
191
192 /* Create a font-object whose structure size is SIZE. If ENTITY is
193 not nil, copy properties from ENTITY to the font-object. If
194 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
195 Lisp_Object
196 font_make_object (size, entity, pixelsize)
197 int size;
198 Lisp_Object entity;
199 int pixelsize;
200 {
201 Lisp_Object font_object;
202 struct font *font
203 = (struct font *) allocate_pseudovector (size, FONT_OBJECT_MAX, PVEC_FONT);
204 int i;
205
206 XSETFONT (font_object, font);
207
208 if (! NILP (entity))
209 {
210 for (i = 1; i < FONT_SPEC_MAX; i++)
211 font->props[i] = AREF (entity, i);
212 if (! NILP (AREF (entity, FONT_EXTRA_INDEX)))
213 font->props[FONT_EXTRA_INDEX]
214 = Fcopy_sequence (AREF (entity, FONT_EXTRA_INDEX));
215 }
216 if (size > 0)
217 font->props[FONT_SIZE_INDEX] = make_number (pixelsize);
218 return font_object;
219 }
220
221 \f
222
223 static int font_pixel_size P_ ((FRAME_PTR f, Lisp_Object));
224 static Lisp_Object font_open_entity P_ ((FRAME_PTR, Lisp_Object, int));
225 static Lisp_Object font_matching_entity P_ ((FRAME_PTR, Lisp_Object *,
226 Lisp_Object));
227
228 /* Number of registered font drivers. */
229 static int num_font_drivers;
230
231
232 /* Return a Lispy value of a font property value at STR and LEN bytes.
233 If STR is "*", it returns nil.
234 If FORCE_SYMBOL is zero and all characters in STR are digits, it
235 returns an integer. Otherwise, it returns a symbol interned from
236 STR. */
237
238 Lisp_Object
239 font_intern_prop (str, len, force_symbol)
240 char *str;
241 int len;
242 int force_symbol;
243 {
244 int i;
245 Lisp_Object tem;
246 Lisp_Object obarray;
247
248 if (len == 1 && *str == '*')
249 return Qnil;
250 if (!force_symbol && len >=1 && isdigit (*str))
251 {
252 for (i = 1; i < len; i++)
253 if (! isdigit (str[i]))
254 break;
255 if (i == len)
256 return make_number (atoi (str));
257 }
258
259 /* The following code is copied from the function intern (in lread.c). */
260 obarray = Vobarray;
261 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
262 obarray = check_obarray (obarray);
263 tem = oblookup (obarray, str, len, len);
264 if (SYMBOLP (tem))
265 return tem;
266 return Fintern (make_unibyte_string (str, len), obarray);
267 }
268
269 /* Return a pixel size of font-spec SPEC on frame F. */
270
271 static int
272 font_pixel_size (f, spec)
273 FRAME_PTR f;
274 Lisp_Object spec;
275 {
276 #ifdef HAVE_WINDOW_SYSTEM
277 Lisp_Object size = AREF (spec, FONT_SIZE_INDEX);
278 double point_size;
279 int dpi, pixel_size;
280 Lisp_Object val;
281
282 if (INTEGERP (size))
283 return XINT (size);
284 if (NILP (size))
285 return 0;
286 font_assert (FLOATP (size));
287 point_size = XFLOAT_DATA (size);
288 val = AREF (spec, FONT_DPI_INDEX);
289 if (INTEGERP (val))
290 dpi = XINT (val);
291 else
292 dpi = f->resy;
293 pixel_size = POINT_TO_PIXEL (point_size, dpi);
294 return pixel_size;
295 #else
296 return 1;
297 #endif
298 }
299
300
301 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
302 font vector. If VAL is not valid (i.e. not registered in
303 font_style_table), return -1 if NOERROR is zero, and return a
304 proper index if NOERROR is nonzero. In that case, register VAL in
305 font_style_table if VAL is a symbol, and return a closest index if
306 VAL is an integer. */
307
308 int
309 font_style_to_value (prop, val, noerror)
310 enum font_property_index prop;
311 Lisp_Object val;
312 int noerror;
313 {
314 Lisp_Object table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
315 int len = ASIZE (table);
316 int i, j;
317
318 if (SYMBOLP (val))
319 {
320 unsigned char *s;
321 Lisp_Object args[2], elt;
322
323 /* At first try exact match. */
324 for (i = 0; i < len; i++)
325 for (j = 1; j < ASIZE (AREF (table, i)); j++)
326 if (EQ (val, AREF (AREF (table, i), j)))
327 return ((XINT (AREF (AREF (table, i), 0)) << 8)
328 | (i << 4) | (j - 1));
329 /* Try also with case-folding match. */
330 s = SDATA (SYMBOL_NAME (val));
331 for (i = 0; i < len; i++)
332 for (j = 1; j < ASIZE (AREF (table, i)); j++)
333 {
334 elt = AREF (AREF (table, i), j);
335 if (xstrcasecmp (s, SDATA (SYMBOL_NAME (elt))) == 0)
336 return ((XINT (AREF (AREF (table, i), 0)) << 8)
337 | (i << 4) | (j - 1));
338 }
339 if (! noerror)
340 return -1;
341 if (len == 255)
342 abort ();
343 elt = Fmake_vector (make_number (2), make_number (255));
344 ASET (elt, 1, val);
345 args[0] = table;
346 args[1] = Fmake_vector (make_number (1), elt);
347 ASET (font_style_table, prop - FONT_WEIGHT_INDEX, Fvconcat (2, args));
348 return (255 << 8) | (i << 4);
349 }
350 else
351 {
352 int i, last_n;
353 int numeric = XINT (val);
354
355 for (i = 0, last_n = -1; i < len; i++)
356 {
357 int n = XINT (AREF (AREF (table, i), 0));
358
359 if (numeric == n)
360 return (n << 8) | (i << 4);
361 if (numeric < n)
362 {
363 if (! noerror)
364 return -1;
365 return ((i == 0 || n - numeric < numeric - last_n)
366 ? (n << 8) | (i << 4): (last_n << 8 | ((i - 1) << 4)));
367 }
368 last_n = n;
369 }
370 if (! noerror)
371 return -1;
372 return ((last_n << 8) | ((i - 1) << 4));
373 }
374 }
375
376 Lisp_Object
377 font_style_symbolic (font, prop, for_face)
378 Lisp_Object font;
379 enum font_property_index prop;
380 int for_face;
381 {
382 Lisp_Object val = AREF (font, prop);
383 Lisp_Object table, elt;
384 int i;
385
386 if (NILP (val))
387 return Qnil;
388 table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
389 i = XINT (val) & 0xFF;
390 font_assert (((i >> 4) & 0xF) < ASIZE (table));
391 elt = AREF (table, ((i >> 4) & 0xF));
392 font_assert ((i & 0xF) + 1 < ASIZE (elt));
393 return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
394 }
395
396 extern Lisp_Object Vface_alternative_font_family_alist;
397
398 extern Lisp_Object find_font_encoding P_ ((Lisp_Object));
399
400
401 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
402 FONTNAME. ENCODING is a charset symbol that specifies the encoding
403 of the font. REPERTORY is a charset symbol or nil. */
404
405 Lisp_Object
406 find_font_encoding (fontname)
407 Lisp_Object fontname;
408 {
409 Lisp_Object tail, elt;
410
411 for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail))
412 {
413 elt = XCAR (tail);
414 if (CONSP (elt)
415 && STRINGP (XCAR (elt))
416 && fast_string_match_ignore_case (XCAR (elt), fontname) >= 0
417 && (SYMBOLP (XCDR (elt))
418 ? CHARSETP (XCDR (elt))
419 : CONSP (XCDR (elt)) && CHARSETP (XCAR (XCDR (elt)))))
420 return (XCDR (elt));
421 }
422 /* We don't know the encoding of this font. Let's assume `ascii'. */
423 return Qascii;
424 }
425
426 /* Return encoding charset and repertory charset for REGISTRY in
427 ENCODING and REPERTORY correspondingly. If correct information for
428 REGISTRY is available, return 0. Otherwise return -1. */
429
430 int
431 font_registry_charsets (registry, encoding, repertory)
432 Lisp_Object registry;
433 struct charset **encoding, **repertory;
434 {
435 Lisp_Object val;
436 int encoding_id, repertory_id;
437
438 val = Fassoc_string (registry, font_charset_alist, Qt);
439 if (! NILP (val))
440 {
441 val = XCDR (val);
442 if (NILP (val))
443 return -1;
444 encoding_id = XINT (XCAR (val));
445 repertory_id = XINT (XCDR (val));
446 }
447 else
448 {
449 val = find_font_encoding (SYMBOL_NAME (registry));
450 if (SYMBOLP (val) && CHARSETP (val))
451 {
452 encoding_id = repertory_id = XINT (CHARSET_SYMBOL_ID (val));
453 }
454 else if (CONSP (val))
455 {
456 if (! CHARSETP (XCAR (val)))
457 goto invalid_entry;
458 encoding_id = XINT (CHARSET_SYMBOL_ID (XCAR (val)));
459 if (NILP (XCDR (val)))
460 repertory_id = -1;
461 else
462 {
463 if (! CHARSETP (XCDR (val)))
464 goto invalid_entry;
465 repertory_id = XINT (CHARSET_SYMBOL_ID (XCDR (val)));
466 }
467 }
468 else
469 goto invalid_entry;
470 val = Fcons (make_number (encoding_id), make_number (repertory_id));
471 font_charset_alist
472 = nconc2 (font_charset_alist, Fcons (Fcons (registry, val), Qnil));
473 }
474
475 if (encoding)
476 *encoding = CHARSET_FROM_ID (encoding_id);
477 if (repertory)
478 *repertory = repertory_id >= 0 ? CHARSET_FROM_ID (repertory_id) : NULL;
479 return 0;
480
481 invalid_entry:
482 font_charset_alist
483 = nconc2 (font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil));
484 return -1;
485 }
486
487 \f
488 /* Font property value validaters. See the comment of
489 font_property_table for the meaning of the arguments. */
490
491 static Lisp_Object font_prop_validate P_ ((int, Lisp_Object, Lisp_Object));
492 static Lisp_Object font_prop_validate_symbol P_ ((Lisp_Object, Lisp_Object));
493 static Lisp_Object font_prop_validate_style P_ ((Lisp_Object, Lisp_Object));
494 static Lisp_Object font_prop_validate_non_neg P_ ((Lisp_Object, Lisp_Object));
495 static Lisp_Object font_prop_validate_spacing P_ ((Lisp_Object, Lisp_Object));
496 static int get_font_prop_index P_ ((Lisp_Object));
497
498 static Lisp_Object
499 font_prop_validate_symbol (prop, val)
500 Lisp_Object prop, val;
501 {
502 if (STRINGP (val))
503 val = Fintern (val, Qnil);
504 if (! SYMBOLP (val))
505 val = Qerror;
506 else if (EQ (prop, QCregistry))
507 val = Fintern (Fdowncase (SYMBOL_NAME (val)), Qnil);
508 return val;
509 }
510
511
512 static Lisp_Object
513 font_prop_validate_style (style, val)
514 Lisp_Object style, val;
515 {
516 enum font_property_index prop = (EQ (style, QCweight) ? FONT_WEIGHT_INDEX
517 : EQ (style, QCslant) ? FONT_SLANT_INDEX
518 : FONT_WIDTH_INDEX);
519 int n;
520 if (INTEGERP (val))
521 {
522 n = XINT (val);
523 if (((n >> 4) & 0xF)
524 >= ASIZE (AREF (font_style_table, prop - FONT_WEIGHT_INDEX)))
525 val = Qerror;
526 else
527 {
528 Lisp_Object elt = AREF (AREF (font_style_table, prop - FONT_WEIGHT_INDEX), (n >> 4) & 0xF);
529
530 if ((n & 0xF) + 1 >= ASIZE (elt))
531 val = Qerror;
532 else if (XINT (AREF (elt, 0)) != (n >> 8))
533 val = Qerror;
534 }
535 }
536 else if (SYMBOLP (val))
537 {
538 int n = font_style_to_value (prop, val, 0);
539
540 val = n >= 0 ? make_number (n) : Qerror;
541 }
542 else
543 val = Qerror;
544 return val;
545 }
546
547 static Lisp_Object
548 font_prop_validate_non_neg (prop, val)
549 Lisp_Object prop, val;
550 {
551 return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0)
552 ? val : Qerror);
553 }
554
555 static Lisp_Object
556 font_prop_validate_spacing (prop, val)
557 Lisp_Object prop, val;
558 {
559 if (NILP (val) || (NATNUMP (val) && XINT (val) <= FONT_SPACING_CHARCELL))
560 return val;
561 if (SYMBOLP (val) && SBYTES (SYMBOL_NAME (val)) == 1)
562 {
563 char spacing = SDATA (SYMBOL_NAME (val))[0];
564
565 if (spacing == 'c' || spacing == 'C')
566 return make_number (FONT_SPACING_CHARCELL);
567 if (spacing == 'm' || spacing == 'M')
568 return make_number (FONT_SPACING_MONO);
569 if (spacing == 'p' || spacing == 'P')
570 return make_number (FONT_SPACING_PROPORTIONAL);
571 if (spacing == 'd' || spacing == 'D')
572 return make_number (FONT_SPACING_DUAL);
573 }
574 return Qerror;
575 }
576
577 static Lisp_Object
578 font_prop_validate_otf (prop, val)
579 Lisp_Object prop, val;
580 {
581 Lisp_Object tail, tmp;
582 int i;
583
584 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
585 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
586 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
587 if (! CONSP (val))
588 return Qerror;
589 if (! SYMBOLP (XCAR (val)))
590 return Qerror;
591 tail = XCDR (val);
592 if (NILP (tail))
593 return val;
594 if (! CONSP (tail) || ! SYMBOLP (XCAR (val)))
595 return Qerror;
596 for (i = 0; i < 2; i++)
597 {
598 tail = XCDR (tail);
599 if (NILP (tail))
600 return val;
601 if (! CONSP (tail))
602 return Qerror;
603 for (tmp = XCAR (tail); CONSP (tmp); tmp = XCDR (tmp))
604 if (! SYMBOLP (XCAR (tmp)))
605 return Qerror;
606 if (! NILP (tmp))
607 return Qerror;
608 }
609 return val;
610 }
611
612 /* Structure of known font property keys and validater of the
613 values. */
614 struct
615 {
616 /* Pointer to the key symbol. */
617 Lisp_Object *key;
618 /* Function to validate PROP's value VAL, or NULL if any value is
619 ok. The value is VAL or its regularized value if VAL is valid,
620 and Qerror if not. */
621 Lisp_Object (*validater) P_ ((Lisp_Object prop, Lisp_Object val));
622 } font_property_table[] =
623 { { &QCtype, font_prop_validate_symbol },
624 { &QCfoundry, font_prop_validate_symbol },
625 { &QCfamily, font_prop_validate_symbol },
626 { &QCadstyle, font_prop_validate_symbol },
627 { &QCregistry, font_prop_validate_symbol },
628 { &QCweight, font_prop_validate_style },
629 { &QCslant, font_prop_validate_style },
630 { &QCwidth, font_prop_validate_style },
631 { &QCsize, font_prop_validate_non_neg },
632 { &QCdpi, font_prop_validate_non_neg },
633 { &QCspacing, font_prop_validate_spacing },
634 { &QCavgwidth, font_prop_validate_non_neg },
635 /* The order of the above entries must match with enum
636 font_property_index. */
637 { &QClang, font_prop_validate_symbol },
638 { &QCscript, font_prop_validate_symbol },
639 { &QCotf, font_prop_validate_otf }
640 };
641
642 /* Size (number of elements) of the above table. */
643 #define FONT_PROPERTY_TABLE_SIZE \
644 ((sizeof font_property_table) / (sizeof *font_property_table))
645
646 /* Return an index number of font property KEY or -1 if KEY is not an
647 already known property. */
648
649 static int
650 get_font_prop_index (key)
651 Lisp_Object key;
652 {
653 int i;
654
655 for (i = 0; i < FONT_PROPERTY_TABLE_SIZE; i++)
656 if (EQ (key, *font_property_table[i].key))
657 return i;
658 return -1;
659 }
660
661 /* Validate the font property. The property key is specified by the
662 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
663 signal an error. The value is VAL or the regularized one. */
664
665 static Lisp_Object
666 font_prop_validate (idx, prop, val)
667 int idx;
668 Lisp_Object prop, val;
669 {
670 Lisp_Object validated;
671
672 if (NILP (val))
673 return val;
674 if (NILP (prop))
675 prop = *font_property_table[idx].key;
676 else
677 {
678 idx = get_font_prop_index (prop);
679 if (idx < 0)
680 return val;
681 }
682 validated = (font_property_table[idx].validater) (prop, val);
683 if (EQ (validated, Qerror))
684 signal_error ("invalid font property", Fcons (prop, val));
685 return validated;
686 }
687
688
689 /* Store VAL as a value of extra font property PROP in FONT while
690 keeping the sorting order. Don't check the validity of VAL. */
691
692 Lisp_Object
693 font_put_extra (font, prop, val)
694 Lisp_Object font, prop, val;
695 {
696 Lisp_Object extra = AREF (font, FONT_EXTRA_INDEX);
697 Lisp_Object slot = (NILP (extra) ? Qnil : assq_no_quit (prop, extra));
698
699 if (NILP (slot))
700 {
701 Lisp_Object prev = Qnil;
702
703 while (CONSP (extra)
704 && NILP (Fstring_lessp (prop, XCAR (XCAR (extra)))))
705 prev = extra, extra = XCDR (extra);
706 if (NILP (prev))
707 ASET (font, FONT_EXTRA_INDEX, Fcons (Fcons (prop, val), extra));
708 else
709 XSETCDR (prev, Fcons (Fcons (prop, val), extra));
710 return val;
711 }
712 XSETCDR (slot, val);
713 return val;
714 }
715
716 \f
717 /* Font name parser and unparser */
718
719 static int parse_matrix P_ ((char *));
720 static int font_expand_wildcards P_ ((Lisp_Object *, int));
721 static int font_parse_name P_ ((char *, Lisp_Object));
722
723 /* An enumerator for each field of an XLFD font name. */
724 enum xlfd_field_index
725 {
726 XLFD_FOUNDRY_INDEX,
727 XLFD_FAMILY_INDEX,
728 XLFD_WEIGHT_INDEX,
729 XLFD_SLANT_INDEX,
730 XLFD_SWIDTH_INDEX,
731 XLFD_ADSTYLE_INDEX,
732 XLFD_PIXEL_INDEX,
733 XLFD_POINT_INDEX,
734 XLFD_RESX_INDEX,
735 XLFD_RESY_INDEX,
736 XLFD_SPACING_INDEX,
737 XLFD_AVGWIDTH_INDEX,
738 XLFD_REGISTRY_INDEX,
739 XLFD_ENCODING_INDEX,
740 XLFD_LAST_INDEX
741 };
742
743 /* An enumerator for mask bit corresponding to each XLFD field. */
744 enum xlfd_field_mask
745 {
746 XLFD_FOUNDRY_MASK = 0x0001,
747 XLFD_FAMILY_MASK = 0x0002,
748 XLFD_WEIGHT_MASK = 0x0004,
749 XLFD_SLANT_MASK = 0x0008,
750 XLFD_SWIDTH_MASK = 0x0010,
751 XLFD_ADSTYLE_MASK = 0x0020,
752 XLFD_PIXEL_MASK = 0x0040,
753 XLFD_POINT_MASK = 0x0080,
754 XLFD_RESX_MASK = 0x0100,
755 XLFD_RESY_MASK = 0x0200,
756 XLFD_SPACING_MASK = 0x0400,
757 XLFD_AVGWIDTH_MASK = 0x0800,
758 XLFD_REGISTRY_MASK = 0x1000,
759 XLFD_ENCODING_MASK = 0x2000
760 };
761
762
763 /* Parse P pointing the pixel/point size field of the form
764 `[A B C D]' which specifies a transformation matrix:
765
766 A B 0
767 C D 0
768 0 0 1
769
770 by which all glyphs of the font are transformed. The spec says
771 that scalar value N for the pixel/point size is equivalent to:
772 A = N * resx/resy, B = C = 0, D = N.
773
774 Return the scalar value N if the form is valid. Otherwise return
775 -1. */
776
777 static int
778 parse_matrix (p)
779 char *p;
780 {
781 double matrix[4];
782 char *end;
783 int i;
784
785 for (i = 0, p++; i < 4 && *p && *p != ']'; i++)
786 {
787 if (*p == '~')
788 matrix[i] = - strtod (p + 1, &end);
789 else
790 matrix[i] = strtod (p, &end);
791 p = end;
792 }
793 return (i == 4 ? (int) matrix[3] : -1);
794 }
795
796 /* Expand a wildcard field in FIELD (the first N fields are filled) to
797 multiple fields to fill in all 14 XLFD fields while restring a
798 field position by its contents. */
799
800 static int
801 font_expand_wildcards (field, n)
802 Lisp_Object field[XLFD_LAST_INDEX];
803 int n;
804 {
805 /* Copy of FIELD. */
806 Lisp_Object tmp[XLFD_LAST_INDEX];
807 /* Array of information about where this element can go. Nth
808 element is for Nth element of FIELD. */
809 struct {
810 /* Minimum possible field. */
811 int from;
812 /* Maxinum possible field. */
813 int to;
814 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
815 int mask;
816 } range[XLFD_LAST_INDEX];
817 int i, j;
818 int range_from, range_to;
819 unsigned range_mask;
820
821 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
822 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
823 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
824 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
825 | XLFD_AVGWIDTH_MASK)
826 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
827
828 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
829 field. The value is shifted to left one bit by one in the
830 following loop. */
831 for (i = 0, range_mask = 0; i <= 14 - n; i++)
832 range_mask = (range_mask << 1) | 1;
833
834 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
835 position-based retriction for FIELD[I]. */
836 for (i = 0, range_from = 0, range_to = 14 - n; i < n;
837 i++, range_from++, range_to++, range_mask <<= 1)
838 {
839 Lisp_Object val = field[i];
840
841 tmp[i] = val;
842 if (NILP (val))
843 {
844 /* Wildcard. */
845 range[i].from = range_from;
846 range[i].to = range_to;
847 range[i].mask = range_mask;
848 }
849 else
850 {
851 /* The triplet FROM, TO, and MASK is a value-based
852 retriction for FIELD[I]. */
853 int from, to;
854 unsigned mask;
855
856 if (INTEGERP (val))
857 {
858 int numeric = XINT (val);
859
860 if (i + 1 == n)
861 from = to = XLFD_ENCODING_INDEX,
862 mask = XLFD_ENCODING_MASK;
863 else if (numeric == 0)
864 from = XLFD_PIXEL_INDEX, to = XLFD_AVGWIDTH_INDEX,
865 mask = XLFD_PIXEL_MASK | XLFD_LARGENUM_MASK;
866 else if (numeric <= 48)
867 from = to = XLFD_PIXEL_INDEX,
868 mask = XLFD_PIXEL_MASK;
869 else
870 from = XLFD_POINT_INDEX, to = XLFD_AVGWIDTH_INDEX,
871 mask = XLFD_LARGENUM_MASK;
872 }
873 else if (SBYTES (SYMBOL_NAME (val)) == 0)
874 from = XLFD_FOUNDRY_INDEX, to = XLFD_ADSTYLE_INDEX,
875 mask = XLFD_NULL_MASK;
876 else if (i == 0)
877 from = to = XLFD_FOUNDRY_INDEX, mask = XLFD_FOUNDRY_MASK;
878 else if (i + 1 == n)
879 {
880 Lisp_Object name = SYMBOL_NAME (val);
881
882 if (SDATA (name)[SBYTES (name) - 1] == '*')
883 from = XLFD_REGISTRY_INDEX, to = XLFD_ENCODING_INDEX,
884 mask = XLFD_REGENC_MASK;
885 else
886 from = to = XLFD_ENCODING_INDEX,
887 mask = XLFD_ENCODING_MASK;
888 }
889 else if (range_from <= XLFD_WEIGHT_INDEX
890 && range_to >= XLFD_WEIGHT_INDEX
891 && FONT_WEIGHT_NAME_NUMERIC (val) >= 0)
892 from = to = XLFD_WEIGHT_INDEX, mask = XLFD_WEIGHT_MASK;
893 else if (range_from <= XLFD_SLANT_INDEX
894 && range_to >= XLFD_SLANT_INDEX
895 && FONT_SLANT_NAME_NUMERIC (val) >= 0)
896 from = to = XLFD_SLANT_INDEX, mask = XLFD_SLANT_MASK;
897 else if (range_from <= XLFD_SWIDTH_INDEX
898 && range_to >= XLFD_SWIDTH_INDEX
899 && FONT_WIDTH_NAME_NUMERIC (val) >= 0)
900 from = to = XLFD_SWIDTH_INDEX, mask = XLFD_SWIDTH_MASK;
901 else
902 {
903 if (EQ (val, Qc) || EQ (val, Qm) || EQ (val, Qp) || EQ (val, Qd))
904 from = to = XLFD_SPACING_INDEX, mask = XLFD_SPACING_MASK;
905 else
906 from = XLFD_FOUNDRY_INDEX, to = XLFD_ENCODING_INDEX,
907 mask = XLFD_SYMBOL_MASK;
908 }
909
910 /* Merge position-based and value-based restrictions. */
911 mask &= range_mask;
912 while (from < range_from)
913 mask &= ~(1 << from++);
914 while (from < 14 && ! (mask & (1 << from)))
915 from++;
916 while (to > range_to)
917 mask &= ~(1 << to--);
918 while (to >= 0 && ! (mask & (1 << to)))
919 to--;
920 if (from > to)
921 return -1;
922 range[i].from = from;
923 range[i].to = to;
924 range[i].mask = mask;
925
926 if (from > range_from || to < range_to)
927 {
928 /* The range is narrowed by value-based restrictions.
929 Reflect it to the other fields. */
930
931 /* Following fields should be after FROM. */
932 range_from = from;
933 /* Preceding fields should be before TO. */
934 for (j = i - 1, from--, to--; j >= 0; j--, from--, to--)
935 {
936 /* Check FROM for non-wildcard field. */
937 if (! NILP (tmp[j]) && range[j].from < from)
938 {
939 while (range[j].from < from)
940 range[j].mask &= ~(1 << range[j].from++);
941 while (from < 14 && ! (range[j].mask & (1 << from)))
942 from++;
943 range[j].from = from;
944 }
945 else
946 from = range[j].from;
947 if (range[j].to > to)
948 {
949 while (range[j].to > to)
950 range[j].mask &= ~(1 << range[j].to--);
951 while (to >= 0 && ! (range[j].mask & (1 << to)))
952 to--;
953 range[j].to = to;
954 }
955 else
956 to = range[j].to;
957 if (from > to)
958 return -1;
959 }
960 }
961 }
962 }
963
964 /* Decide all fileds from restrictions in RANGE. */
965 for (i = j = 0; i < n ; i++)
966 {
967 if (j < range[i].from)
968 {
969 if (i == 0 || ! NILP (tmp[i - 1]))
970 /* None of TMP[X] corresponds to Jth field. */
971 return -1;
972 for (; j < range[i].from; j++)
973 field[j] = Qnil;
974 }
975 field[j++] = tmp[i];
976 }
977 if (! NILP (tmp[n - 1]) && j < XLFD_REGISTRY_INDEX)
978 return -1;
979 for (; j < XLFD_LAST_INDEX; j++)
980 field[j] = Qnil;
981 if (INTEGERP (field[XLFD_ENCODING_INDEX]))
982 field[XLFD_ENCODING_INDEX]
983 = Fintern (Fnumber_to_string (field[XLFD_ENCODING_INDEX]), Qnil);
984 return 0;
985 }
986
987
988 #ifdef ENABLE_CHECKING
989 /* Match a 14-field XLFD pattern against a full XLFD font name. */
990 static int
991 font_match_xlfd (char *pattern, char *name)
992 {
993 while (*pattern && *name)
994 {
995 if (*pattern == *name)
996 pattern++;
997 else if (*pattern == '*')
998 if (*name == pattern[1])
999 pattern += 2;
1000 else
1001 ;
1002 else
1003 return 0;
1004 name++;
1005 }
1006 return 1;
1007 }
1008
1009 /* Make sure the font object matches the XLFD font name. */
1010 static int
1011 font_check_xlfd_parse (Lisp_Object font, char *name)
1012 {
1013 char name_check[256];
1014 font_unparse_xlfd (font, 0, name_check, 255);
1015 return font_match_xlfd (name_check, name);
1016 }
1017
1018 #endif
1019
1020
1021 /* Parse NAME (null terminated) as XLFD and store information in FONT
1022 (font-spec or font-entity). Size property of FONT is set as
1023 follows:
1024 specified XLFD fields FONT property
1025 --------------------- -------------
1026 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1027 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1028 POINT_SIZE POINT_SIZE/10 (Lisp float)
1029
1030 If NAME is successfully parsed, return 0. Otherwise return -1.
1031
1032 FONT is usually a font-spec, but when this function is called from
1033 X font backend driver, it is a font-entity. In that case, NAME is
1034 a fully specified XLFD. */
1035
1036 int
1037 font_parse_xlfd (name, font)
1038 char *name;
1039 Lisp_Object font;
1040 {
1041 int len = strlen (name);
1042 int i, j, n;
1043 char *f[XLFD_LAST_INDEX + 1];
1044 Lisp_Object val;
1045 char *p;
1046
1047 if (len > 255)
1048 /* Maximum XLFD name length is 255. */
1049 return -1;
1050 /* Accept "*-.." as a fully specified XLFD. */
1051 if (name[0] == '*' && name[1] == '-')
1052 i = 1, f[XLFD_FOUNDRY_INDEX] = name;
1053 else
1054 i = 0;
1055 for (p = name + i; *p; p++)
1056 if (*p == '-')
1057 {
1058 f[i++] = p + 1;
1059 if (i == XLFD_LAST_INDEX)
1060 break;
1061 }
1062 f[i] = name + len;
1063
1064 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1065 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1066
1067 if (i == XLFD_LAST_INDEX)
1068 {
1069 /* Fully specified XLFD. */
1070 int pixel_size;
1071
1072 ASET (font, FONT_FOUNDRY_INDEX, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX));
1073 ASET (font, FONT_FAMILY_INDEX, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX));
1074 for (i = XLFD_WEIGHT_INDEX, j = FONT_WEIGHT_INDEX;
1075 i <= XLFD_SWIDTH_INDEX; i++, j++)
1076 {
1077 val = INTERN_FIELD_SYM (i);
1078 if (! NILP (val))
1079 {
1080 if ((n = font_style_to_value (j, INTERN_FIELD_SYM (i), 0)) < 0)
1081 return -1;
1082 ASET (font, j, make_number (n));
1083 }
1084 }
1085 ASET (font, FONT_ADSTYLE_INDEX, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX));
1086 if (strcmp (f[XLFD_REGISTRY_INDEX], "*-*") == 0)
1087 ASET (font, FONT_REGISTRY_INDEX, Qnil);
1088 else
1089 ASET (font, FONT_REGISTRY_INDEX,
1090 font_intern_prop (f[XLFD_REGISTRY_INDEX],
1091 f[XLFD_LAST_INDEX] - f[XLFD_REGISTRY_INDEX],
1092 1));
1093 p = f[XLFD_PIXEL_INDEX];
1094 if (*p == '[' && (pixel_size = parse_matrix (p)) >= 0)
1095 ASET (font, FONT_SIZE_INDEX, make_number (pixel_size));
1096 else
1097 {
1098 val = INTERN_FIELD (XLFD_PIXEL_INDEX);
1099 if (INTEGERP (val))
1100 ASET (font, FONT_SIZE_INDEX, val);
1101 else
1102 {
1103 double point_size = -1;
1104
1105 font_assert (FONT_SPEC_P (font));
1106 p = f[XLFD_POINT_INDEX];
1107 if (*p == '[')
1108 point_size = parse_matrix (p);
1109 else if (isdigit (*p))
1110 point_size = atoi (p), point_size /= 10;
1111 if (point_size >= 0)
1112 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
1113 }
1114 }
1115
1116 ASET (font, FONT_DPI_INDEX, INTERN_FIELD (XLFD_RESY_INDEX));
1117 val = INTERN_FIELD (XLFD_SPACING_INDEX);
1118 if (! NILP (val))
1119 {
1120 val = font_prop_validate_spacing (QCspacing, val);
1121 if (! INTEGERP (val))
1122 return -1;
1123 ASET (font, FONT_SPACING_INDEX, val);
1124 }
1125 p = f[XLFD_AVGWIDTH_INDEX];
1126 if (*p == '~')
1127 p++;
1128 ASET (font, FONT_AVGWIDTH_INDEX,
1129 font_intern_prop (p, f[XLFD_REGISTRY_INDEX] - 1 - p, 0));
1130 }
1131 else
1132 {
1133 int wild_card_found = 0;
1134 Lisp_Object prop[XLFD_LAST_INDEX];
1135
1136 if (FONT_ENTITY_P (font))
1137 return -1;
1138 for (j = 0; j < i; j++)
1139 {
1140 if (*f[j] == '*')
1141 {
1142 if (f[j][1] && f[j][1] != '-')
1143 return -1;
1144 prop[j] = Qnil;
1145 wild_card_found = 1;
1146 }
1147 else if (j + 1 < i)
1148 prop[j] = INTERN_FIELD (j);
1149 else
1150 prop[j] = font_intern_prop (f[j], f[i] - f[j], 0);
1151 }
1152 if (! wild_card_found)
1153 return -1;
1154 if (font_expand_wildcards (prop, i) < 0)
1155 return -1;
1156
1157 ASET (font, FONT_FOUNDRY_INDEX, prop[XLFD_FOUNDRY_INDEX]);
1158 ASET (font, FONT_FAMILY_INDEX, prop[XLFD_FAMILY_INDEX]);
1159 for (i = XLFD_WEIGHT_INDEX, j = FONT_WEIGHT_INDEX;
1160 i <= XLFD_SWIDTH_INDEX; i++, j++)
1161 if (! NILP (prop[i]))
1162 {
1163 if ((n = font_style_to_value (j, prop[i], 1)) < 0)
1164 return -1;
1165 ASET (font, j, make_number (n));
1166 }
1167 ASET (font, FONT_ADSTYLE_INDEX, prop[XLFD_ADSTYLE_INDEX]);
1168 val = prop[XLFD_REGISTRY_INDEX];
1169 if (NILP (val))
1170 {
1171 val = prop[XLFD_ENCODING_INDEX];
1172 if (! NILP (val))
1173 val = concat2 (build_string ("*-"), SYMBOL_NAME (val));
1174 }
1175 else if (NILP (prop[XLFD_ENCODING_INDEX]))
1176 val = concat2 (SYMBOL_NAME (val), build_string ("-*"));
1177 else
1178 val = concat3 (SYMBOL_NAME (val), build_string ("-"),
1179 SYMBOL_NAME (prop[XLFD_ENCODING_INDEX]));
1180 if (! NILP (val))
1181 ASET (font, FONT_REGISTRY_INDEX, Fintern (val, Qnil));
1182
1183 if (INTEGERP (prop[XLFD_PIXEL_INDEX]))
1184 ASET (font, FONT_SIZE_INDEX, prop[XLFD_PIXEL_INDEX]);
1185 else if (INTEGERP (prop[XLFD_POINT_INDEX]))
1186 {
1187 double point_size = XINT (prop[XLFD_POINT_INDEX]);
1188
1189 ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10));
1190 }
1191
1192 if (INTEGERP (prop[XLFD_RESX_INDEX]))
1193 ASET (font, FONT_DPI_INDEX, prop[XLFD_RESY_INDEX]);
1194 if (! NILP (prop[XLFD_SPACING_INDEX]))
1195 {
1196 val = font_prop_validate_spacing (QCspacing,
1197 prop[XLFD_SPACING_INDEX]);
1198 if (! INTEGERP (val))
1199 return -1;
1200 ASET (font, FONT_SPACING_INDEX, val);
1201 }
1202 if (INTEGERP (prop[XLFD_AVGWIDTH_INDEX]))
1203 ASET (font, FONT_AVGWIDTH_INDEX, prop[XLFD_AVGWIDTH_INDEX]);
1204 }
1205
1206 return 0;
1207 }
1208
1209 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1210 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1211 0, use PIXEL_SIZE instead. */
1212
1213 int
1214 font_unparse_xlfd (font, pixel_size, name, nbytes)
1215 Lisp_Object font;
1216 int pixel_size;
1217 char *name;
1218 int nbytes;
1219 {
1220 char *f[XLFD_REGISTRY_INDEX + 1];
1221 Lisp_Object val;
1222 int i, j, len = 0;
1223
1224 font_assert (FONTP (font));
1225
1226 for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX;
1227 i++, j++)
1228 {
1229 if (i == FONT_ADSTYLE_INDEX)
1230 j = XLFD_ADSTYLE_INDEX;
1231 else if (i == FONT_REGISTRY_INDEX)
1232 j = XLFD_REGISTRY_INDEX;
1233 val = AREF (font, i);
1234 if (NILP (val))
1235 {
1236 if (j == XLFD_REGISTRY_INDEX)
1237 f[j] = "*-*", len += 4;
1238 else
1239 f[j] = "*", len += 2;
1240 }
1241 else
1242 {
1243 if (SYMBOLP (val))
1244 val = SYMBOL_NAME (val);
1245 if (j == XLFD_REGISTRY_INDEX
1246 && ! strchr ((char *) SDATA (val), '-'))
1247 {
1248 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1249 if (SDATA (val)[SBYTES (val) - 1] == '*')
1250 {
1251 f[j] = alloca (SBYTES (val) + 3);
1252 sprintf (f[j], "%s-*", SDATA (val));
1253 len += SBYTES (val) + 3;
1254 }
1255 else
1256 {
1257 f[j] = alloca (SBYTES (val) + 4);
1258 sprintf (f[j], "%s*-*", SDATA (val));
1259 len += SBYTES (val) + 4;
1260 }
1261 }
1262 else
1263 f[j] = (char *) SDATA (val), len += SBYTES (val) + 1;
1264 }
1265 }
1266
1267 for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX;
1268 i++, j++)
1269 {
1270 val = font_style_symbolic (font, i, 0);
1271 if (NILP (val))
1272 f[j] = "*", len += 2;
1273 else
1274 {
1275 val = SYMBOL_NAME (val);
1276 f[j] = (char *) SDATA (val), len += SBYTES (val) + 1;
1277 }
1278 }
1279
1280 val = AREF (font, FONT_SIZE_INDEX);
1281 font_assert (NUMBERP (val) || NILP (val));
1282 if (INTEGERP (val))
1283 {
1284 i = XINT (val);
1285 if (i <= 0)
1286 i = pixel_size;
1287 if (i > 0)
1288 {
1289 f[XLFD_PIXEL_INDEX] = alloca (22);
1290 len += sprintf (f[XLFD_PIXEL_INDEX], "%d-*", i) + 1;
1291 }
1292 else
1293 f[XLFD_PIXEL_INDEX] = "*-*", len += 4;
1294 }
1295 else if (FLOATP (val))
1296 {
1297 i = XFLOAT_DATA (val) * 10;
1298 f[XLFD_PIXEL_INDEX] = alloca (12);
1299 len += sprintf (f[XLFD_PIXEL_INDEX], "*-%d", i) + 1;
1300 }
1301 else
1302 f[XLFD_PIXEL_INDEX] = "*-*", len += 4;
1303
1304 if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
1305 {
1306 i = XINT (AREF (font, FONT_DPI_INDEX));
1307 f[XLFD_RESX_INDEX] = alloca (22);
1308 len += sprintf (f[XLFD_RESX_INDEX],
1309 "%d-%d", i, i) + 1;
1310 }
1311 else
1312 f[XLFD_RESX_INDEX] = "*-*", len += 4;
1313 if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
1314 {
1315 int spacing = XINT (AREF (font, FONT_SPACING_INDEX));
1316
1317 f[XLFD_SPACING_INDEX] = (spacing <= FONT_SPACING_PROPORTIONAL ? "p"
1318 : spacing <= FONT_SPACING_DUAL ? "d"
1319 : spacing <= FONT_SPACING_MONO ? "m"
1320 : "c");
1321 len += 2;
1322 }
1323 else
1324 f[XLFD_SPACING_INDEX] = "*", len += 2;
1325 if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
1326 {
1327 f[XLFD_AVGWIDTH_INDEX] = alloca (11);
1328 len += sprintf (f[XLFD_AVGWIDTH_INDEX],
1329 "%d", XINT (AREF (font, FONT_AVGWIDTH_INDEX))) + 1;
1330 }
1331 else
1332 f[XLFD_AVGWIDTH_INDEX] = "*", len += 2;
1333 len++; /* for terminating '\0'. */
1334 if (len >= nbytes)
1335 return -1;
1336 return sprintf (name, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1337 f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
1338 f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
1339 f[XLFD_SWIDTH_INDEX], f[XLFD_ADSTYLE_INDEX],
1340 f[XLFD_PIXEL_INDEX], f[XLFD_RESX_INDEX],
1341 f[XLFD_SPACING_INDEX], f[XLFD_AVGWIDTH_INDEX],
1342 f[XLFD_REGISTRY_INDEX]);
1343 }
1344
1345 /* Parse NAME (null terminated) and store information in FONT
1346 (font-spec or font-entity). NAME is supplied in either the
1347 Fontconfig or GTK font name format. If NAME is successfully
1348 parsed, return 0. Otherwise return -1.
1349
1350 The fontconfig format is
1351
1352 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1353
1354 The GTK format is
1355
1356 FAMILY [PROPS...] [SIZE]
1357
1358 This function tries to guess which format it is. */
1359
1360 int
1361 font_parse_fcname (name, font)
1362 char *name;
1363 Lisp_Object font;
1364 {
1365 char *p, *q;
1366 char *size_beg = NULL, *size_end = NULL;
1367 char *props_beg = NULL, *family_end = NULL;
1368 int len = strlen (name);
1369
1370 if (len == 0)
1371 return -1;
1372
1373 for (p = name; *p; p++)
1374 {
1375 if (*p == '\\' && p[1])
1376 p++;
1377 else if (*p == ':')
1378 {
1379 props_beg = family_end = p;
1380 break;
1381 }
1382 else if (*p == '-')
1383 {
1384 int decimal = 0, size_found = 1;
1385 for (q = p + 1; *q && *q != ':'; q++)
1386 if (! isdigit(*q))
1387 {
1388 if (*q != '.' || decimal)
1389 {
1390 size_found = 0;
1391 break;
1392 }
1393 decimal = 1;
1394 }
1395 if (size_found)
1396 {
1397 family_end = p;
1398 size_beg = p + 1;
1399 size_end = q;
1400 break;
1401 }
1402 }
1403 }
1404
1405 if (family_end)
1406 {
1407 /* A fontconfig name with size and/or property data. */
1408 if (family_end > name)
1409 {
1410 Lisp_Object family;
1411 family = font_intern_prop (name, family_end - name, 1);
1412 ASET (font, FONT_FAMILY_INDEX, family);
1413 }
1414 if (size_beg)
1415 {
1416 double point_size = strtod (size_beg, &size_end);
1417 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
1418 if (*size_end == ':' && size_end[1])
1419 props_beg = size_end;
1420 }
1421 if (props_beg)
1422 {
1423 /* Now parse ":KEY=VAL" patterns. */
1424 Lisp_Object val;
1425
1426 for (p = props_beg; *p; p = q)
1427 {
1428 for (q = p + 1; *q && *q != '=' && *q != ':'; q++);
1429 if (*q != '=')
1430 {
1431 /* Must be an enumerated value. */
1432 int word_len;
1433 p = p + 1;
1434 word_len = q - p;
1435 val = font_intern_prop (p, q - p, 1);
1436
1437 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1438
1439 if (PROP_MATCH ("light", 5)
1440 || PROP_MATCH ("medium", 6)
1441 || PROP_MATCH ("demibold", 8)
1442 || PROP_MATCH ("bold", 4)
1443 || PROP_MATCH ("black", 5))
1444 FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, val);
1445 else if (PROP_MATCH ("roman", 5)
1446 || PROP_MATCH ("italic", 6)
1447 || PROP_MATCH ("oblique", 7))
1448 FONT_SET_STYLE (font, FONT_SLANT_INDEX, val);
1449 else if (PROP_MATCH ("charcell", 8))
1450 ASET (font, FONT_SPACING_INDEX,
1451 make_number (FONT_SPACING_CHARCELL));
1452 else if (PROP_MATCH ("mono", 4))
1453 ASET (font, FONT_SPACING_INDEX,
1454 make_number (FONT_SPACING_MONO));
1455 else if (PROP_MATCH ("proportional", 12))
1456 ASET (font, FONT_SPACING_INDEX,
1457 make_number (FONT_SPACING_PROPORTIONAL));
1458 #undef PROP_MATCH
1459 }
1460 else
1461 {
1462 /* KEY=VAL pairs */
1463 Lisp_Object key;
1464 int prop;
1465
1466 if (q - p == 10 && memcmp (p + 1, "pixelsize", 9) == 0)
1467 prop = FONT_SIZE_INDEX;
1468 else
1469 {
1470 key = font_intern_prop (p, q - p, 1);
1471 prop = get_font_prop_index (key);
1472 }
1473
1474 p = q + 1;
1475 for (q = p; *q && *q != ':'; q++);
1476 val = font_intern_prop (p, q - p, 0);
1477
1478 if (prop >= FONT_FOUNDRY_INDEX
1479 && prop < FONT_EXTRA_INDEX)
1480 ASET (font, prop, font_prop_validate (prop, Qnil, val));
1481 else
1482 Ffont_put (font, key, val);
1483 }
1484 p = q;
1485 }
1486 }
1487 }
1488 else
1489 {
1490 /* Either a fontconfig-style name with no size and property
1491 data, or a GTK-style name. */
1492 Lisp_Object prop;
1493 int word_len, prop_found = 0;
1494
1495 for (p = name; *p; p = *q ? q + 1 : q)
1496 {
1497 if (isdigit (*p))
1498 {
1499 int size_found = 1;
1500
1501 for (q = p + 1; *q && *q != ' '; q++)
1502 if (! isdigit (*q))
1503 {
1504 size_found = 0;
1505 break;
1506 }
1507 if (size_found)
1508 {
1509 double point_size = strtod (p, &q);
1510 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
1511 continue;
1512 }
1513 }
1514
1515 for (q = p + 1; *q && *q != ' '; q++)
1516 if (*q == '\\' && q[1])
1517 q++;
1518 word_len = q - p;
1519
1520 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1521
1522 if (PROP_MATCH ("Ultra-Light", 11))
1523 {
1524 prop_found = 1;
1525 prop = font_intern_prop ("ultra-light", 11, 1);
1526 FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
1527 }
1528 else if (PROP_MATCH ("Light", 5))
1529 {
1530 prop_found = 1;
1531 prop = font_intern_prop ("light", 5, 1);
1532 FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
1533 }
1534 else if (PROP_MATCH ("Semi-Bold", 9))
1535 {
1536 prop_found = 1;
1537 prop = font_intern_prop ("semi-bold", 9, 1);
1538 FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
1539 }
1540 else if (PROP_MATCH ("Bold", 4))
1541 {
1542 prop_found = 1;
1543 prop = font_intern_prop ("bold", 4, 1);
1544 FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
1545 }
1546 else if (PROP_MATCH ("Italic", 6))
1547 {
1548 prop_found = 1;
1549 prop = font_intern_prop ("italic", 4, 1);
1550 FONT_SET_STYLE (font, FONT_SLANT_INDEX, prop);
1551 }
1552 else if (PROP_MATCH ("Oblique", 7))
1553 {
1554 prop_found = 1;
1555 prop = font_intern_prop ("oblique", 7, 1);
1556 FONT_SET_STYLE (font, FONT_SLANT_INDEX, prop);
1557 }
1558 else {
1559 if (prop_found)
1560 return -1; /* Unknown property in GTK-style font name. */
1561 family_end = q;
1562 }
1563 }
1564 #undef PROP_MATCH
1565
1566 if (family_end)
1567 {
1568 Lisp_Object family;
1569 family = font_intern_prop (name, family_end - name, 1);
1570 ASET (font, FONT_FAMILY_INDEX, family);
1571 }
1572 }
1573
1574 return 0;
1575 }
1576
1577 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1578 NAME (NBYTES length), and return the name length. If
1579 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1580
1581 int
1582 font_unparse_fcname (font, pixel_size, name, nbytes)
1583 Lisp_Object font;
1584 int pixel_size;
1585 char *name;
1586 int nbytes;
1587 {
1588 Lisp_Object family, foundry;
1589 Lisp_Object tail, val;
1590 int point_size;
1591 int dpi;
1592 int i, len = 1;
1593 char *p;
1594 Lisp_Object styles[3];
1595 char *style_names[3] = { "weight", "slant", "width" };
1596 char work[256];
1597
1598 family = AREF (font, FONT_FAMILY_INDEX);
1599 if (! NILP (family))
1600 {
1601 if (SYMBOLP (family))
1602 {
1603 family = SYMBOL_NAME (family);
1604 len += SBYTES (family);
1605 }
1606 else
1607 family = Qnil;
1608 }
1609
1610 val = AREF (font, FONT_SIZE_INDEX);
1611 if (INTEGERP (val))
1612 {
1613 if (XINT (val) != 0)
1614 pixel_size = XINT (val);
1615 point_size = -1;
1616 len += 21; /* for ":pixelsize=NUM" */
1617 }
1618 else if (FLOATP (val))
1619 {
1620 pixel_size = -1;
1621 point_size = (int) XFLOAT_DATA (val);
1622 len += 11; /* for "-NUM" */
1623 }
1624
1625 foundry = AREF (font, FONT_FOUNDRY_INDEX);
1626 if (! NILP (foundry))
1627 {
1628 if (SYMBOLP (foundry))
1629 {
1630 foundry = SYMBOL_NAME (foundry);
1631 len += 9 + SBYTES (foundry); /* ":foundry=NAME" */
1632 }
1633 else
1634 foundry = Qnil;
1635 }
1636
1637 for (i = 0; i < 3; i++)
1638 {
1639 styles[i] = font_style_symbolic (font, FONT_WEIGHT_INDEX + i, 0);
1640 if (! NILP (styles[i]))
1641 len += sprintf (work, ":%s=%s", style_names[i],
1642 SDATA (SYMBOL_NAME (styles[i])));
1643 }
1644
1645 if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
1646 len += sprintf (work, ":dpi=%d", dpi);
1647 if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
1648 len += strlen (":spacing=100");
1649 if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
1650 len += strlen (":scalable=false"); /* or ":scalable=true" */
1651 for (tail = AREF (font, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
1652 {
1653 Lisp_Object key = XCAR (XCAR (tail)), val = XCDR (XCAR (tail));
1654
1655 len += SBYTES (SYMBOL_NAME (key)) + 1; /* for :KEY= */
1656 if (STRINGP (val))
1657 len += SBYTES (val);
1658 else if (INTEGERP (val))
1659 len += sprintf (work, "%d", XINT (val));
1660 else if (SYMBOLP (val))
1661 len += (NILP (val) ? 5 : 4); /* for "false" or "true" */
1662 }
1663
1664 if (len > nbytes)
1665 return -1;
1666 p = name;
1667 if (! NILP (family))
1668 p += sprintf (p, "%s", SDATA (family));
1669 if (point_size > 0)
1670 {
1671 if (p == name)
1672 p += sprintf (p, "%d", point_size);
1673 else
1674 p += sprintf (p, "-%d", point_size);
1675 }
1676 else if (pixel_size > 0)
1677 p += sprintf (p, ":pixelsize=%d", pixel_size);
1678 if (! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
1679 p += sprintf (p, ":foundry=%s",
1680 SDATA (SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX))));
1681 for (i = 0; i < 3; i++)
1682 if (! NILP (styles[i]))
1683 p += sprintf (p, ":%s=%s", style_names[i],
1684 SDATA (SYMBOL_NAME (styles[i])));
1685 if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
1686 p += sprintf (p, ":dpi=%d", XINT (AREF (font, FONT_DPI_INDEX)));
1687 if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
1688 p += sprintf (p, ":spacing=%d", XINT (AREF (font, FONT_SPACING_INDEX)));
1689 if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
1690 {
1691 if (XINT (AREF (font, FONT_AVGWIDTH_INDEX)) == 0)
1692 p += sprintf (p, ":scalable=true");
1693 else
1694 p += sprintf (p, ":scalable=false");
1695 }
1696 return (p - name);
1697 }
1698
1699 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1700 NAME (NBYTES length), and return the name length. F is the frame
1701 on which the font is displayed; it is used to calculate the point
1702 size. */
1703
1704 int
1705 font_unparse_gtkname (font, f, name, nbytes)
1706 Lisp_Object font;
1707 struct frame *f;
1708 char *name;
1709 int nbytes;
1710 {
1711 char *p;
1712 int len = 1;
1713 Lisp_Object family, weight, slant, size;
1714 int point_size = -1;
1715
1716 family = AREF (font, FONT_FAMILY_INDEX);
1717 if (! NILP (family))
1718 {
1719 if (! SYMBOLP (family))
1720 return -1;
1721 family = SYMBOL_NAME (family);
1722 len += SBYTES (family);
1723 }
1724
1725 weight = font_style_symbolic (font, FONT_WEIGHT_INDEX, 0);
1726 if (EQ (weight, Qnormal))
1727 weight = Qnil;
1728 else if (! NILP (weight))
1729 {
1730 weight = SYMBOL_NAME (weight);
1731 len += SBYTES (weight);
1732 }
1733
1734 slant = font_style_symbolic (font, FONT_SLANT_INDEX, 0);
1735 if (EQ (slant, Qnormal))
1736 slant = Qnil;
1737 else if (! NILP (slant))
1738 {
1739 slant = SYMBOL_NAME (slant);
1740 len += SBYTES (slant);
1741 }
1742
1743 size = AREF (font, FONT_SIZE_INDEX);
1744 /* Convert pixel size to point size. */
1745 if (INTEGERP (size))
1746 {
1747 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
1748 int dpi = 75;
1749 if (INTEGERP (font_dpi))
1750 dpi = XINT (font_dpi);
1751 else if (f)
1752 dpi = f->resy;
1753 point_size = PIXEL_TO_POINT (XINT (size), dpi);
1754 len += 11;
1755 }
1756 else if (FLOATP (size))
1757 {
1758 point_size = (int) XFLOAT_DATA (size);
1759 len += 11;
1760 }
1761
1762 if (len > nbytes)
1763 return -1;
1764
1765 p = name + sprintf (name, "%s", SDATA (family));
1766
1767 if (! NILP (weight))
1768 {
1769 char *q = p;
1770 p += sprintf (p, " %s", SDATA (weight));
1771 q[1] = toupper (q[1]);
1772 }
1773
1774 if (! NILP (slant))
1775 {
1776 char *q = p;
1777 p += sprintf (p, " %s", SDATA (slant));
1778 q[1] = toupper (q[1]);
1779 }
1780
1781 if (point_size > 0)
1782 p += sprintf (p, " %d", point_size);
1783
1784 return (p - name);
1785 }
1786
1787 /* Parse NAME (null terminated) and store information in FONT
1788 (font-spec or font-entity). If NAME is successfully parsed, return
1789 0. Otherwise return -1. */
1790
1791 static int
1792 font_parse_name (name, font)
1793 char *name;
1794 Lisp_Object font;
1795 {
1796 if (name[0] == '-' || index (name, '*'))
1797 return font_parse_xlfd (name, font);
1798 return font_parse_fcname (name, font);
1799 }
1800
1801
1802 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1803 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1804 part. */
1805
1806 void
1807 font_parse_family_registry (family, registry, font_spec)
1808 Lisp_Object family, registry, font_spec;
1809 {
1810 int len;
1811 char *p0, *p1;
1812
1813 if (! NILP (family)
1814 && NILP (AREF (font_spec, FONT_FAMILY_INDEX)))
1815 {
1816 CHECK_STRING (family);
1817 len = SBYTES (family);
1818 p0 = (char *) SDATA (family);
1819 p1 = index (p0, '-');
1820 if (p1)
1821 {
1822 if ((*p0 != '*' || p1 - p0 > 1)
1823 && NILP (AREF (font_spec, FONT_FOUNDRY_INDEX)))
1824 Ffont_put (font_spec, QCfoundry, font_intern_prop (p0, p1 - p0, 1));
1825 p1++;
1826 len -= p1 - p0;
1827 Ffont_put (font_spec, QCfamily, font_intern_prop (p1, len, 1));
1828 }
1829 else
1830 ASET (font_spec, FONT_FAMILY_INDEX, Fintern (family, Qnil));
1831 }
1832 if (! NILP (registry))
1833 {
1834 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1835 CHECK_STRING (registry);
1836 len = SBYTES (registry);
1837 p0 = (char *) SDATA (registry);
1838 p1 = index (p0, '-');
1839 if (! p1)
1840 {
1841 if (SDATA (registry)[len - 1] == '*')
1842 registry = concat2 (registry, build_string ("-*"));
1843 else
1844 registry = concat2 (registry, build_string ("*-*"));
1845 }
1846 registry = Fdowncase (registry);
1847 ASET (font_spec, FONT_REGISTRY_INDEX, Fintern (registry, Qnil));
1848 }
1849 }
1850
1851 \f
1852 /* This part (through the next ^L) is still experimental and not
1853 tested much. We may drastically change codes. */
1854
1855 /* OTF handler */
1856
1857 #if 0
1858
1859 #define LGSTRING_HEADER_SIZE 6
1860 #define LGSTRING_GLYPH_SIZE 8
1861
1862 static int
1863 check_gstring (gstring)
1864 Lisp_Object gstring;
1865 {
1866 Lisp_Object val;
1867 int i, j;
1868
1869 CHECK_VECTOR (gstring);
1870 val = AREF (gstring, 0);
1871 CHECK_VECTOR (val);
1872 if (ASIZE (val) < LGSTRING_HEADER_SIZE)
1873 goto err;
1874 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
1875 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
1876 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
1877 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
1878 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
1879 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
1880 CHECK_NATNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
1881 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
1882 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
1883 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
1884 CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
1885
1886 for (i = 0; i < LGSTRING_LENGTH (gstring); i++)
1887 {
1888 val = LGSTRING_GLYPH (gstring, i);
1889 CHECK_VECTOR (val);
1890 if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
1891 goto err;
1892 if (NILP (AREF (val, LGLYPH_IX_CHAR)))
1893 break;
1894 CHECK_NATNUM (AREF (val, LGLYPH_IX_FROM));
1895 CHECK_NATNUM (AREF (val, LGLYPH_IX_TO));
1896 CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
1897 if (!NILP (AREF (val, LGLYPH_IX_CODE)))
1898 CHECK_NATNUM (AREF (val, LGLYPH_IX_CODE));
1899 if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
1900 CHECK_NATNUM (AREF (val, LGLYPH_IX_WIDTH));
1901 if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
1902 {
1903 val = AREF (val, LGLYPH_IX_ADJUSTMENT);
1904 CHECK_VECTOR (val);
1905 if (ASIZE (val) < 3)
1906 goto err;
1907 for (j = 0; j < 3; j++)
1908 CHECK_NUMBER (AREF (val, j));
1909 }
1910 }
1911 return i;
1912 err:
1913 error ("Invalid glyph-string format");
1914 return -1;
1915 }
1916
1917 static void
1918 check_otf_features (otf_features)
1919 Lisp_Object otf_features;
1920 {
1921 Lisp_Object val;
1922
1923 CHECK_CONS (otf_features);
1924 CHECK_SYMBOL (XCAR (otf_features));
1925 otf_features = XCDR (otf_features);
1926 CHECK_CONS (otf_features);
1927 CHECK_SYMBOL (XCAR (otf_features));
1928 otf_features = XCDR (otf_features);
1929 for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
1930 {
1931 CHECK_SYMBOL (Fcar (val));
1932 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1933 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val)));
1934 }
1935 otf_features = XCDR (otf_features);
1936 for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
1937 {
1938 CHECK_SYMBOL (Fcar (val));
1939 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1940 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val)));
1941 }
1942 }
1943
1944 #ifdef HAVE_LIBOTF
1945 #include <otf.h>
1946
1947 Lisp_Object otf_list;
1948
1949 static Lisp_Object
1950 otf_tag_symbol (tag)
1951 OTF_Tag tag;
1952 {
1953 char name[5];
1954
1955 OTF_tag_name (tag, name);
1956 return Fintern (make_unibyte_string (name, 4), Qnil);
1957 }
1958
1959 static OTF *
1960 otf_open (file)
1961 Lisp_Object file;
1962 {
1963 Lisp_Object val = Fassoc (file, otf_list);
1964 OTF *otf;
1965
1966 if (! NILP (val))
1967 otf = XSAVE_VALUE (XCDR (val))->pointer;
1968 else
1969 {
1970 otf = STRINGP (file) ? OTF_open ((char *) SDATA (file)) : NULL;
1971 val = make_save_value (otf, 0);
1972 otf_list = Fcons (Fcons (file, val), otf_list);
1973 }
1974 return otf;
1975 }
1976
1977
1978 /* Return a list describing which scripts/languages FONT supports by
1979 which GSUB/GPOS features of OpenType tables. See the comment of
1980 (struct font_driver).otf_capability. */
1981
1982 Lisp_Object
1983 font_otf_capability (font)
1984 struct font *font;
1985 {
1986 OTF *otf;
1987 Lisp_Object capability = Fcons (Qnil, Qnil);
1988 int i;
1989
1990 otf = otf_open (font->props[FONT_FILE_INDEX]);
1991 if (! otf)
1992 return Qnil;
1993 for (i = 0; i < 2; i++)
1994 {
1995 OTF_GSUB_GPOS *gsub_gpos;
1996 Lisp_Object script_list = Qnil;
1997 int j;
1998
1999 if (OTF_get_features (otf, i == 0) < 0)
2000 continue;
2001 gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
2002 for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
2003 {
2004 OTF_Script *script = gsub_gpos->ScriptList.Script + j;
2005 Lisp_Object langsys_list = Qnil;
2006 Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
2007 int k;
2008
2009 for (k = script->LangSysCount; k >= 0; k--)
2010 {
2011 OTF_LangSys *langsys;
2012 Lisp_Object feature_list = Qnil;
2013 Lisp_Object langsys_tag;
2014 int l;
2015
2016 if (k == script->LangSysCount)
2017 {
2018 langsys = &script->DefaultLangSys;
2019 langsys_tag = Qnil;
2020 }
2021 else
2022 {
2023 langsys = script->LangSys + k;
2024 langsys_tag
2025 = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
2026 }
2027 for (l = langsys->FeatureCount - 1; l >= 0; l--)
2028 {
2029 OTF_Feature *feature
2030 = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
2031 Lisp_Object feature_tag
2032 = otf_tag_symbol (feature->FeatureTag);
2033
2034 feature_list = Fcons (feature_tag, feature_list);
2035 }
2036 langsys_list = Fcons (Fcons (langsys_tag, feature_list),
2037 langsys_list);
2038 }
2039 script_list = Fcons (Fcons (script_tag, langsys_list),
2040 script_list);
2041 }
2042
2043 if (i == 0)
2044 XSETCAR (capability, script_list);
2045 else
2046 XSETCDR (capability, script_list);
2047 }
2048
2049 return capability;
2050 }
2051
2052 /* Parse OTF features in SPEC and write a proper features spec string
2053 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2054 assured that the sufficient memory has already allocated for
2055 FEATURES. */
2056
2057 static void
2058 generate_otf_features (spec, features)
2059 Lisp_Object spec;
2060 char *features;
2061 {
2062 Lisp_Object val;
2063 char *p;
2064 int asterisk;
2065
2066 p = features;
2067 *p = '\0';
2068 for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
2069 {
2070 val = XCAR (spec);
2071 CHECK_SYMBOL (val);
2072 if (p > features)
2073 *p++ = ',';
2074 if (SREF (SYMBOL_NAME (val), 0) == '*')
2075 {
2076 asterisk = 1;
2077 *p++ = '*';
2078 }
2079 else if (! asterisk)
2080 {
2081 val = SYMBOL_NAME (val);
2082 p += sprintf (p, "%s", SDATA (val));
2083 }
2084 else
2085 {
2086 val = SYMBOL_NAME (val);
2087 p += sprintf (p, "~%s", SDATA (val));
2088 }
2089 }
2090 if (CONSP (spec))
2091 error ("OTF spec too long");
2092 }
2093
2094 Lisp_Object
2095 font_otf_DeviceTable (device_table)
2096 OTF_DeviceTable *device_table;
2097 {
2098 int len = device_table->StartSize - device_table->EndSize + 1;
2099
2100 return Fcons (make_number (len),
2101 make_unibyte_string (device_table->DeltaValue, len));
2102 }
2103
2104 Lisp_Object
2105 font_otf_ValueRecord (value_format, value_record)
2106 int value_format;
2107 OTF_ValueRecord *value_record;
2108 {
2109 Lisp_Object val = Fmake_vector (make_number (8), Qnil);
2110
2111 if (value_format & OTF_XPlacement)
2112 ASET (val, 0, make_number (value_record->XPlacement));
2113 if (value_format & OTF_YPlacement)
2114 ASET (val, 1, make_number (value_record->YPlacement));
2115 if (value_format & OTF_XAdvance)
2116 ASET (val, 2, make_number (value_record->XAdvance));
2117 if (value_format & OTF_YAdvance)
2118 ASET (val, 3, make_number (value_record->YAdvance));
2119 if (value_format & OTF_XPlaDevice)
2120 ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
2121 if (value_format & OTF_YPlaDevice)
2122 ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
2123 if (value_format & OTF_XAdvDevice)
2124 ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
2125 if (value_format & OTF_YAdvDevice)
2126 ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
2127 return val;
2128 }
2129
2130 Lisp_Object
2131 font_otf_Anchor (anchor)
2132 OTF_Anchor *anchor;
2133 {
2134 Lisp_Object val;
2135
2136 val = Fmake_vector (make_number (anchor->AnchorFormat + 1), Qnil);
2137 ASET (val, 0, make_number (anchor->XCoordinate));
2138 ASET (val, 1, make_number (anchor->YCoordinate));
2139 if (anchor->AnchorFormat == 2)
2140 ASET (val, 2, make_number (anchor->f.f1.AnchorPoint));
2141 else
2142 {
2143 ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
2144 ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
2145 }
2146 return val;
2147 }
2148 #endif /* HAVE_LIBOTF */
2149 #endif /* 0 */
2150
2151 /* G-string (glyph string) handler */
2152
2153 /* G-string is a vector of the form [HEADER GLYPH ...].
2154 See the docstring of `font-make-gstring' for more detail. */
2155
2156 struct font *
2157 font_prepare_composition (cmp, f)
2158 struct composition *cmp;
2159 FRAME_PTR f;
2160 {
2161 Lisp_Object gstring
2162 = AREF (XHASH_TABLE (composition_hash_table)->key_and_value,
2163 cmp->hash_index * 2);
2164
2165 cmp->font = XFONT_OBJECT (LGSTRING_FONT (gstring));
2166 cmp->glyph_len = LGSTRING_LENGTH (gstring);
2167 cmp->pixel_width = LGSTRING_WIDTH (gstring);
2168 cmp->lbearing = LGSTRING_LBEARING (gstring);
2169 cmp->rbearing = LGSTRING_RBEARING (gstring);
2170 cmp->ascent = LGSTRING_ASCENT (gstring);
2171 cmp->descent = LGSTRING_DESCENT (gstring);
2172 cmp->width = cmp->pixel_width / FRAME_COLUMN_WIDTH (f);
2173 if (cmp->width == 0)
2174 cmp->width = 1;
2175
2176 return cmp->font;
2177 }
2178
2179 \f
2180 /* Font sorting */
2181
2182 static unsigned font_score P_ ((Lisp_Object, Lisp_Object *));
2183 static int font_compare P_ ((const void *, const void *));
2184 static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object,
2185 Lisp_Object, int));
2186
2187 /* We sort fonts by scoring each of them against a specified
2188 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2189 the value is, the closer the font is to the font-spec.
2190
2191 The lowest 2 bits of the score is used for driver type. The font
2192 available by the most preferred font driver is 0.
2193
2194 Each 7-bit in the higher 28 bits are used for numeric properties
2195 WEIGHT, SLANT, WIDTH, and SIZE. */
2196
2197 /* How many bits to shift to store the difference value of each font
2198 property in a score. Note that flots for FONT_TYPE_INDEX and
2199 FONT_REGISTRY_INDEX are not used. */
2200 static int sort_shift_bits[FONT_SIZE_INDEX + 1];
2201
2202 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2203 The return value indicates how different ENTITY is compared with
2204 SPEC_PROP. */
2205
2206 static unsigned
2207 font_score (entity, spec_prop)
2208 Lisp_Object entity, *spec_prop;
2209 {
2210 unsigned score = 0;
2211 int i;
2212
2213 /* Score three style numeric fields. Maximum difference is 127. */
2214 for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
2215 if (! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i]))
2216 {
2217 int diff = (XINT (AREF (entity, i)) >> 8) - (XINT (spec_prop[i]) >> 8);
2218
2219 if (diff < 0)
2220 diff = - diff;
2221 if (diff > 0)
2222 score |= min (diff, 127) << sort_shift_bits[i];
2223 }
2224
2225 /* Score the size. Maximum difference is 127. */
2226 i = FONT_SIZE_INDEX;
2227 if (! NILP (spec_prop[i]) && XINT (AREF (entity, i)) > 0)
2228 {
2229 /* We use the higher 6-bit for the actual size difference. The
2230 lowest bit is set if the DPI is different. */
2231 int diff = XINT (spec_prop[i]) - XINT (AREF (entity, i));
2232
2233 if (diff < 0)
2234 diff = - diff;
2235 diff <<= 1;
2236 if (! NILP (spec_prop[FONT_DPI_INDEX])
2237 && ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
2238 diff |= 1;
2239 score |= min (diff, 127) << sort_shift_bits[FONT_SIZE_INDEX];
2240 }
2241
2242 return score;
2243 }
2244
2245
2246 /* The comparison function for qsort. */
2247
2248 static int
2249 font_compare (d1, d2)
2250 const void *d1, *d2;
2251 {
2252 return (*(unsigned *) d1 - *(unsigned *) d2);
2253 }
2254
2255
2256 /* The structure for elements being sorted by qsort. */
2257 struct font_sort_data
2258 {
2259 unsigned score;
2260 Lisp_Object entity;
2261 };
2262
2263
2264 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2265 If PREFER specifies a point-size, calculate the corresponding
2266 pixel-size from QCdpi property of PREFER or from the Y-resolution
2267 of FRAME before sorting.
2268
2269 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2270 return the sorted VEC. */
2271
2272 static Lisp_Object
2273 font_sort_entites (vec, prefer, frame, best_only)
2274 Lisp_Object vec, prefer, frame;
2275 int best_only;
2276 {
2277 Lisp_Object prefer_prop[FONT_SPEC_MAX];
2278 int len, i;
2279 struct font_sort_data *data;
2280 unsigned best_score;
2281 Lisp_Object best_entity, driver_type;
2282 int driver_order;
2283 struct frame *f = XFRAME (frame);
2284 struct font_driver_list *list;
2285 USE_SAFE_ALLOCA;
2286
2287 len = ASIZE (vec);
2288 if (len <= 1)
2289 return best_only ? AREF (vec, 0) : vec;
2290
2291 for (i = FONT_WEIGHT_INDEX; i <= FONT_DPI_INDEX; i++)
2292 prefer_prop[i] = AREF (prefer, i);
2293 if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
2294 prefer_prop[FONT_SIZE_INDEX]
2295 = make_number (font_pixel_size (XFRAME (frame), prefer));
2296
2297 /* Scoring and sorting. */
2298 SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len);
2299 best_score = 0xFFFFFFFF;
2300 /* We are sure that the length of VEC > 1. */
2301 driver_type = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
2302 for (driver_order = 0, list = f->font_driver_list; list;
2303 driver_order++, list = list->next)
2304 if (EQ (driver_type, list->driver->type))
2305 break;
2306 best_entity = data[0].entity = AREF (vec, 0);
2307 best_score = data[0].score
2308 = font_score (data[0].entity, prefer_prop) | driver_order;
2309 for (i = 0; i < len; i++)
2310 {
2311 if (!EQ (driver_type, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
2312 for (driver_order = 0, list = f->font_driver_list; list;
2313 driver_order++, list = list->next)
2314 if (EQ (driver_type, list->driver->type))
2315 break;
2316 data[i].entity = AREF (vec, i);
2317 data[i].score = font_score (data[i].entity, prefer_prop) | driver_order;
2318 if (best_only && best_score > data[i].score)
2319 {
2320 best_score = data[i].score;
2321 best_entity = data[i].entity;
2322 if (best_score == 0)
2323 break;
2324 }
2325 }
2326 if (! best_only)
2327 {
2328 qsort (data, len, sizeof *data, font_compare);
2329 for (i = 0; i < len; i++)
2330 ASET (vec, i, data[i].entity);
2331 }
2332 else
2333 vec = best_entity;
2334 SAFE_FREE ();
2335
2336 font_add_log ("sort-by", prefer, vec);
2337 return vec;
2338 }
2339
2340 \f
2341 /* API of Font Service Layer. */
2342
2343 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2344 sort_shift_bits. Finternal_set_font_selection_order calls this
2345 function with font_sort_order after setting up it. */
2346
2347 void
2348 font_update_sort_order (order)
2349 int *order;
2350 {
2351 int i, shift_bits;
2352
2353 for (i = 0, shift_bits = 23; i < 4; i++, shift_bits -= 7)
2354 {
2355 int xlfd_idx = order[i];
2356
2357 if (xlfd_idx == XLFD_WEIGHT_INDEX)
2358 sort_shift_bits[FONT_WEIGHT_INDEX] = shift_bits;
2359 else if (xlfd_idx == XLFD_SLANT_INDEX)
2360 sort_shift_bits[FONT_SLANT_INDEX] = shift_bits;
2361 else if (xlfd_idx == XLFD_SWIDTH_INDEX)
2362 sort_shift_bits[FONT_WIDTH_INDEX] = shift_bits;
2363 else
2364 sort_shift_bits[FONT_SIZE_INDEX] = shift_bits;
2365 }
2366 }
2367
2368 static int
2369 font_check_otf_features (script, langsys, features, table)
2370 Lisp_Object script, langsys, features, table;
2371 {
2372 Lisp_Object val;
2373 int negative;
2374
2375 table = assq_no_quit (script, table);
2376 if (NILP (table))
2377 return 0;
2378 table = XCDR (table);
2379 if (! NILP (langsys))
2380 {
2381 table = assq_no_quit (langsys, table);
2382 if (NILP (table))
2383 return 0;
2384 }
2385 else
2386 {
2387 val = assq_no_quit (Qnil, table);
2388 if (NILP (val))
2389 table = XCAR (table);
2390 else
2391 table = val;
2392 }
2393 table = XCDR (table);
2394 for (negative = 0; CONSP (features); features = XCDR (features))
2395 {
2396 if (NILP (XCAR (features)))
2397 negative = 1;
2398 if (NILP (Fmemq (XCAR (features), table)) != negative)
2399 return 0;
2400 }
2401 return 1;
2402 }
2403
2404 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2405
2406 static int
2407 font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
2408 {
2409 Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
2410
2411 script = XCAR (spec);
2412 spec = XCDR (spec);
2413 if (! NILP (spec))
2414 {
2415 langsys = XCAR (spec);
2416 spec = XCDR (spec);
2417 if (! NILP (spec))
2418 {
2419 gsub = XCAR (spec);
2420 spec = XCDR (spec);
2421 if (! NILP (spec))
2422 gpos = XCAR (spec);
2423 }
2424 }
2425
2426 if (! NILP (gsub) && ! font_check_otf_features (script, langsys, gsub,
2427 XCAR (otf_capability)))
2428 return 0;
2429 if (! NILP (gpos) && ! font_check_otf_features (script, langsys, gpos,
2430 XCDR (otf_capability)))
2431 return 0;
2432 return 1;
2433 }
2434
2435
2436
2437 /* Check if FONT (font-entity or font-object) matches with the font
2438 specification SPEC. */
2439
2440 int
2441 font_match_p (spec, font)
2442 Lisp_Object spec, font;
2443 {
2444 Lisp_Object prop[FONT_SPEC_MAX], *props;
2445 Lisp_Object extra, font_extra;
2446 int i;
2447
2448 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
2449 if (! NILP (AREF (spec, i))
2450 && ! NILP (AREF (font, i))
2451 && ! EQ (AREF (spec, i), AREF (font, i)))
2452 return 0;
2453 props = XFONT_SPEC (spec)->props;
2454 if (FLOATP (props[FONT_SIZE_INDEX]))
2455 {
2456 for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++)
2457 prop[i] = AREF (spec, i);
2458 prop[FONT_SIZE_INDEX]
2459 = make_number (font_pixel_size (XFRAME (selected_frame), spec));
2460 props = prop;
2461 }
2462
2463 if (font_score (font, props) > 0)
2464 return 0;
2465 extra = AREF (spec, FONT_EXTRA_INDEX);
2466 font_extra = AREF (font, FONT_EXTRA_INDEX);
2467 for (; CONSP (extra); extra = XCDR (extra))
2468 {
2469 Lisp_Object key = XCAR (XCAR (extra));
2470 Lisp_Object val = XCDR (XCAR (extra)), val2;
2471
2472 if (EQ (key, QClang))
2473 {
2474 val2 = assq_no_quit (key, font_extra);
2475 if (NILP (val2))
2476 return 0;
2477 val2 = XCDR (val2);
2478 if (CONSP (val))
2479 {
2480 if (! CONSP (val2))
2481 return 0;
2482 while (CONSP (val))
2483 if (NILP (Fmemq (val, val2)))
2484 return 0;
2485 }
2486 else
2487 if (CONSP (val2)
2488 ? NILP (Fmemq (val, XCDR (val2)))
2489 : ! EQ (val, val2))
2490 return 0;
2491 }
2492 else if (EQ (key, QCscript))
2493 {
2494 val2 = assq_no_quit (val, Vscript_representative_chars);
2495 if (! NILP (val2))
2496 for (val2 = XCDR (val2); CONSP (val2); val2 = XCDR (val2))
2497 if (font_encode_char (font, XINT (XCAR (val2)))
2498 == FONT_INVALID_CODE)
2499 return 0;
2500 }
2501 else if (EQ (key, QCotf))
2502 {
2503 struct font *fontp;
2504
2505 if (! FONT_OBJECT_P (font))
2506 return 0;
2507 fontp = XFONT_OBJECT (font);
2508 if (! fontp->driver->otf_capability)
2509 return 0;
2510 val2 = fontp->driver->otf_capability (fontp);
2511 if (NILP (val2) || ! font_check_otf (val, val2))
2512 return 0;
2513 }
2514 }
2515
2516 return 1;
2517 }
2518 \f
2519
2520 /* Font cache
2521
2522 Each font backend has the callback function get_cache, and it
2523 returns a cons cell of which cdr part can be freely used for
2524 caching fonts. The cons cell may be shared by multiple frames
2525 and/or multiple font drivers. So, we arrange the cdr part as this:
2526
2527 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2528
2529 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2530 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2531 cons (FONT-SPEC FONT-ENTITY ...). */
2532
2533 static void font_prepare_cache P_ ((FRAME_PTR, struct font_driver *));
2534 static void font_finish_cache P_ ((FRAME_PTR, struct font_driver *));
2535 static Lisp_Object font_get_cache P_ ((FRAME_PTR, struct font_driver *));
2536 static void font_clear_cache P_ ((FRAME_PTR, Lisp_Object,
2537 struct font_driver *));
2538
2539 static void
2540 font_prepare_cache (f, driver)
2541 FRAME_PTR f;
2542 struct font_driver *driver;
2543 {
2544 Lisp_Object cache, val;
2545
2546 cache = driver->get_cache (f);
2547 val = XCDR (cache);
2548 while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
2549 val = XCDR (val);
2550 if (NILP (val))
2551 {
2552 val = Fcons (driver->type, Fcons (make_number (1), Qnil));
2553 XSETCDR (cache, Fcons (val, XCDR (cache)));
2554 }
2555 else
2556 {
2557 val = XCDR (XCAR (val));
2558 XSETCAR (val, make_number (XINT (XCAR (val)) + 1));
2559 }
2560 }
2561
2562
2563 static void
2564 font_finish_cache (f, driver)
2565 FRAME_PTR f;
2566 struct font_driver *driver;
2567 {
2568 Lisp_Object cache, val, tmp;
2569
2570
2571 cache = driver->get_cache (f);
2572 val = XCDR (cache);
2573 while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
2574 cache = val, val = XCDR (val);
2575 font_assert (! NILP (val));
2576 tmp = XCDR (XCAR (val));
2577 XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1));
2578 if (XINT (XCAR (tmp)) == 0)
2579 {
2580 font_clear_cache (f, XCAR (val), driver);
2581 XSETCDR (cache, XCDR (val));
2582 }
2583 }
2584
2585
2586 static Lisp_Object
2587 font_get_cache (f, driver)
2588 FRAME_PTR f;
2589 struct font_driver *driver;
2590 {
2591 Lisp_Object val = driver->get_cache (f);
2592 Lisp_Object type = driver->type;
2593
2594 font_assert (CONSP (val));
2595 for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val));
2596 font_assert (CONSP (val));
2597 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2598 val = XCDR (XCAR (val));
2599 return val;
2600 }
2601
2602 static int num_fonts;
2603
2604 static void
2605 font_clear_cache (f, cache, driver)
2606 FRAME_PTR f;
2607 Lisp_Object cache;
2608 struct font_driver *driver;
2609 {
2610 Lisp_Object tail, elt;
2611
2612 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2613 for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
2614 {
2615 elt = XCAR (tail);
2616 if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)) && VECTORP (XCDR (elt)))
2617 {
2618 Lisp_Object vec = XCDR (elt);
2619 int i;
2620
2621 for (i = 0; i < ASIZE (vec); i++)
2622 {
2623 Lisp_Object entity = AREF (vec, i);
2624
2625 if (EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
2626 {
2627 Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
2628
2629 for (; CONSP (objlist); objlist = XCDR (objlist))
2630 {
2631 Lisp_Object val = XCAR (objlist);
2632 struct font *font = XFONT_OBJECT (val);
2633
2634 if (! NILP (AREF (val, FONT_TYPE_INDEX)))
2635 {
2636 font_assert (font && driver == font->driver);
2637 driver->close (f, font);
2638 num_fonts--;
2639 }
2640 }
2641 if (driver->free_entity)
2642 driver->free_entity (entity);
2643 }
2644 }
2645 }
2646 }
2647 XSETCDR (cache, Qnil);
2648 }
2649 \f
2650
2651 static Lisp_Object scratch_font_spec, scratch_font_prefer;
2652
2653 Lisp_Object
2654 font_delete_unmatched (list, spec, size)
2655 Lisp_Object list, spec;
2656 int size;
2657 {
2658 Lisp_Object entity, val;
2659 enum font_property_index prop;
2660
2661 for (val = Qnil; CONSP (list); list = XCDR (list))
2662 {
2663 entity = XCAR (list);
2664 for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
2665 if (INTEGERP (AREF (spec, prop))
2666 && ((XINT (AREF (spec, prop)) >> 8)
2667 != (XINT (AREF (entity, prop)) >> 8)))
2668 prop = FONT_SPEC_MAX;
2669 if (prop < FONT_SPEC_MAX
2670 && size
2671 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
2672 {
2673 int diff = XINT (AREF (entity, FONT_SIZE_INDEX)) - size;
2674
2675 if (diff != 0
2676 && (diff < 0 ? -diff > FONT_PIXEL_SIZE_QUANTUM
2677 : diff > FONT_PIXEL_SIZE_QUANTUM))
2678 prop = FONT_SPEC_MAX;
2679 }
2680 if (prop < FONT_SPEC_MAX
2681 && INTEGERP (AREF (spec, FONT_DPI_INDEX))
2682 && INTEGERP (AREF (entity, FONT_DPI_INDEX))
2683 && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX)))
2684 prop = FONT_SPEC_MAX;
2685 if (prop < FONT_SPEC_MAX
2686 && INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX))
2687 && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
2688 && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX),
2689 AREF (entity, FONT_AVGWIDTH_INDEX)))
2690 prop = FONT_SPEC_MAX;
2691 if (prop < FONT_SPEC_MAX)
2692 val = Fcons (entity, val);
2693 }
2694 return val;
2695 }
2696
2697
2698 /* Return a vector of font-entities matching with SPEC on FRAME. */
2699
2700 Lisp_Object
2701 font_list_entities (frame, spec)
2702 Lisp_Object frame, spec;
2703 {
2704 FRAME_PTR f = XFRAME (frame);
2705 struct font_driver_list *driver_list = f->font_driver_list;
2706 Lisp_Object ftype, val;
2707 Lisp_Object *vec;
2708 int size;
2709 int need_filtering = 0;
2710 int i;
2711
2712 font_assert (FONT_SPEC_P (spec));
2713
2714 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
2715 size = XINT (AREF (spec, FONT_SIZE_INDEX));
2716 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
2717 size = font_pixel_size (f, spec);
2718 else
2719 size = 0;
2720
2721 ftype = AREF (spec, FONT_TYPE_INDEX);
2722 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
2723 ASET (scratch_font_spec, i, AREF (spec, i));
2724 for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
2725 {
2726 ASET (scratch_font_spec, i, Qnil);
2727 if (! NILP (AREF (spec, i)))
2728 need_filtering = 1;
2729 if (i == FONT_DPI_INDEX)
2730 /* Skip FONT_SPACING_INDEX */
2731 i++;
2732 }
2733 ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
2734 ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
2735
2736 vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
2737 if (! vec)
2738 return null_vector;
2739
2740 for (i = 0; driver_list; driver_list = driver_list->next)
2741 if (driver_list->on
2742 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
2743 {
2744 Lisp_Object cache = font_get_cache (f, driver_list->driver);
2745
2746 ASET (scratch_font_spec, FONT_TYPE_INDEX, driver_list->driver->type);
2747 val = assoc_no_quit (scratch_font_spec, XCDR (cache));
2748 if (CONSP (val))
2749 val = XCDR (val);
2750 else
2751 {
2752 Lisp_Object copy;
2753
2754 val = driver_list->driver->list (frame, scratch_font_spec);
2755 copy = Fcopy_font_spec (scratch_font_spec);
2756 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2757 XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
2758 }
2759 if (! NILP (val) && need_filtering)
2760 val = font_delete_unmatched (val, spec, size);
2761 if (! NILP (val))
2762 vec[i++] = val;
2763 }
2764
2765 val = (i > 0 ? Fvconcat (i, vec) : null_vector);
2766 font_add_log ("list", spec, val);
2767 return (val);
2768 }
2769
2770
2771 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2772 nil, is an array of face's attributes, which specifies preferred
2773 font-related attributes. */
2774
2775 static Lisp_Object
2776 font_matching_entity (f, attrs, spec)
2777 FRAME_PTR f;
2778 Lisp_Object *attrs, spec;
2779 {
2780 struct font_driver_list *driver_list = f->font_driver_list;
2781 Lisp_Object ftype, size, entity;
2782 Lisp_Object frame;
2783
2784 XSETFRAME (frame, f);
2785 ftype = AREF (spec, FONT_TYPE_INDEX);
2786 size = AREF (spec, FONT_SIZE_INDEX);
2787 if (FLOATP (size))
2788 ASET (spec, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
2789 entity = Qnil;
2790 for (; driver_list; driver_list = driver_list->next)
2791 if (driver_list->on
2792 && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
2793 {
2794 Lisp_Object cache = font_get_cache (f, driver_list->driver);
2795 Lisp_Object copy;
2796
2797 ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type);
2798 entity = assoc_no_quit (spec, XCDR (cache));
2799 if (CONSP (entity))
2800 entity = XCDR (entity);
2801 else
2802 {
2803 entity = driver_list->driver->match (frame, spec);
2804 copy = Fcopy_font_spec (spec);
2805 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
2806 XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache)));
2807 }
2808 if (! NILP (entity))
2809 break;
2810 }
2811 ASET (spec, FONT_TYPE_INDEX, ftype);
2812 ASET (spec, FONT_SIZE_INDEX, size);
2813 font_add_log ("match", spec, entity);
2814 return entity;
2815 }
2816
2817
2818 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2819 opened font object. */
2820
2821 static Lisp_Object
2822 font_open_entity (f, entity, pixel_size)
2823 FRAME_PTR f;
2824 Lisp_Object entity;
2825 int pixel_size;
2826 {
2827 struct font_driver_list *driver_list;
2828 Lisp_Object objlist, size, val, font_object;
2829 struct font *font;
2830 int min_width, height;
2831
2832 font_assert (FONT_ENTITY_P (entity));
2833 size = AREF (entity, FONT_SIZE_INDEX);
2834 if (XINT (size) != 0)
2835 pixel_size = XINT (size);
2836
2837 for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
2838 objlist = XCDR (objlist))
2839 if (! NILP (AREF (XCAR (objlist), FONT_TYPE_INDEX))
2840 && XFONT_OBJECT (XCAR (objlist))->pixel_size == pixel_size)
2841 return XCAR (objlist);
2842
2843 val = AREF (entity, FONT_TYPE_INDEX);
2844 for (driver_list = f->font_driver_list;
2845 driver_list && ! EQ (driver_list->driver->type, val);
2846 driver_list = driver_list->next);
2847 if (! driver_list)
2848 return Qnil;
2849
2850 font_object = driver_list->driver->open (f, entity, pixel_size);
2851 font_add_log ("open", entity, font_object);
2852 if (NILP (font_object))
2853 return Qnil;
2854 ASET (entity, FONT_OBJLIST_INDEX,
2855 Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
2856 ASET (font_object, FONT_OBJLIST_INDEX, Qnil);
2857 num_fonts++;
2858
2859 font = XFONT_OBJECT (font_object);
2860 min_width = (font->min_width ? font->min_width
2861 : font->average_width ? font->average_width
2862 : font->space_width ? font->space_width
2863 : 1);
2864 height = (font->height ? font->height : 1);
2865 #ifdef HAVE_WINDOW_SYSTEM
2866 FRAME_X_DISPLAY_INFO (f)->n_fonts++;
2867 if (FRAME_X_DISPLAY_INFO (f)->n_fonts == 1)
2868 {
2869 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width;
2870 FRAME_SMALLEST_FONT_HEIGHT (f) = height;
2871 fonts_changed_p = 1;
2872 }
2873 else
2874 {
2875 if (FRAME_SMALLEST_CHAR_WIDTH (f) > min_width)
2876 FRAME_SMALLEST_CHAR_WIDTH (f) = min_width, fonts_changed_p = 1;
2877 if (FRAME_SMALLEST_FONT_HEIGHT (f) > height)
2878 FRAME_SMALLEST_FONT_HEIGHT (f) = height, fonts_changed_p = 1;
2879 }
2880 #endif
2881
2882 return font_object;
2883 }
2884
2885
2886 /* Close FONT_OBJECT that is opened on frame F. */
2887
2888 void
2889 font_close_object (f, font_object)
2890 FRAME_PTR f;
2891 Lisp_Object font_object;
2892 {
2893 struct font *font = XFONT_OBJECT (font_object);
2894
2895 if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
2896 /* Already closed. */
2897 return;
2898 font_add_log ("close", font_object, Qnil);
2899 font->driver->close (f, font);
2900 #ifdef HAVE_WINDOW_SYSTEM
2901 font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
2902 FRAME_X_DISPLAY_INFO (f)->n_fonts--;
2903 #endif
2904 num_fonts--;
2905 }
2906
2907
2908 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2909 FONT is a font-entity and it must be opened to check. */
2910
2911 int
2912 font_has_char (f, font, c)
2913 FRAME_PTR f;
2914 Lisp_Object font;
2915 int c;
2916 {
2917 struct font *fontp;
2918
2919 if (FONT_ENTITY_P (font))
2920 {
2921 Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
2922 struct font_driver_list *driver_list;
2923
2924 for (driver_list = f->font_driver_list;
2925 driver_list && ! EQ (driver_list->driver->type, type);
2926 driver_list = driver_list->next);
2927 if (! driver_list)
2928 return 0;
2929 if (! driver_list->driver->has_char)
2930 return -1;
2931 return driver_list->driver->has_char (font, c);
2932 }
2933
2934 font_assert (FONT_OBJECT_P (font));
2935 fontp = XFONT_OBJECT (font);
2936 if (fontp->driver->has_char)
2937 {
2938 int result = fontp->driver->has_char (font, c);
2939
2940 if (result >= 0)
2941 return result;
2942 }
2943 return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
2944 }
2945
2946
2947 /* Return the glyph ID of FONT_OBJECT for character C. */
2948
2949 unsigned
2950 font_encode_char (font_object, c)
2951 Lisp_Object font_object;
2952 int c;
2953 {
2954 struct font *font;
2955
2956 font_assert (FONT_OBJECT_P (font_object));
2957 font = XFONT_OBJECT (font_object);
2958 return font->driver->encode_char (font, c);
2959 }
2960
2961
2962 /* Return the name of FONT_OBJECT. */
2963
2964 Lisp_Object
2965 font_get_name (font_object)
2966 Lisp_Object font_object;
2967 {
2968 font_assert (FONT_OBJECT_P (font_object));
2969 return AREF (font_object, FONT_NAME_INDEX);
2970 }
2971
2972
2973 /* Return the specification of FONT_OBJECT. */
2974
2975 Lisp_Object
2976 font_get_spec (font_object)
2977 Lisp_Object font_object;
2978 {
2979 Lisp_Object spec = font_make_spec ();
2980 int i;
2981
2982 for (i = 0; i < FONT_SIZE_INDEX; i++)
2983 ASET (spec, i, AREF (font_object, i));
2984 ASET (spec, FONT_SIZE_INDEX,
2985 make_number (XFONT_OBJECT (font_object)->pixel_size));
2986 return spec;
2987 }
2988
2989 Lisp_Object
2990 font_spec_from_name (font_name)
2991 Lisp_Object font_name;
2992 {
2993 Lisp_Object args[2];
2994
2995 args[0] = QCname;
2996 args[1] = font_name;
2997 return Ffont_spec (2, args);
2998 }
2999
3000
3001 void
3002 font_clear_prop (attrs, prop)
3003 Lisp_Object *attrs;
3004 enum font_property_index prop;
3005 {
3006 Lisp_Object font = attrs[LFACE_FONT_INDEX];
3007
3008 if (! FONTP (font))
3009 return;
3010 if (NILP (AREF (font, prop))
3011 && prop != FONT_FAMILY_INDEX && prop != FONT_FOUNDRY_INDEX
3012 && prop != FONT_SIZE_INDEX)
3013 return;
3014 font = Fcopy_font_spec (font);
3015 ASET (font, prop, Qnil);
3016 if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
3017 {
3018 if (prop == FONT_FAMILY_INDEX)
3019 ASET (font, FONT_FOUNDRY_INDEX, Qnil);
3020 ASET (font, FONT_ADSTYLE_INDEX, Qnil);
3021 ASET (font, FONT_REGISTRY_INDEX, Qnil);
3022 ASET (font, FONT_SIZE_INDEX, Qnil);
3023 ASET (font, FONT_DPI_INDEX, Qnil);
3024 ASET (font, FONT_SPACING_INDEX, Qnil);
3025 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3026 }
3027 else if (prop == FONT_SIZE_INDEX)
3028 {
3029 ASET (font, FONT_DPI_INDEX, Qnil);
3030 ASET (font, FONT_SPACING_INDEX, Qnil);
3031 ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
3032 }
3033 attrs[LFACE_FONT_INDEX] = font;
3034 }
3035
3036 void
3037 font_update_lface (f, attrs)
3038 FRAME_PTR f;
3039 Lisp_Object *attrs;
3040 {
3041 Lisp_Object spec;
3042
3043 spec = attrs[LFACE_FONT_INDEX];
3044 if (! FONT_SPEC_P (spec))
3045 return;
3046
3047 if (! NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
3048 attrs[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FOUNDRY_INDEX));
3049 if (! NILP (AREF (spec, FONT_FAMILY_INDEX)))
3050 attrs[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FAMILY_INDEX));
3051 if (! NILP (AREF (spec, FONT_WEIGHT_INDEX)))
3052 attrs[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (spec);
3053 if (! NILP (AREF (spec, FONT_SLANT_INDEX)))
3054 attrs[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (spec);;
3055 if (! NILP (AREF (spec, FONT_WIDTH_INDEX)))
3056 attrs[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (spec);
3057 if (! NILP (AREF (spec, FONT_SIZE_INDEX)))
3058 {
3059 int point;
3060
3061 if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
3062 {
3063 Lisp_Object val;
3064 int dpi = f->resy;
3065
3066 val = Ffont_get (spec, QCdpi);
3067 if (! NILP (val))
3068 dpi = XINT (val);
3069 point = PIXEL_TO_POINT (XINT (AREF (spec, FONT_SIZE_INDEX)) * 10,
3070 dpi);
3071 }
3072 else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
3073 point = XFLOAT_DATA (AREF (spec, FONT_SIZE_INDEX)) * 10;
3074 attrs[LFACE_HEIGHT_INDEX] = make_number (point);
3075 }
3076 }
3077
3078
3079 /* Return a font-entity satisfying SPEC and best matching with face's
3080 font related attributes in ATTRS. C, if not negative, is a
3081 character that the entity must support. */
3082
3083 Lisp_Object
3084 font_find_for_lface (f, attrs, spec, c)
3085 FRAME_PTR f;
3086 Lisp_Object *attrs;
3087 Lisp_Object spec;
3088 int c;
3089 {
3090 Lisp_Object work;
3091 Lisp_Object frame, entities, val, props[FONT_REGISTRY_INDEX + 1] ;
3092 Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
3093 int pixel_size;
3094 int i, j, k, l, result;
3095
3096 registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
3097 if (NILP (registry[0]))
3098 {
3099 registry[0] = Qiso8859_1;
3100 registry[1] = Qascii_0;
3101 registry[2] = null_vector;
3102 }
3103 else
3104 registry[1] = null_vector;
3105
3106 if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
3107 {
3108 struct charset *encoding, *repertory;
3109
3110 if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
3111 &encoding, &repertory) < 0)
3112 return Qnil;
3113 if (repertory)
3114 {
3115 if (ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
3116 return Qnil;
3117 /* Any font of this registry support C. So, let's
3118 suppress the further checking. */
3119 c = -1;
3120 }
3121 else if (c > encoding->max_char)
3122 return Qnil;
3123 }
3124
3125 work = Fcopy_font_spec (spec);
3126 XSETFRAME (frame, f);
3127 size = AREF (spec, FONT_SIZE_INDEX);
3128 pixel_size = font_pixel_size (f, spec);
3129 if (pixel_size == 0)
3130 {
3131 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
3132
3133 pixel_size = POINT_TO_PIXEL (pt / 10, f->resy);
3134 }
3135 ASET (work, FONT_SIZE_INDEX, Qnil);
3136 foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
3137 if (! NILP (foundry[0]))
3138 foundry[1] = null_vector;
3139 else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
3140 {
3141 foundry[0] = font_intern_prop (SDATA (attrs[LFACE_FOUNDRY_INDEX]),
3142 SBYTES (attrs[LFACE_FOUNDRY_INDEX]), 1);
3143 foundry[1] = Qnil;
3144 foundry[2] = null_vector;
3145 }
3146 else
3147 foundry[0] = Qnil, foundry[1] = null_vector;
3148
3149 adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
3150 if (! NILP (adstyle[0]))
3151 adstyle[1] = null_vector;
3152 else if (FONTP (attrs[LFACE_FONT_INDEX]))
3153 {
3154 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3155
3156 if (! NILP (AREF (face_font, FONT_ADSTYLE_INDEX)))
3157 {
3158 adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
3159 adstyle[1] = Qnil;
3160 adstyle[2] = null_vector;
3161 }
3162 else
3163 adstyle[0] = Qnil, adstyle[1] = null_vector;
3164 }
3165 else
3166 adstyle[0] = Qnil, adstyle[1] = null_vector;
3167
3168
3169 val = AREF (work, FONT_FAMILY_INDEX);
3170 if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
3171 val = font_intern_prop (SDATA (attrs[LFACE_FAMILY_INDEX]),
3172 SBYTES (attrs[LFACE_FAMILY_INDEX]), 1);
3173 if (NILP (val))
3174 {
3175 family = alloca ((sizeof family[0]) * 2);
3176 family[0] = Qnil;
3177 family[1] = null_vector; /* terminator. */
3178 }
3179 else
3180 {
3181 Lisp_Object alters
3182 = Fassoc_string (val, Vface_alternative_font_family_alist, Qt);
3183
3184 if (! NILP (alters))
3185 {
3186 family = alloca ((sizeof family[0]) * (XINT (Flength (alters)) + 2));
3187 for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
3188 family[i] = XCAR (alters);
3189 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3190 family[i++] = Qnil;
3191 family[i] = null_vector;
3192 }
3193 else
3194 {
3195 family = alloca ((sizeof family[0]) * 3);
3196 i = 0;
3197 family[i++] = val;
3198 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
3199 family[i++] = Qnil;
3200 family[i] = null_vector;
3201 }
3202 }
3203
3204 for (i = 0; SYMBOLP (family[i]); i++)
3205 {
3206 ASET (work, FONT_FAMILY_INDEX, family[i]);
3207 for (j = 0; SYMBOLP (foundry[j]); j++)
3208 {
3209 ASET (work, FONT_FOUNDRY_INDEX, foundry[j]);
3210 for (k = 0; SYMBOLP (registry[k]); k++)
3211 {
3212 ASET (work, FONT_REGISTRY_INDEX, registry[k]);
3213 for (l = 0; SYMBOLP (adstyle[l]); l++)
3214 {
3215 ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
3216 entities = font_list_entities (frame, work);
3217 if (ASIZE (entities) > 0)
3218 goto found;
3219 }
3220 }
3221 }
3222 }
3223 return Qnil;
3224 found:
3225 if (ASIZE (entities) == 1)
3226 {
3227 if (c < 0)
3228 return AREF (entities, 0);
3229 }
3230 else
3231 {
3232 /* Sort fonts by properties specified in LFACE. */
3233 Lisp_Object prefer = scratch_font_prefer;
3234
3235 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3236 ASET (prefer, i, AREF (work, i));
3237 if (FONTP (attrs[LFACE_FONT_INDEX]))
3238 {
3239 Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
3240
3241 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3242 if (NILP (AREF (prefer, i)))
3243 ASET (prefer, i, AREF (face_font, i));
3244 }
3245 if (NILP (AREF (prefer, FONT_WEIGHT_INDEX)))
3246 FONT_SET_STYLE (prefer, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
3247 if (NILP (AREF (prefer, FONT_SLANT_INDEX)))
3248 FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
3249 if (NILP (AREF (prefer, FONT_WIDTH_INDEX)))
3250 FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
3251 ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size));
3252 entities = font_sort_entites (entities, prefer, frame, c < 0);
3253 }
3254 if (c < 0)
3255 return entities;
3256
3257 for (i = 0; i < ASIZE (entities); i++)
3258 {
3259 int j;
3260
3261 val = AREF (entities, i);
3262 if (i > 0)
3263 {
3264 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3265 if (! EQ (AREF (val, j), props[j]))
3266 break;
3267 if (j > FONT_REGISTRY_INDEX)
3268 continue;
3269 }
3270 for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
3271 props[j] = AREF (val, j);
3272 result = font_has_char (f, val, c);
3273 if (result > 0)
3274 return val;
3275 if (result == 0)
3276 return Qnil;
3277 val = font_open_for_lface (f, val, attrs, spec);
3278 if (NILP (val))
3279 continue;
3280 result = font_has_char (f, val, c);
3281 font_close_object (f, val);
3282 if (result > 0)
3283 return AREF (entities, i);
3284 }
3285 return Qnil;
3286 }
3287
3288
3289 Lisp_Object
3290 font_open_for_lface (f, entity, attrs, spec)
3291 FRAME_PTR f;
3292 Lisp_Object entity;
3293 Lisp_Object *attrs;
3294 Lisp_Object spec;
3295 {
3296 int size;
3297
3298 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX))
3299 && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
3300 size = XINT (AREF (entity, FONT_SIZE_INDEX));
3301 else if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
3302 size = font_pixel_size (f, spec);
3303 else
3304 {
3305 double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
3306
3307 pt /= 10;
3308 size = POINT_TO_PIXEL (pt, f->resy);
3309 }
3310 return font_open_entity (f, entity, size);
3311 }
3312
3313
3314 /* Find a font satisfying SPEC and best matching with face's
3315 attributes in ATTRS on FRAME, and return the opened
3316 font-object. */
3317
3318 Lisp_Object
3319 font_load_for_lface (f, attrs, spec)
3320 FRAME_PTR f;
3321 Lisp_Object *attrs, spec;
3322 {
3323 Lisp_Object entity;
3324
3325 entity = font_find_for_lface (f, attrs, spec, -1);
3326 if (NILP (entity))
3327 {
3328 /* No font is listed for SPEC, but each font-backend may have
3329 the different criteria about "font matching". So, try
3330 it. */
3331 entity = font_matching_entity (f, attrs, spec);
3332 if (NILP (entity))
3333 return Qnil;
3334 }
3335 return font_open_for_lface (f, entity, attrs, spec);
3336 }
3337
3338
3339 /* Make FACE on frame F ready to use the font opened for FACE. */
3340
3341 void
3342 font_prepare_for_face (f, face)
3343 FRAME_PTR f;
3344 struct face *face;
3345 {
3346 if (face->font->driver->prepare_face)
3347 face->font->driver->prepare_face (f, face);
3348 }
3349
3350
3351 /* Make FACE on frame F stop using the font opened for FACE. */
3352
3353 void
3354 font_done_for_face (f, face)
3355 FRAME_PTR f;
3356 struct face *face;
3357 {
3358 if (face->font->driver->done_face)
3359 face->font->driver->done_face (f, face);
3360 face->extra = NULL;
3361 }
3362
3363
3364 /* Open a font best matching with NAME on frame F. If no proper font
3365 is found, return Qnil. */
3366
3367 Lisp_Object
3368 font_open_by_name (f, name)
3369 FRAME_PTR f;
3370 char *name;
3371 {
3372 Lisp_Object args[2];
3373 Lisp_Object spec, attrs[LFACE_VECTOR_SIZE];
3374
3375 args[0] = QCname;
3376 args[1] = make_unibyte_string (name, strlen (name));
3377 spec = Ffont_spec (2, args);
3378 /* We set up the default font-related attributes of a face to prefer
3379 a moderate font. */
3380 attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
3381 attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
3382 = attrs[LFACE_SLANT_INDEX] = Qnormal;
3383 attrs[LFACE_HEIGHT_INDEX] = make_number (120);
3384 attrs[LFACE_FONT_INDEX] = Qnil;
3385
3386 return font_load_for_lface (f, attrs, spec);
3387 }
3388
3389
3390 /* Register font-driver DRIVER. This function is used in two ways.
3391
3392 The first is with frame F non-NULL. In this case, make DRIVER
3393 available (but not yet activated) on F. All frame creaters
3394 (e.g. Fx_create_frame) must call this function at least once with
3395 an available font-driver.
3396
3397 The second is with frame F NULL. In this case, DRIVER is globally
3398 registered in the variable `font_driver_list'. All font-driver
3399 implementations must call this function in its syms_of_XXXX
3400 (e.g. syms_of_xfont). */
3401
3402 void
3403 register_font_driver (driver, f)
3404 struct font_driver *driver;
3405 FRAME_PTR f;
3406 {
3407 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
3408 struct font_driver_list *prev, *list;
3409
3410 if (f && ! driver->draw)
3411 error ("Unusable font driver for a frame: %s",
3412 SDATA (SYMBOL_NAME (driver->type)));
3413
3414 for (prev = NULL, list = root; list; prev = list, list = list->next)
3415 if (EQ (list->driver->type, driver->type))
3416 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
3417
3418 list = malloc (sizeof (struct font_driver_list));
3419 list->on = 0;
3420 list->driver = driver;
3421 list->next = NULL;
3422 if (prev)
3423 prev->next = list;
3424 else if (f)
3425 f->font_driver_list = list;
3426 else
3427 font_driver_list = list;
3428 if (! f)
3429 num_font_drivers++;
3430 }
3431
3432
3433 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3434 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3435 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3436
3437 A caller must free all realized faces if any in advance. The
3438 return value is a list of font backends actually made used on
3439 F. */
3440
3441 Lisp_Object
3442 font_update_drivers (f, new_drivers)
3443 FRAME_PTR f;
3444 Lisp_Object new_drivers;
3445 {
3446 Lisp_Object active_drivers = Qnil;
3447 struct font_driver *driver;
3448 struct font_driver_list *list;
3449
3450 /* At first, turn off non-requested drivers, and turn on requested
3451 drivers. */
3452 for (list = f->font_driver_list; list; list = list->next)
3453 {
3454 driver = list->driver;
3455 if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers)))
3456 != list->on)
3457 {
3458 if (list->on)
3459 {
3460 if (driver->end_for_frame)
3461 driver->end_for_frame (f);
3462 font_finish_cache (f, driver);
3463 list->on = 0;
3464 }
3465 else
3466 {
3467 if (! driver->start_for_frame
3468 || driver->start_for_frame (f) == 0)
3469 {
3470 font_prepare_cache (f, driver);
3471 list->on = 1;
3472 }
3473 }
3474 }
3475 }
3476
3477 if (NILP (new_drivers))
3478 return Qnil;
3479
3480 if (! EQ (new_drivers, Qt))
3481 {
3482 /* Re-order the driver list according to new_drivers. */
3483 struct font_driver_list **list_table, **next;
3484 Lisp_Object tail;
3485 int i;
3486
3487 list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
3488 for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
3489 {
3490 for (list = f->font_driver_list; list; list = list->next)
3491 if (list->on && EQ (list->driver->type, XCAR (tail)))
3492 break;
3493 if (list)
3494 list_table[i++] = list;
3495 }
3496 for (list = f->font_driver_list; list; list = list->next)
3497 if (! list->on)
3498 list_table[i] = list;
3499 list_table[i] = NULL;
3500
3501 next = &f->font_driver_list;
3502 for (i = 0; list_table[i]; i++)
3503 {
3504 *next = list_table[i];
3505 next = &(*next)->next;
3506 }
3507 *next = NULL;
3508 }
3509
3510 for (list = f->font_driver_list; list; list = list->next)
3511 if (list->on)
3512 active_drivers = nconc2 (active_drivers,
3513 Fcons (list->driver->type, Qnil));
3514 return active_drivers;
3515 }
3516
3517 int
3518 font_put_frame_data (f, driver, data)
3519 FRAME_PTR f;
3520 struct font_driver *driver;
3521 void *data;
3522 {
3523 struct font_data_list *list, *prev;
3524
3525 for (prev = NULL, list = f->font_data_list; list;
3526 prev = list, list = list->next)
3527 if (list->driver == driver)
3528 break;
3529 if (! data)
3530 {
3531 if (list)
3532 {
3533 if (prev)
3534 prev->next = list->next;
3535 else
3536 f->font_data_list = list->next;
3537 free (list);
3538 }
3539 return 0;
3540 }
3541
3542 if (! list)
3543 {
3544 list = malloc (sizeof (struct font_data_list));
3545 if (! list)
3546 return -1;
3547 list->driver = driver;
3548 list->next = f->font_data_list;
3549 f->font_data_list = list;
3550 }
3551 list->data = data;
3552 return 0;
3553 }
3554
3555
3556 void *
3557 font_get_frame_data (f, driver)
3558 FRAME_PTR f;
3559 struct font_driver *driver;
3560 {
3561 struct font_data_list *list;
3562
3563 for (list = f->font_data_list; list; list = list->next)
3564 if (list->driver == driver)
3565 break;
3566 if (! list)
3567 return NULL;
3568 return list->data;
3569 }
3570
3571
3572 /* Return the font used to draw character C by FACE at buffer position
3573 POS in window W. If STRING is non-nil, it is a string containing C
3574 at index POS. If C is negative, get C from the current buffer or
3575 STRING. */
3576
3577 Lisp_Object
3578 font_at (c, pos, face, w, string)
3579 int c;
3580 EMACS_INT pos;
3581 struct face *face;
3582 struct window *w;
3583 Lisp_Object string;
3584 {
3585 FRAME_PTR f;
3586 int multibyte;
3587 Lisp_Object font_object;
3588
3589 if (c < 0)
3590 {
3591 if (NILP (string))
3592 {
3593 multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3594 if (multibyte)
3595 {
3596 EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
3597
3598 c = FETCH_CHAR (pos_byte);
3599 }
3600 else
3601 c = FETCH_BYTE (pos);
3602 }
3603 else
3604 {
3605 unsigned char *str;
3606
3607 multibyte = STRING_MULTIBYTE (string);
3608 if (multibyte)
3609 {
3610 EMACS_INT pos_byte = string_char_to_byte (string, pos);
3611
3612 str = SDATA (string) + pos_byte;
3613 c = STRING_CHAR (str, 0);
3614 }
3615 else
3616 c = SDATA (string)[pos];
3617 }
3618 }
3619
3620 f = XFRAME (w->frame);
3621 if (! FRAME_WINDOW_P (f))
3622 return Qnil;
3623 if (! face)
3624 {
3625 int face_id;
3626 EMACS_INT endptr;
3627
3628 if (STRINGP (string))
3629 face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
3630 DEFAULT_FACE_ID, 0);
3631 else
3632 face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
3633 pos + 100, 0);
3634 face = FACE_FROM_ID (f, face_id);
3635 }
3636 if (multibyte)
3637 {
3638 int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
3639 face = FACE_FROM_ID (f, face_id);
3640 }
3641 if (! face->font)
3642 return Qnil;
3643
3644 XSETFONT (font_object, face->font);
3645 return font_object;
3646 }
3647
3648
3649 /* Check how many characters after POS (at most to LIMIT) can be
3650 displayed by the same font. FACE is the face selected for the
3651 character as POS on frame F. STRING, if not nil, is the string to
3652 check instead of the current buffer.
3653
3654 The return value is the position of the character that is displayed
3655 by the differnt font than that of the character as POS. */
3656
3657 EMACS_INT
3658 font_range (pos, limit, face, f, string)
3659 EMACS_INT pos, limit;
3660 struct face *face;
3661 FRAME_PTR f;
3662 Lisp_Object string;
3663 {
3664 int multibyte;
3665 EMACS_INT pos_byte;
3666 int c;
3667 struct font *font;
3668 int first = 1;
3669
3670 if (NILP (string))
3671 {
3672 multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3673 pos_byte = CHAR_TO_BYTE (pos);
3674 }
3675 else
3676 {
3677 multibyte = STRING_MULTIBYTE (string);
3678 pos_byte = string_char_to_byte (string, pos);
3679 }
3680
3681 if (! multibyte)
3682 /* All unibyte character are displayed by the same font. */
3683 return limit;
3684
3685 while (pos < limit)
3686 {
3687 int face_id;
3688
3689 if (NILP (string))
3690 FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
3691 else
3692 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
3693 face_id = FACE_FOR_CHAR (f, face, c, pos, string);
3694 face = FACE_FROM_ID (f, face_id);
3695 if (first)
3696 {
3697 font = face->font;
3698 first = 0;
3699 continue;
3700 }
3701 else if (font != face->font)
3702 {
3703 pos--;
3704 break;
3705 }
3706 }
3707 return pos;
3708 }
3709
3710 \f
3711 /* Lisp API */
3712
3713 DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
3714 doc: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3715 Return nil otherwise.
3716 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3717 which kind of font it is. It must be one of `font-spec', `font-entity',
3718 `font-object'. */)
3719 (object, extra_type)
3720 Lisp_Object object, extra_type;
3721 {
3722 if (NILP (extra_type))
3723 return (FONTP (object) ? Qt : Qnil);
3724 if (EQ (extra_type, Qfont_spec))
3725 return (FONT_SPEC_P (object) ? Qt : Qnil);
3726 if (EQ (extra_type, Qfont_entity))
3727 return (FONT_ENTITY_P (object) ? Qt : Qnil);
3728 if (EQ (extra_type, Qfont_object))
3729 return (FONT_OBJECT_P (object) ? Qt : Qnil);
3730 wrong_type_argument (intern ("font-extra-type"), extra_type);
3731 }
3732
3733 DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
3734 doc: /* Return a newly created font-spec with arguments as properties.
3735
3736 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3737 valid font property name listed below:
3738
3739 `:family', `:weight', `:slant', `:width'
3740
3741 They are the same as face attributes of the same name. See
3742 `set-face-attribute'.
3743
3744 `:foundry'
3745
3746 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3747
3748 `:adstyle'
3749
3750 VALUE must be a string or a symbol specifying the additional
3751 typographic style information of a font, e.g. ``sans''.
3752
3753 `:registry'
3754
3755 VALUE must be a string or a symbol specifying the charset registry and
3756 encoding of a font, e.g. ``iso8859-1''.
3757
3758 `:size'
3759
3760 VALUE must be a non-negative integer or a floating point number
3761 specifying the font size. It specifies the font size in pixels
3762 (if VALUE is an integer), or in points (if VALUE is a float).
3763
3764 `:name'
3765
3766 VALUE must be a string of XLFD-style or fontconfig-style font name.
3767 usage: (font-spec ARGS ...) */)
3768 (nargs, args)
3769 int nargs;
3770 Lisp_Object *args;
3771 {
3772 Lisp_Object spec = font_make_spec ();
3773 int i;
3774
3775 for (i = 0; i < nargs; i += 2)
3776 {
3777 Lisp_Object key = args[i], val = args[i + 1];
3778
3779 if (EQ (key, QCname))
3780 {
3781 CHECK_STRING (val);
3782 font_parse_name ((char *) SDATA (val), spec);
3783 font_put_extra (spec, key, val);
3784 }
3785 else
3786 {
3787 int idx = get_font_prop_index (key);
3788
3789 if (idx >= 0)
3790 {
3791 val = font_prop_validate (idx, Qnil, val);
3792 if (idx < FONT_EXTRA_INDEX)
3793 ASET (spec, idx, val);
3794 else
3795 font_put_extra (spec, key, val);
3796 }
3797 else
3798 font_put_extra (spec, key, font_prop_validate (0, key, val));
3799 }
3800 }
3801 return spec;
3802 }
3803
3804 DEFUN ("copy-font-spec", Fcopy_font_spec, Scopy_font_spec, 1, 1, 0,
3805 doc: /* Return a copy of FONT as a font-spec. */)
3806 (font)
3807 Lisp_Object font;
3808 {
3809 Lisp_Object new_spec, tail, prev, extra;
3810 int i;
3811
3812 CHECK_FONT (font);
3813 new_spec = font_make_spec ();
3814 for (i = 1; i < FONT_EXTRA_INDEX; i++)
3815 ASET (new_spec, i, AREF (font, i));
3816 extra = Fcopy_sequence (AREF (font, FONT_EXTRA_INDEX));
3817 /* We must remove :font-entity property. */
3818 for (prev = Qnil, tail = extra; CONSP (tail); prev = tail, tail = XCDR (tail))
3819 if (EQ (XCAR (XCAR (tail)), QCfont_entity))
3820 {
3821 if (NILP (prev))
3822 extra = XCDR (extra);
3823 else
3824 XSETCDR (prev, XCDR (tail));
3825 break;
3826 }
3827 ASET (new_spec, FONT_EXTRA_INDEX, extra);
3828 return new_spec;
3829 }
3830
3831 DEFUN ("merge-font-spec", Fmerge_font_spec, Smerge_font_spec, 2, 2, 0,
3832 doc: /* Merge font-specs FROM and TO, and return a new font-spec.
3833 Every specified properties in FROM override the corresponding
3834 properties in TO. */)
3835 (from, to)
3836 Lisp_Object from, to;
3837 {
3838 Lisp_Object extra, tail;
3839 int i;
3840
3841 CHECK_FONT (from);
3842 CHECK_FONT (to);
3843 to = Fcopy_font_spec (to);
3844 for (i = 0; i < FONT_EXTRA_INDEX; i++)
3845 ASET (to, i, AREF (from, i));
3846 extra = AREF (to, FONT_EXTRA_INDEX);
3847 for (tail = AREF (from, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
3848 if (! EQ (XCAR (XCAR (tail)), Qfont_entity))
3849 {
3850 Lisp_Object slot = assq_no_quit (XCAR (XCAR (tail)), extra);
3851
3852 if (! NILP (slot))
3853 XSETCDR (slot, XCDR (XCAR (tail)));
3854 else
3855 extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
3856 }
3857 ASET (to, FONT_EXTRA_INDEX, extra);
3858 return to;
3859 }
3860
3861 DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
3862 doc: /* Return the value of FONT's property KEY.
3863 FONT is a font-spec, a font-entity, or a font-object. */)
3864 (font, key)
3865 Lisp_Object font, key;
3866 {
3867 int idx;
3868
3869 CHECK_FONT (font);
3870 CHECK_SYMBOL (key);
3871
3872 idx = get_font_prop_index (key);
3873 if (idx >= FONT_WEIGHT_INDEX && idx <= FONT_WIDTH_INDEX)
3874 return font_style_symbolic (font, idx, 0);
3875 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
3876 return AREF (font, idx);
3877 return Fcdr (Fassq (key, AREF (font, FONT_EXTRA_INDEX)));
3878 }
3879
3880 #ifdef HAVE_WINDOW_SYSTEM
3881
3882 DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1, 2, 0,
3883 doc: /* Return a plist of face attributes generated by FONT.
3884 FONT is a font name, a font-spec, a font-entity, or a font-object.
3885 The return value is a list of the form
3886
3887 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3888
3889 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3890 compatible with `set-face-attribute'. Some of these key-attribute pairs
3891 may be omitted from the list if they are not specified by FONT.
3892
3893 The optional argument FRAME specifies the frame that the face attributes
3894 are to be displayed on. If omitted, the selected frame is used. */)
3895 (font, frame)
3896 Lisp_Object font, frame;
3897 {
3898 struct frame *f;
3899 Lisp_Object plist[10];
3900 Lisp_Object val;
3901 int n = 0;
3902
3903 if (NILP (frame))
3904 frame = selected_frame;
3905 CHECK_LIVE_FRAME (frame);
3906 f = XFRAME (frame);
3907
3908 if (STRINGP (font))
3909 {
3910 int fontset = fs_query_fontset (font, 0);
3911 Lisp_Object name = font;
3912 if (fontset >= 0)
3913 font = fontset_ascii (fontset);
3914 font = font_spec_from_name (name);
3915 if (! FONTP (font))
3916 signal_error ("Invalid font name", name);
3917 }
3918 else if (! FONTP (font))
3919 signal_error ("Invalid font object", font);
3920
3921 val = AREF (font, FONT_FAMILY_INDEX);
3922 if (! NILP (val))
3923 {
3924 plist[n++] = QCfamily;
3925 plist[n++] = SYMBOL_NAME (val);
3926 }
3927
3928 val = AREF (font, FONT_SIZE_INDEX);
3929 if (INTEGERP (val))
3930 {
3931 Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
3932 int dpi = INTEGERP (font_dpi) ? XINT (font_dpi) : f->resy;
3933 plist[n++] = QCheight;
3934 plist[n++] = make_number (PIXEL_TO_POINT (XINT (val) * 10, dpi));
3935 }
3936 else if (FLOATP (val))
3937 {
3938 plist[n++] = QCheight;
3939 plist[n++] = make_number (10 * (int) XFLOAT_DATA (val));
3940 }
3941
3942 val = FONT_WEIGHT_FOR_FACE (font);
3943 if (! NILP (val))
3944 {
3945 plist[n++] = QCweight;
3946 plist[n++] = val;
3947 }
3948
3949 val = FONT_SLANT_FOR_FACE (font);
3950 if (! NILP (val))
3951 {
3952 plist[n++] = QCslant;
3953 plist[n++] = val;
3954 }
3955
3956 val = FONT_WIDTH_FOR_FACE (font);
3957 if (! NILP (val))
3958 {
3959 plist[n++] = QCwidth;
3960 plist[n++] = val;
3961 }
3962
3963 return Flist (n, plist);
3964 }
3965
3966 #endif
3967
3968 DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
3969 doc: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3970 (font_spec, prop, val)
3971 Lisp_Object font_spec, prop, val;
3972 {
3973 int idx;
3974
3975 CHECK_FONT_SPEC (font_spec);
3976 idx = get_font_prop_index (prop);
3977 if (idx >= 0 && idx < FONT_EXTRA_INDEX)
3978 ASET (font_spec, idx, font_prop_validate (idx, Qnil, val));
3979 else
3980 font_put_extra (font_spec, prop, font_prop_validate (0, prop, val));
3981 return val;
3982 }
3983
3984 DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
3985 doc: /* List available fonts matching FONT-SPEC on the current frame.
3986 Optional 2nd argument FRAME specifies the target frame.
3987 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3988 Optional 4th argument PREFER, if non-nil, is a font-spec to
3989 control the order of the returned list. Fonts are sorted by
3990 how close they are to PREFER. */)
3991 (font_spec, frame, num, prefer)
3992 Lisp_Object font_spec, frame, num, prefer;
3993 {
3994 Lisp_Object vec, list, tail;
3995 int n = 0, i, len;
3996
3997 if (NILP (frame))
3998 frame = selected_frame;
3999 CHECK_LIVE_FRAME (frame);
4000 CHECK_FONT_SPEC (font_spec);
4001 if (! NILP (num))
4002 {
4003 CHECK_NUMBER (num);
4004 n = XINT (num);
4005 if (n <= 0)
4006 return Qnil;
4007 }
4008 if (! NILP (prefer))
4009 CHECK_FONT_SPEC (prefer);
4010
4011 vec = font_list_entities (frame, font_spec);
4012 len = ASIZE (vec);
4013 if (len == 0)
4014 return Qnil;
4015 if (len == 1)
4016 return Fcons (AREF (vec, 0), Qnil);
4017
4018 if (! NILP (prefer))
4019 vec = font_sort_entites (vec, prefer, frame, 0);
4020
4021 list = tail = Fcons (AREF (vec, 0), Qnil);
4022 if (n == 0 || n > len)
4023 n = len;
4024 for (i = 1; i < n; i++)
4025 {
4026 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
4027
4028 XSETCDR (tail, val);
4029 tail = val;
4030 }
4031 return list;
4032 }
4033
4034 DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
4035 doc: /* List available font families on the current frame.
4036 Optional argument FRAME, if non-nil, specifies the target frame. */)
4037 (frame)
4038 Lisp_Object frame;
4039 {
4040 FRAME_PTR f;
4041 struct font_driver_list *driver_list;
4042 Lisp_Object list;
4043
4044 if (NILP (frame))
4045 frame = selected_frame;
4046 CHECK_LIVE_FRAME (frame);
4047 f = XFRAME (frame);
4048 list = Qnil;
4049 for (driver_list = f->font_driver_list; driver_list;
4050 driver_list = driver_list->next)
4051 if (driver_list->driver->list_family)
4052 {
4053 Lisp_Object val = driver_list->driver->list_family (frame);
4054
4055 if (NILP (list))
4056 list = val;
4057 else
4058 {
4059 Lisp_Object tail = list;
4060
4061 for (; CONSP (val); val = XCDR (val))
4062 if (NILP (Fmemq (XCAR (val), tail)))
4063 list = Fcons (XCAR (val), list);
4064 }
4065 }
4066 return list;
4067 }
4068
4069 DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
4070 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
4071 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4072 (font_spec, frame)
4073 Lisp_Object font_spec, frame;
4074 {
4075 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
4076
4077 if (CONSP (val))
4078 val = XCAR (val);
4079 return val;
4080 }
4081
4082 DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
4083 doc: /* Return XLFD name of FONT.
4084 FONT is a font-spec, font-entity, or font-object.
4085 If the name is too long for XLFD (maximum 255 chars), return nil.
4086 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4087 the consecutive wildcards are folded to one. */)
4088 (font, fold_wildcards)
4089 Lisp_Object font, fold_wildcards;
4090 {
4091 char name[256];
4092 int pixel_size = 0;
4093
4094 CHECK_FONT (font);
4095
4096 if (FONT_OBJECT_P (font))
4097 {
4098 Lisp_Object font_name = AREF (font, FONT_NAME_INDEX);
4099
4100 if (STRINGP (font_name)
4101 && SDATA (font_name)[0] == '-')
4102 {
4103 if (NILP (fold_wildcards))
4104 return font_name;
4105 strcpy (name, (char *) SDATA (font_name));
4106 goto done;
4107 }
4108 pixel_size = XFONT_OBJECT (font)->pixel_size;
4109 }
4110 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
4111 return Qnil;
4112 done:
4113 if (! NILP (fold_wildcards))
4114 {
4115 char *p0 = name, *p1;
4116
4117 while ((p1 = strstr (p0, "-*-*")))
4118 {
4119 strcpy (p1, p1 + 2);
4120 p0 = p1;
4121 }
4122 }
4123
4124 return build_string (name);
4125 }
4126
4127 DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
4128 doc: /* Clear font cache. */)
4129 ()
4130 {
4131 Lisp_Object list, frame;
4132
4133 FOR_EACH_FRAME (list, frame)
4134 {
4135 FRAME_PTR f = XFRAME (frame);
4136 struct font_driver_list *driver_list = f->font_driver_list;
4137
4138 for (; driver_list; driver_list = driver_list->next)
4139 if (driver_list->on)
4140 {
4141 Lisp_Object cache = driver_list->driver->get_cache (f);
4142 Lisp_Object val;
4143
4144 val = XCDR (cache);
4145 while (! NILP (val)
4146 && ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
4147 val = XCDR (val);
4148 font_assert (! NILP (val));
4149 val = XCDR (XCAR (val));
4150 if (XINT (XCAR (val)) == 0)
4151 {
4152 font_clear_cache (f, XCAR (val), driver_list->driver);
4153 XSETCDR (cache, XCDR (val));
4154 }
4155 }
4156 }
4157
4158 return Qnil;
4159 }
4160
4161 /* The following three functions are still experimental. */
4162
4163 DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0,
4164 doc: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
4165 FONT-OBJECT may be nil if it is not yet known.
4166
4167 G-string is sequence of glyphs of a specific font,
4168 and is a vector of this form:
4169 [ HEADER GLYPH ... ]
4170 HEADER is a vector of this form:
4171 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
4172 where
4173 FONT-OBJECT is a font-object for all glyphs in the g-string,
4174 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
4175 GLYPH is a vector of this form:
4176 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
4177 [ [X-OFF Y-OFF WADJUST] | nil] ]
4178 where
4179 FROM-IDX and TO-IDX are used internally and should not be touched.
4180 C is the character of the glyph.
4181 CODE is the glyph-code of C in FONT-OBJECT.
4182 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4183 X-OFF and Y-OFF are offests to the base position for the glyph.
4184 WADJUST is the adjustment to the normal width of the glyph. */)
4185 (font_object, num)
4186 Lisp_Object font_object, num;
4187 {
4188 Lisp_Object gstring, g;
4189 int len;
4190 int i;
4191
4192 if (! NILP (font_object))
4193 CHECK_FONT_OBJECT (font_object);
4194 CHECK_NATNUM (num);
4195
4196 len = XINT (num) + 1;
4197 gstring = Fmake_vector (make_number (len), Qnil);
4198 g = Fmake_vector (make_number (6), Qnil);
4199 ASET (g, 0, font_object);
4200 ASET (gstring, 0, g);
4201 for (i = 1; i < len; i++)
4202 ASET (gstring, i, Fmake_vector (make_number (10), Qnil));
4203 return gstring;
4204 }
4205
4206 DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
4207 doc: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
4208 START and END specify the region to extract characters.
4209 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
4210 where to extract characters.
4211 FONT-OBJECT may be nil if GSTRING already contains one. */)
4212 (gstring, font_object, start, end, object)
4213 Lisp_Object gstring, font_object, start, end, object;
4214 {
4215 int len, i, c;
4216 unsigned code;
4217 struct font *font;
4218
4219 CHECK_VECTOR (gstring);
4220 if (NILP (font_object))
4221 font_object = LGSTRING_FONT (gstring);
4222 font = XFONT_OBJECT (font_object);
4223
4224 if (STRINGP (object))
4225 {
4226 const unsigned char *p;
4227
4228 CHECK_NATNUM (start);
4229 CHECK_NATNUM (end);
4230 if (XINT (start) > XINT (end)
4231 || XINT (end) > ASIZE (object)
4232 || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
4233 args_out_of_range_3 (object, start, end);
4234
4235 len = XINT (end) - XINT (start);
4236 p = SDATA (object) + string_char_to_byte (object, XINT (start));
4237 for (i = 0; i < len; i++)
4238 {
4239 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
4240 /* Shut up GCC warning in comparison with
4241 MOST_POSITIVE_FIXNUM below. */
4242 EMACS_INT cod;
4243
4244 c = STRING_CHAR_ADVANCE (p);
4245 cod = code = font->driver->encode_char (font, c);
4246 if (cod > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE)
4247 break;
4248 LGLYPH_SET_FROM (g, i);
4249 LGLYPH_SET_TO (g, i);
4250 LGLYPH_SET_CHAR (g, c);
4251 LGLYPH_SET_CODE (g, code);
4252 }
4253 }
4254 else
4255 {
4256 int pos, pos_byte;
4257
4258 if (! NILP (object))
4259 Fset_buffer (object);
4260 validate_region (&start, &end);
4261 if (XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
4262 args_out_of_range (start, end);
4263 len = XINT (end) - XINT (start);
4264 pos = XINT (start);
4265 pos_byte = CHAR_TO_BYTE (pos);
4266 for (i = 0; i < len; i++)
4267 {
4268 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
4269 /* Shut up GCC warning in comparison with
4270 MOST_POSITIVE_FIXNUM below. */
4271 EMACS_INT cod;
4272
4273 FETCH_CHAR_ADVANCE (c, pos, pos_byte);
4274 cod = code = font->driver->encode_char (font, c);
4275 if (cod > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE)
4276 break;
4277 LGLYPH_SET_FROM (g, i);
4278 LGLYPH_SET_TO (g, i);
4279 LGLYPH_SET_CHAR (g, c);
4280 LGLYPH_SET_CODE (g, code);
4281 }
4282 }
4283 for (; i < LGSTRING_LENGTH (gstring); i++)
4284 LGSTRING_SET_GLYPH (gstring, i, Qnil);
4285 return Qnil;
4286 }
4287
4288 DEFUN ("font-shape-text", Ffont_shape_text, Sfont_shape_text, 3, 4, 0,
4289 doc: /* Shape text between FROM and TO by FONT-OBJECT.
4290 If optional 4th argument STRING is non-nil, it is a string to shape,
4291 and FROM and TO are indices to the string.
4292 The value is the end position of the text that can be shaped by
4293 FONT-OBJECT. */)
4294 (from, to, font_object, string)
4295 Lisp_Object from, to, font_object, string;
4296 {
4297 struct font *font;
4298 struct font_metrics metrics;
4299 EMACS_INT start, end;
4300 Lisp_Object gstring, n;
4301 int len, i;
4302
4303 if (! FONT_OBJECT_P (font_object))
4304 return Qnil;
4305 font = XFONT_OBJECT (font_object);
4306 if (! font->driver->shape)
4307 return Qnil;
4308
4309 if (NILP (string))
4310 {
4311 validate_region (&from, &to);
4312 start = XFASTINT (from);
4313 end = XFASTINT (to);
4314 modify_region (current_buffer, start, end, 0);
4315 }
4316 else
4317 {
4318 CHECK_STRING (string);
4319 start = XINT (from);
4320 end = XINT (to);
4321 if (start < 0 || start > end || end > SCHARS (string))
4322 args_out_of_range_3 (string, from, to);
4323 }
4324
4325 len = end - start;
4326 gstring = Ffont_make_gstring (font_object, make_number (len));
4327 Ffont_fill_gstring (gstring, font_object, from, to, string);
4328
4329 /* Try at most three times with larger gstring each time. */
4330 for (i = 0; i < 3; i++)
4331 {
4332 Lisp_Object args[2];
4333
4334 n = font->driver->shape (gstring);
4335 if (INTEGERP (n))
4336 break;
4337 args[0] = gstring;
4338 args[1] = Fmake_vector (make_number (len), Qnil);
4339 gstring = Fvconcat (2, args);
4340 }
4341 if (! INTEGERP (n) || XINT (n) == 0)
4342 return Qnil;
4343 len = XINT (n);
4344
4345 for (i = 0; i < len;)
4346 {
4347 Lisp_Object gstr;
4348 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
4349 EMACS_INT this_from = LGLYPH_FROM (g);
4350 EMACS_INT this_to = LGLYPH_TO (g) + 1;
4351 int j, k;
4352 int need_composition = 0;
4353
4354 metrics.lbearing = LGLYPH_LBEARING (g);
4355 metrics.rbearing = LGLYPH_RBEARING (g);
4356 metrics.ascent = LGLYPH_ASCENT (g);
4357 metrics.descent = LGLYPH_DESCENT (g);
4358 if (NILP (LGLYPH_ADJUSTMENT (g)))
4359 {
4360 metrics.width = LGLYPH_WIDTH (g);
4361 if (LGLYPH_CHAR (g) == 0 || metrics.width == 0)
4362 need_composition = 1;
4363 }
4364 else
4365 {
4366 metrics.width = LGLYPH_WADJUST (g);
4367 metrics.lbearing += LGLYPH_XOFF (g);
4368 metrics.rbearing += LGLYPH_XOFF (g);
4369 metrics.ascent -= LGLYPH_YOFF (g);
4370 metrics.descent += LGLYPH_YOFF (g);
4371 need_composition = 1;
4372 }
4373 for (j = i + 1; j < len; j++)
4374 {
4375 int x;
4376
4377 g = LGSTRING_GLYPH (gstring, j);
4378 if (this_from != LGLYPH_FROM (g))
4379 break;
4380 need_composition = 1;
4381 x = metrics.width + LGLYPH_LBEARING (g) + LGLYPH_XOFF (g);
4382 if (metrics.lbearing > x)
4383 metrics.lbearing = x;
4384 x = metrics.width + LGLYPH_RBEARING (g) + LGLYPH_XOFF (g);
4385 if (metrics.rbearing < x)
4386 metrics.rbearing = x;
4387 x = LGLYPH_ASCENT (g) - LGLYPH_YOFF (g);
4388 if (metrics.ascent < x)
4389 metrics.ascent = x;
4390 x = LGLYPH_DESCENT (g) - LGLYPH_YOFF (g);
4391 if (metrics.descent < x)
4392 metrics.descent = x;
4393 if (NILP (LGLYPH_ADJUSTMENT (g)))
4394 metrics.width += LGLYPH_WIDTH (g);
4395 else
4396 metrics.width += LGLYPH_WADJUST (g);
4397 }
4398
4399 if (need_composition)
4400 {
4401 gstr = Ffont_make_gstring (font_object, make_number (j - i));
4402 LGSTRING_SET_WIDTH (gstr, metrics.width);
4403 LGSTRING_SET_LBEARING (gstr, metrics.lbearing);
4404 LGSTRING_SET_RBEARING (gstr, metrics.rbearing);
4405 LGSTRING_SET_ASCENT (gstr, metrics.ascent);
4406 LGSTRING_SET_DESCENT (gstr, metrics.descent);
4407 for (k = i; i < j; i++)
4408 {
4409 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
4410
4411 LGLYPH_SET_FROM (g, LGLYPH_FROM (g) - this_from);
4412 LGLYPH_SET_TO (g, LGLYPH_TO (g) - this_from);
4413 LGSTRING_SET_GLYPH (gstr, i - k, LGSTRING_GLYPH (gstring, i));
4414 }
4415 from = make_number (start + this_from);
4416 to = make_number (start + this_to);
4417 if (NILP (string))
4418 Fcompose_region_internal (from, to, gstr, Qnil);
4419 else
4420 Fcompose_string_internal (string, from, to, gstr, Qnil);
4421 }
4422 else
4423 i = j;
4424 }
4425
4426 return to;
4427 }
4428
4429 #if 0
4430
4431 DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
4432 doc: /* Apply OpenType features on glyph-string GSTRING-IN.
4433 OTF-FEATURES specifies which features to apply in this format:
4434 (SCRIPT LANGSYS GSUB GPOS)
4435 where
4436 SCRIPT is a symbol specifying a script tag of OpenType,
4437 LANGSYS is a symbol specifying a langsys tag of OpenType,
4438 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4439
4440 If LANGYS is nil, the default langsys is selected.
4441
4442 The features are applied in the order they appear in the list. The
4443 symbol `*' means to apply all available features not present in this
4444 list, and the remaining features are ignored. For instance, (vatu
4445 pstf * haln) is to apply vatu and pstf in this order, then to apply
4446 all available features other than vatu, pstf, and haln.
4447
4448 The features are applied to the glyphs in the range FROM and TO of
4449 the glyph-string GSTRING-IN.
4450
4451 If some feature is actually applicable, the resulting glyphs are
4452 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4453 this case, the value is the number of produced glyphs.
4454
4455 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4456 the value is 0.
4457
4458 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4459 produced in GSTRING-OUT, and the value is nil.
4460
4461 See the documentation of `font-make-gstring' for the format of
4462 glyph-string. */)
4463 (otf_features, gstring_in, from, to, gstring_out, index)
4464 Lisp_Object otf_features, gstring_in, from, to, gstring_out, index;
4465 {
4466 Lisp_Object font_object = LGSTRING_FONT (gstring_in);
4467 Lisp_Object val;
4468 struct font *font;
4469 int len, num;
4470
4471 check_otf_features (otf_features);
4472 CHECK_FONT_OBJECT (font_object);
4473 font = XFONT_OBJECT (font_object);
4474 if (! font->driver->otf_drive)
4475 error ("Font backend %s can't drive OpenType GSUB table",
4476 SDATA (SYMBOL_NAME (font->driver->type)));
4477 CHECK_CONS (otf_features);
4478 CHECK_SYMBOL (XCAR (otf_features));
4479 val = XCDR (otf_features);
4480 CHECK_SYMBOL (XCAR (val));
4481 val = XCDR (otf_features);
4482 if (! NILP (val))
4483 CHECK_CONS (val);
4484 len = check_gstring (gstring_in);
4485 CHECK_VECTOR (gstring_out);
4486 CHECK_NATNUM (from);
4487 CHECK_NATNUM (to);
4488 CHECK_NATNUM (index);
4489
4490 if (XINT (from) >= XINT (to) || XINT (to) > len)
4491 args_out_of_range_3 (from, to, make_number (len));
4492 if (XINT (index) >= ASIZE (gstring_out))
4493 args_out_of_range (index, make_number (ASIZE (gstring_out)));
4494 num = font->driver->otf_drive (font, otf_features,
4495 gstring_in, XINT (from), XINT (to),
4496 gstring_out, XINT (index), 0);
4497 if (num < 0)
4498 return Qnil;
4499 return make_number (num);
4500 }
4501
4502 DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
4503 3, 3, 0,
4504 doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4505 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4506 in this format:
4507 (SCRIPT LANGSYS FEATURE ...)
4508 See the documentation of `font-drive-otf' for more detail.
4509
4510 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4511 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4512 character code corresponding to the glyph or nil if there's no
4513 corresponding character. */)
4514 (font_object, character, otf_features)
4515 Lisp_Object font_object, character, otf_features;
4516 {
4517 struct font *font;
4518 Lisp_Object gstring_in, gstring_out, g;
4519 Lisp_Object alternates;
4520 int i, num;
4521
4522 CHECK_FONT_GET_OBJECT (font_object, font);
4523 if (! font->driver->otf_drive)
4524 error ("Font backend %s can't drive OpenType GSUB table",
4525 SDATA (SYMBOL_NAME (font->driver->type)));
4526 CHECK_CHARACTER (character);
4527 CHECK_CONS (otf_features);
4528
4529 gstring_in = Ffont_make_gstring (font_object, make_number (1));
4530 g = LGSTRING_GLYPH (gstring_in, 0);
4531 LGLYPH_SET_CHAR (g, XINT (character));
4532 gstring_out = Ffont_make_gstring (font_object, make_number (10));
4533 while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
4534 gstring_out, 0, 1)) < 0)
4535 gstring_out = Ffont_make_gstring (font_object,
4536 make_number (ASIZE (gstring_out) * 2));
4537 alternates = Qnil;
4538 for (i = 0; i < num; i++)
4539 {
4540 Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
4541 int c = LGLYPH_CHAR (g);
4542 unsigned code = LGLYPH_CODE (g);
4543
4544 alternates = Fcons (Fcons (make_number (code),
4545 c > 0 ? make_number (c) : Qnil),
4546 alternates);
4547 }
4548 return Fnreverse (alternates);
4549 }
4550 #endif /* 0 */
4551
4552 #ifdef FONT_DEBUG
4553
4554 DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
4555 doc: /* Open FONT-ENTITY. */)
4556 (font_entity, size, frame)
4557 Lisp_Object font_entity;
4558 Lisp_Object size;
4559 Lisp_Object frame;
4560 {
4561 int isize;
4562
4563 CHECK_FONT_ENTITY (font_entity);
4564 if (NILP (frame))
4565 frame = selected_frame;
4566 CHECK_LIVE_FRAME (frame);
4567
4568 if (NILP (size))
4569 isize = XINT (AREF (font_entity, FONT_SIZE_INDEX));
4570 else
4571 {
4572 CHECK_NUMBER_OR_FLOAT (size);
4573 if (FLOATP (size))
4574 isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
4575 else
4576 isize = XINT (size);
4577 if (isize == 0)
4578 isize = 120;
4579 }
4580 return font_open_entity (XFRAME (frame), font_entity, isize);
4581 }
4582
4583 DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
4584 doc: /* Close FONT-OBJECT. */)
4585 (font_object, frame)
4586 Lisp_Object font_object, frame;
4587 {
4588 CHECK_FONT_OBJECT (font_object);
4589 if (NILP (frame))
4590 frame = selected_frame;
4591 CHECK_LIVE_FRAME (frame);
4592 font_close_object (XFRAME (frame), font_object);
4593 return Qnil;
4594 }
4595
4596 DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
4597 doc: /* Return information about FONT-OBJECT.
4598 The value is a vector:
4599 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4600 CAPABILITY ]
4601
4602 NAME is a string of the font name (or nil if the font backend doesn't
4603 provide a name).
4604
4605 FILENAME is a string of the font file (or nil if the font backend
4606 doesn't provide a file name).
4607
4608 PIXEL-SIZE is a pixel size by which the font is opened.
4609
4610 SIZE is a maximum advance width of the font in pixels.
4611
4612 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4613 pixels.
4614
4615 CAPABILITY is a list whose first element is a symbol representing the
4616 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4617 remaining elements describe the details of the font capability.
4618
4619 If the font is OpenType font, the form of the list is
4620 \(opentype GSUB GPOS)
4621 where GSUB shows which "GSUB" features the font supports, and GPOS
4622 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4623 lists of the format:
4624 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4625
4626 If the font is not OpenType font, currently the length of the form is
4627 one.
4628
4629 SCRIPT is a symbol representing OpenType script tag.
4630
4631 LANGSYS is a symbol representing OpenType langsys tag, or nil
4632 representing the default langsys.
4633
4634 FEATURE is a symbol representing OpenType feature tag.
4635
4636 If the font is not OpenType font, CAPABILITY is nil. */)
4637 (font_object)
4638 Lisp_Object font_object;
4639 {
4640 struct font *font;
4641 Lisp_Object val;
4642
4643 CHECK_FONT_GET_OBJECT (font_object, font);
4644
4645 val = Fmake_vector (make_number (9), Qnil);
4646 ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
4647 ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
4648 ASET (val, 2, make_number (font->pixel_size));
4649 ASET (val, 3, make_number (font->max_width));
4650 ASET (val, 4, make_number (font->ascent));
4651 ASET (val, 5, make_number (font->descent));
4652 ASET (val, 6, make_number (font->space_width));
4653 ASET (val, 7, make_number (font->average_width));
4654 if (font->driver->otf_capability)
4655 ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
4656 return val;
4657 }
4658
4659 DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
4660 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4661 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4662 (font_object, string)
4663 Lisp_Object font_object, string;
4664 {
4665 struct font *font;
4666 int i, len;
4667 Lisp_Object vec;
4668
4669 CHECK_FONT_GET_OBJECT (font_object, font);
4670 CHECK_STRING (string);
4671 len = SCHARS (string);
4672 vec = Fmake_vector (make_number (len), Qnil);
4673 for (i = 0; i < len; i++)
4674 {
4675 Lisp_Object ch = Faref (string, make_number (i));
4676 Lisp_Object val;
4677 int c = XINT (ch);
4678 unsigned code;
4679 EMACS_INT cod;
4680 struct font_metrics metrics;
4681
4682 cod = code = font->driver->encode_char (font, c);
4683 if (code == FONT_INVALID_CODE)
4684 continue;
4685 val = Fmake_vector (make_number (6), Qnil);
4686 if (cod <= MOST_POSITIVE_FIXNUM)
4687 ASET (val, 0, make_number (code));
4688 else
4689 ASET (val, 0, Fcons (make_number (code >> 16),
4690 make_number (code & 0xFFFF)));
4691 font->driver->text_extents (font, &code, 1, &metrics);
4692 ASET (val, 1, make_number (metrics.lbearing));
4693 ASET (val, 2, make_number (metrics.rbearing));
4694 ASET (val, 3, make_number (metrics.width));
4695 ASET (val, 4, make_number (metrics.ascent));
4696 ASET (val, 5, make_number (metrics.descent));
4697 ASET (vec, i, val);
4698 }
4699 return vec;
4700 }
4701
4702 DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
4703 doc: /* Return t if and only if font-spec SPEC matches with FONT.
4704 FONT is a font-spec, font-entity, or font-object. */)
4705 (spec, font)
4706 Lisp_Object spec, font;
4707 {
4708 CHECK_FONT_SPEC (spec);
4709 CHECK_FONT (font);
4710
4711 return (font_match_p (spec, font) ? Qt : Qnil);
4712 }
4713
4714 DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
4715 doc: /* Return a font-object for displaying a character at POSITION.
4716 Optional second arg WINDOW, if non-nil, is a window displaying
4717 the current buffer. It defaults to the currently selected window. */)
4718 (position, window, string)
4719 Lisp_Object position, window, string;
4720 {
4721 struct window *w;
4722 EMACS_INT pos;
4723
4724 if (NILP (string))
4725 {
4726 CHECK_NUMBER_COERCE_MARKER (position);
4727 pos = XINT (position);
4728 if (pos < BEGV || pos >= ZV)
4729 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
4730 }
4731 else
4732 {
4733 CHECK_NUMBER (position);
4734 CHECK_STRING (string);
4735 pos = XINT (position);
4736 if (pos < 0 || pos >= SCHARS (string))
4737 args_out_of_range (string, position);
4738 }
4739 if (NILP (window))
4740 window = selected_window;
4741 CHECK_LIVE_WINDOW (window);
4742 w = XWINDOW (window);
4743
4744 return font_at (-1, pos, NULL, w, string);
4745 }
4746
4747 #if 0
4748 DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
4749 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4750 The value is a number of glyphs drawn.
4751 Type C-l to recover what previously shown. */)
4752 (font_object, string)
4753 Lisp_Object font_object, string;
4754 {
4755 Lisp_Object frame = selected_frame;
4756 FRAME_PTR f = XFRAME (frame);
4757 struct font *font;
4758 struct face *face;
4759 int i, len, width;
4760 unsigned *code;
4761
4762 CHECK_FONT_GET_OBJECT (font_object, font);
4763 CHECK_STRING (string);
4764 len = SCHARS (string);
4765 code = alloca (sizeof (unsigned) * len);
4766 for (i = 0; i < len; i++)
4767 {
4768 Lisp_Object ch = Faref (string, make_number (i));
4769 Lisp_Object val;
4770 int c = XINT (ch);
4771
4772 code[i] = font->driver->encode_char (font, c);
4773 if (code[i] == FONT_INVALID_CODE)
4774 break;
4775 }
4776 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4777 face->fontp = font;
4778 if (font->driver->prepare_face)
4779 font->driver->prepare_face (f, face);
4780 width = font->driver->text_extents (font, code, i, NULL);
4781 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
4782 if (font->driver->done_face)
4783 font->driver->done_face (f, face);
4784 face->fontp = NULL;
4785 return make_number (len);
4786 }
4787 #endif
4788
4789 #endif /* FONT_DEBUG */
4790
4791 #ifdef HAVE_WINDOW_SYSTEM
4792
4793 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
4794 doc: /* Return information about a font named NAME on frame FRAME.
4795 If FRAME is omitted or nil, use the selected frame.
4796 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4797 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4798 where
4799 OPENED-NAME is the name used for opening the font,
4800 FULL-NAME is the full name of the font,
4801 SIZE is the maximum bound width of the font,
4802 HEIGHT is the height of the font,
4803 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4804 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4805 how to compose characters.
4806 If the named font is not yet loaded, return nil. */)
4807 (name, frame)
4808 Lisp_Object name, frame;
4809 {
4810 FRAME_PTR f;
4811 struct font *font;
4812 Lisp_Object info;
4813 Lisp_Object font_object;
4814
4815 (*check_window_system_func) ();
4816
4817 if (! FONTP (name))
4818 CHECK_STRING (name);
4819 if (NILP (frame))
4820 frame = selected_frame;
4821 CHECK_LIVE_FRAME (frame);
4822 f = XFRAME (frame);
4823
4824 if (STRINGP (name))
4825 {
4826 int fontset = fs_query_fontset (name, 0);
4827
4828 if (fontset >= 0)
4829 name = fontset_ascii (fontset);
4830 font_object = font_open_by_name (f, (char *) SDATA (name));
4831 }
4832 else if (FONT_OBJECT_P (name))
4833 font_object = name;
4834 else if (FONT_ENTITY_P (name))
4835 font_object = font_open_entity (f, name, 0);
4836 else
4837 {
4838 struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
4839 Lisp_Object entity = font_matching_entity (f, face->lface, name);
4840
4841 font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
4842 }
4843 if (NILP (font_object))
4844 return Qnil;
4845 font = XFONT_OBJECT (font_object);
4846
4847 info = Fmake_vector (make_number (7), Qnil);
4848 XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
4849 XVECTOR (info)->contents[1] = AREF (font_object, FONT_NAME_INDEX);
4850 XVECTOR (info)->contents[2] = make_number (font->pixel_size);
4851 XVECTOR (info)->contents[3] = make_number (font->height);
4852 XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
4853 XVECTOR (info)->contents[5] = make_number (font->relative_compose);
4854 XVECTOR (info)->contents[6] = make_number (font->default_ascent);
4855
4856 #if 0
4857 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4858 close it now. Perhaps, we should manage font-objects
4859 by `reference-count'. */
4860 font_close_object (f, font_object);
4861 #endif
4862 return info;
4863 }
4864 #endif
4865
4866 \f
4867 #define BUILD_STYLE_TABLE(TBL) \
4868 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4869
4870 static Lisp_Object
4871 build_style_table (entry, nelement)
4872 struct table_entry *entry;
4873 int nelement;
4874 {
4875 int i, j;
4876 Lisp_Object table, elt;
4877
4878 table = Fmake_vector (make_number (nelement), Qnil);
4879 for (i = 0; i < nelement; i++)
4880 {
4881 for (j = 0; entry[i].names[j]; j++);
4882 elt = Fmake_vector (make_number (j + 1), Qnil);
4883 ASET (elt, 0, make_number (entry[i].numeric));
4884 for (j = 0; entry[i].names[j]; j++)
4885 ASET (elt, j + 1, intern (entry[i].names[j]));
4886 ASET (table, i, elt);
4887 }
4888 return table;
4889 }
4890
4891 static Lisp_Object Vfont_log;
4892 static int font_log_env_checked;
4893
4894 void
4895 font_add_log (action, arg, result)
4896 char *action;
4897 Lisp_Object arg, result;
4898 {
4899 Lisp_Object tail, val;
4900 int i;
4901
4902 if (! font_log_env_checked)
4903 {
4904 Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
4905 font_log_env_checked = 1;
4906 }
4907 if (EQ (Vfont_log, Qt))
4908 return;
4909 if (FONTP (arg))
4910 arg = Ffont_xlfd_name (arg, Qt);
4911 if (FONTP (result))
4912 {
4913 val = Ffont_xlfd_name (result, Qt);
4914 if (! FONT_SPEC_P (result))
4915 val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
4916 build_string (":"), val);
4917 result = val;
4918 }
4919 else if (CONSP (result))
4920 {
4921 result = Fcopy_sequence (result);
4922 for (tail = result; CONSP (tail); tail = XCDR (tail))
4923 {
4924 val = XCAR (tail);
4925 if (FONTP (val))
4926 val = Ffont_xlfd_name (val, Qt);
4927 XSETCAR (tail, val);
4928 }
4929 }
4930 else if (VECTORP (result))
4931 {
4932 result = Fcopy_sequence (result);
4933 for (i = 0; i < ASIZE (result); i++)
4934 {
4935 val = AREF (result, i);
4936 if (FONTP (val))
4937 val = Ffont_xlfd_name (val, Qt);
4938 ASET (result, i, val);
4939 }
4940 }
4941 Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
4942 }
4943
4944 extern void syms_of_ftfont P_ (());
4945 extern void syms_of_xfont P_ (());
4946 extern void syms_of_xftfont P_ (());
4947 extern void syms_of_ftxfont P_ (());
4948 extern void syms_of_bdffont P_ (());
4949 extern void syms_of_w32font P_ (());
4950 extern void syms_of_atmfont P_ (());
4951
4952 void
4953 syms_of_font ()
4954 {
4955 sort_shift_bits[FONT_TYPE_INDEX] = 0;
4956 sort_shift_bits[FONT_SLANT_INDEX] = 2;
4957 sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
4958 sort_shift_bits[FONT_SIZE_INDEX] = 16;
4959 sort_shift_bits[FONT_WIDTH_INDEX] = 23;
4960 /* Note that the other elements in sort_shift_bits are not used. */
4961
4962 staticpro (&font_charset_alist);
4963 font_charset_alist = Qnil;
4964
4965 DEFSYM (Qfont_spec, "font-spec");
4966 DEFSYM (Qfont_entity, "font-entity");
4967 DEFSYM (Qfont_object, "font-object");
4968
4969 DEFSYM (Qopentype, "opentype");
4970
4971 DEFSYM (Qascii_0, "ascii-0");
4972 DEFSYM (Qiso8859_1, "iso8859-1");
4973 DEFSYM (Qiso10646_1, "iso10646-1");
4974 DEFSYM (Qunicode_bmp, "unicode-bmp");
4975 DEFSYM (Qunicode_sip, "unicode-sip");
4976
4977 DEFSYM (QCotf, ":otf");
4978 DEFSYM (QClang, ":lang");
4979 DEFSYM (QCscript, ":script");
4980 DEFSYM (QCantialias, ":antialias");
4981
4982 DEFSYM (QCfoundry, ":foundry");
4983 DEFSYM (QCadstyle, ":adstyle");
4984 DEFSYM (QCregistry, ":registry");
4985 DEFSYM (QCspacing, ":spacing");
4986 DEFSYM (QCdpi, ":dpi");
4987 DEFSYM (QCscalable, ":scalable");
4988 DEFSYM (QCavgwidth, ":avgwidth");
4989 DEFSYM (QCfont_entity, ":font-entity");
4990 DEFSYM (QCfc_unknown_spec, ":fc-unknown-spec");
4991
4992 DEFSYM (Qc, "c");
4993 DEFSYM (Qm, "m");
4994 DEFSYM (Qp, "p");
4995 DEFSYM (Qd, "d");
4996
4997 staticpro (&null_vector);
4998 null_vector = Fmake_vector (make_number (0), Qnil);
4999
5000 staticpro (&scratch_font_spec);
5001 scratch_font_spec = Ffont_spec (0, NULL);
5002 staticpro (&scratch_font_prefer);
5003 scratch_font_prefer = Ffont_spec (0, NULL);
5004
5005 #if 0
5006 #ifdef HAVE_LIBOTF
5007 staticpro (&otf_list);
5008 otf_list = Qnil;
5009 #endif /* HAVE_LIBOTF */
5010 #endif /* 0 */
5011
5012 defsubr (&Sfontp);
5013 defsubr (&Sfont_spec);
5014 defsubr (&Sfont_get);
5015 #ifdef HAVE_WINDOW_SYSTEM
5016 defsubr (&Sfont_face_attributes);
5017 #endif
5018 defsubr (&Sfont_put);
5019 defsubr (&Slist_fonts);
5020 defsubr (&Sfont_family_list);
5021 defsubr (&Sfind_font);
5022 defsubr (&Sfont_xlfd_name);
5023 defsubr (&Sclear_font_cache);
5024 defsubr (&Sfont_make_gstring);
5025 defsubr (&Sfont_fill_gstring);
5026 defsubr (&Sfont_shape_text);
5027 #if 0
5028 defsubr (&Sfont_drive_otf);
5029 defsubr (&Sfont_otf_alternates);
5030 #endif /* 0 */
5031
5032 #ifdef FONT_DEBUG
5033 defsubr (&Sopen_font);
5034 defsubr (&Sclose_font);
5035 defsubr (&Squery_font);
5036 defsubr (&Sget_font_glyphs);
5037 defsubr (&Sfont_match_p);
5038 defsubr (&Sfont_at);
5039 #if 0
5040 defsubr (&Sdraw_string);
5041 #endif
5042 #endif /* FONT_DEBUG */
5043 #ifdef HAVE_WINDOW_SYSTEM
5044 defsubr (&Sfont_info);
5045 #endif
5046
5047 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
5048 doc: /*
5049 Alist of fontname patterns vs the corresponding encoding and repertory info.
5050 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5051 where ENCODING is a charset or a char-table,
5052 and REPERTORY is a charset, a char-table, or nil.
5053
5054 If ENCODING and REPERTORY are the same, the element can have the form
5055 \(REGEXP . ENCODING).
5056
5057 ENCODING is for converting a character to a glyph code of the font.
5058 If ENCODING is a charset, encoding a character by the charset gives
5059 the corresponding glyph code. If ENCODING is a char-table, looking up
5060 the table by a character gives the corresponding glyph code.
5061
5062 REPERTORY specifies a repertory of characters supported by the font.
5063 If REPERTORY is a charset, all characters beloging to the charset are
5064 supported. If REPERTORY is a char-table, all characters who have a
5065 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5066 gets the repertory information by an opened font and ENCODING. */);
5067 Vfont_encoding_alist = Qnil;
5068
5069 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table,
5070 doc: /* Vector of valid font weight values.
5071 Each element has the form:
5072 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5073 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5074 Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
5075
5076 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table,
5077 doc: /* Vector of font slant symbols vs the corresponding numeric values.
5078 See `font-weight-table' for the format of the vector. */);
5079 Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
5080
5081 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table,
5082 doc: /* Alist of font width symbols vs the corresponding numeric values.
5083 See `font-weight-table' for the format of the vector. */);
5084 Vfont_width_table = BUILD_STYLE_TABLE (width_table);
5085
5086 staticpro (&font_style_table);
5087 font_style_table = Fmake_vector (make_number (3), Qnil);
5088 ASET (font_style_table, 0, Vfont_weight_table);
5089 ASET (font_style_table, 1, Vfont_slant_table);
5090 ASET (font_style_table, 2, Vfont_width_table);
5091
5092 DEFVAR_LISP ("font-log", &Vfont_log, doc: /*
5093 *Logging list of font related actions and results.
5094 The value t means to suppress the logging.
5095 The initial value is set to nil if the environment variable
5096 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5097 Vfont_log = Qnil;
5098
5099 #ifdef HAVE_WINDOW_SYSTEM
5100 #ifdef HAVE_FREETYPE
5101 syms_of_ftfont ();
5102 #ifdef HAVE_X_WINDOWS
5103 syms_of_xfont ();
5104 syms_of_ftxfont ();
5105 #ifdef HAVE_XFT
5106 syms_of_xftfont ();
5107 #endif /* HAVE_XFT */
5108 #endif /* HAVE_X_WINDOWS */
5109 #else /* not HAVE_FREETYPE */
5110 #ifdef HAVE_X_WINDOWS
5111 syms_of_xfont ();
5112 #endif /* HAVE_X_WINDOWS */
5113 #endif /* not HAVE_FREETYPE */
5114 #ifdef HAVE_BDFFONT
5115 syms_of_bdffont ();
5116 #endif /* HAVE_BDFFONT */
5117 #ifdef WINDOWSNT
5118 syms_of_w32font ();
5119 #endif /* WINDOWSNT */
5120 #ifdef MAC_OS
5121 syms_of_atmfont ();
5122 #endif /* MAC_OS */
5123 #endif /* HAVE_WINDOW_SYSTEM */
5124 }
5125
5126 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5127 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.