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