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