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