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