HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(Qfont_backend): Extern it.
[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
KH		 1244 Lisp_Object styles[3];
1245 char *style_names[3] = { "weight", "slant", "swidth" };
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)
2250 if (NILP (ftype) || EQ (driver_list->driver->type, ftype))
2251 {
2252 Lisp_Object cache = driver_list->driver->get_cache (frame);
2253 Lisp_Object tail = alternate_familes;
2254 Lisp_Object val;
2255
2256 xassert (CONSP (cache));
2257 ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type);
2258 ASET (spec, FONT_FAMILY_INDEX, family);
2259
2260 while (1)
2261 {
2262 val = assoc_no_quit (spec, XCDR (cache));
2263 if (CONSP (val))
2264 val = XCDR (val);
2265 else
2266 {
2267 val = driver_list->driver->list (frame, spec);
2268 if (VECTORP (val))
2269 XSETCDR (cache, Fcons (Fcons (Fcopy_sequence (spec), val),
2270 XCDR (cache)));
2271 }
2272 if (VECTORP (val) && ASIZE (val) > 0)
2273 {
2274 vec[i++] = val;
2275 break;
2276 }
2277 if (NILP (tail))
2278 break;
2279 ASET (spec, FONT_FAMILY_INDEX, XCAR (tail));
2280 tail = XCDR (tail);
2281 }
2282 }
2283 ASET (spec, FONT_TYPE_INDEX, ftype);
2284 ASET (spec, FONT_FAMILY_INDEX, family);
a9262bb8 2285 ASET (spec, FONT_SIZE_INDEX, size);
c2f5bfd6
KH		 2286 return (i > 0 ? Fvconcat (i, vec) : null_vector);
2287}
2288
2289static int num_fonts;
2290
2291static Lisp_Object
2292font_open_entity (f, entity, pixel_size)
2293 FRAME_PTR f;
2294 Lisp_Object entity;
2295 int pixel_size;
2296{
2297 struct font_driver_list *driver_list;
2298 Lisp_Object objlist, size, val;
2299 struct font *font;
2300
2301 size = AREF (entity, FONT_SIZE_INDEX);
2302 xassert (NATNUMP (size));
2303 if (XINT (size) != 0)
2304 pixel_size = XINT (size);
2305
2306 for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
2307 objlist = XCDR (objlist))
2308 {
2309 font = XSAVE_VALUE (XCAR (objlist))->pointer;
2310 if (font->pixel_size == pixel_size)
2311 {
2312 XSAVE_VALUE (XCAR (objlist))->integer++;
2313 return XCAR (objlist);
2314 }
2315 }
2316
2317 xassert (FONT_ENTITY_P (entity));
2318 val = AREF (entity, FONT_TYPE_INDEX);
2319 for (driver_list = f->font_driver_list;
2320 driver_list && ! EQ (driver_list->driver->type, val);
2321 driver_list = driver_list->next);
2322 if (! driver_list)
2323 return Qnil;
2324
2325 font = driver_list->driver->open (f, entity, pixel_size);
2326 if (! font)
2327 return Qnil;
2328 val = make_save_value (font, 1);
2329 ASET (entity, FONT_OBJLIST_INDEX,
2330 Fcons (val, AREF (entity, FONT_OBJLIST_INDEX)));
2331 num_fonts++;
2332 return val;
2333}
2334
2335void
2336font_close_object (f, font_object)
2337 FRAME_PTR f;
2338 Lisp_Object font_object;
2339{
10d16101
KH		 2340 struct font *font = XSAVE_VALUE (font_object)->pointer;
2341 Lisp_Object objlist;
c2f5bfd6
KH		 2342 Lisp_Object tail, prev = Qnil;
2343
10d16101
KH		 2344 XSAVE_VALUE (font_object)->integer--;
2345 xassert (XSAVE_VALUE (font_object)->integer >= 0);
2346 if (XSAVE_VALUE (font_object)->integer > 0)
2347 return;
2348
2349 objlist = AREF (font->entity, FONT_OBJLIST_INDEX);
c2f5bfd6
KH		 2350 for (prev = Qnil, tail = objlist; CONSP (tail);
2351 prev = tail, tail = XCDR (tail))
2352 if (EQ (font_object, XCAR (tail)))
2353 {
10d16101
KH		 2354 if (font->driver->close)
2355 font->driver->close (f, font);
2356 XSAVE_VALUE (font_object)->pointer = NULL;
2357 if (NILP (prev))
2358 ASET (font->entity, FONT_OBJLIST_INDEX, XCDR (objlist));
2359 else
2360 XSETCDR (prev, XCDR (objlist));
2361 return;
c2f5bfd6 2362 }
10d16101 2363 abort ();
c2f5bfd6
KH		 2364}
2365
2366int
1b834a8d 2367font_has_char (f, font, c)
c2f5bfd6 2368 FRAME_PTR f;
1b834a8d 2369 Lisp_Object font;
c2f5bfd6
KH		 2370 int c;
2371{
1b834a8d 2372 struct font *fontp;
c2f5bfd6 2373
1b834a8d
KH		 2374 if (FONT_ENTITY_P (font))
2375 {
2376 Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
2377 struct font_driver_list *driver_list;
2378
2379 for (driver_list = f->font_driver_list;
2380 driver_list && ! EQ (driver_list->driver->type, type);
2381 driver_list = driver_list->next);
2382 if (! driver_list)
2383 return 0;
2384 if (! driver_list->driver->has_char)
2385 return -1;
2386 return driver_list->driver->has_char (font, c);
2387 }
2388
2389 xassert (FONT_OBJECT_P (font));
2390 fontp = XSAVE_VALUE (font)->pointer;
2391
2392 if (fontp->driver->has_char)
2393 {
2394 int result = fontp->driver->has_char (fontp->entity, c);
2395
2396 if (result >= 0)
2397 return result;
2398 }
2399 return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
c2f5bfd6
KH		 2400}
2401
2402unsigned
2403font_encode_char (font_object, c)
2404 Lisp_Object font_object;
2405 int c;
2406{
2407 struct font *font = XSAVE_VALUE (font_object)->pointer;
2408
2409 return font->driver->encode_char (font, c);
2410}
2411
ef18374f 2412Lisp_Object
c2f5bfd6
KH		 2413font_get_name (font_object)
2414 Lisp_Object font_object;
2415{
2416 struct font *font = XSAVE_VALUE (font_object)->pointer;
ef18374f
KH		 2417 char *name = (font->font.full_name ? font->font.full_name
2418 : font->font.name ? font->font.name
2419 : NULL);
c2f5bfd6 2420
ef18374f
KH		 2421 return (name ? make_unibyte_string (name, strlen (name)) : null_string);
2422}
2423
2424Lisp_Object
2425font_get_spec (font_object)
2426 Lisp_Object font_object;
2427{
2428 struct font *font = XSAVE_VALUE (font_object)->pointer;
2429 Lisp_Object spec = Ffont_spec (0, NULL);
2430 int i;
2431
2432 for (i = 0; i < FONT_SIZE_INDEX; i++)
2433 ASET (spec, i, AREF (font->entity, i));
2434 ASET (spec, FONT_SIZE_INDEX, make_number (font->pixel_size));
2435 return spec;
c2f5bfd6
KH		 2436}
2437
2438Lisp_Object
2439font_get_frame (font)
2440 Lisp_Object font;
2441{
2442 if (FONT_OBJECT_P (font))
2443 font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity;
2444 xassert (FONT_ENTITY_P (font));
2445 return AREF (font, FONT_FRAME_INDEX);
2446}
2447
ef18374f
KH		 2448/* Find a font entity best matching with LFACE. If SPEC is non-nil,
2449 the font must exactly match with it. */
c2f5bfd6
KH		 2450
2451Lisp_Object
2452font_find_for_lface (f, lface, spec)
2453 FRAME_PTR f;
2454 Lisp_Object *lface;
2455 Lisp_Object spec;
2456{
ef18374f 2457 Lisp_Object frame, entities;
c2f5bfd6 2458 int i;
c2f5bfd6 2459
fe5ddfbc 2460 XSETFRAME (frame, f);
c2f5bfd6 2461
fe5ddfbc 2462 if (NILP (spec))
1b834a8d 2463 {
fe5ddfbc
KH		 2464 for (i = 0; i < FONT_SPEC_MAX; i++)
2465 ASET (scratch_font_spec, i, Qnil);
2466 ASET (scratch_font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
1b834a8d 2467
fe5ddfbc
KH		 2468 if (! NILP (lface[LFACE_FAMILY_INDEX]))
2469 font_merge_old_spec (Qnil, lface[LFACE_FAMILY_INDEX], Qnil,
2470 scratch_font_spec);
2471 entities = font_list_entities (frame, scratch_font_spec);
2472 while (ASIZE (entities) == 0)
c2f5bfd6 2473 {
fe5ddfbc
KH		 2474 /* Try without FOUNDRY or FAMILY. */
2475 if (! NILP (AREF (scratch_font_spec, FONT_FOUNDRY_INDEX)))
2476 {
2477 ASET (scratch_font_spec, FONT_FOUNDRY_INDEX, Qnil);
2478 entities = font_list_entities (frame, scratch_font_spec);
2479 }
2480 else if (! NILP (AREF (scratch_font_spec, FONT_FAMILY_INDEX)))
2481 {
2482 ASET (scratch_font_spec, FONT_FAMILY_INDEX, Qnil);
2483 entities = font_list_entities (frame, scratch_font_spec);
2484 }
2485 else
2486 break;
c2f5bfd6 2487 }
fe5ddfbc
KH		 2488 }
2489 else
2490 {
2491 for (i = 0; i < FONT_SPEC_MAX; i++)
2492 ASET (scratch_font_spec, i, AREF (spec, i));
2493 if (NILP (AREF (spec, FONT_REGISTRY_INDEX)))
2494 ASET (scratch_font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
2495 entities = font_list_entities (frame, scratch_font_spec);
c2f5bfd6
KH		 2496 }
2497
fe5ddfbc
KH		 2498 if (ASIZE (entities) == 0)
2499 return Qnil;
c2f5bfd6
KH		 2500 if (ASIZE (entities) > 1)
2501 {
fe5ddfbc 2502 /* Sort fonts by properties specified in LFACE. */
ec6fe57c 2503 Lisp_Object prefer = scratch_font_prefer;
9331887d 2504 double pt;
ef18374f 2505
fe5ddfbc
KH		 2506 if (! NILP (lface[LFACE_FAMILY_INDEX]))
2507 font_merge_old_spec (Qnil, lface[LFACE_FAMILY_INDEX], Qnil, prefer);
ef18374f 2508 ASET (prefer, FONT_WEIGHT_INDEX,
ec6fe57c 2509 font_prop_validate_style (FONT_WEIGHT_INDEX, QCweight,
ef18374f
KH		 2510 lface[LFACE_WEIGHT_INDEX]));
2511 ASET (prefer, FONT_SLANT_INDEX,
ec6fe57c 2512 font_prop_validate_style (FONT_SLANT_INDEX, QCslant,
ef18374f
KH		 2513 lface[LFACE_SLANT_INDEX]));
2514 ASET (prefer, FONT_WIDTH_INDEX,
ec6fe57c 2515 font_prop_validate_style (FONT_WIDTH_INDEX, QCwidth,
ef18374f 2516 lface[LFACE_SWIDTH_INDEX]));
9331887d
KH		 2517 pt = XINT (lface[LFACE_HEIGHT_INDEX]);
2518 ASET (prefer, FONT_SIZE_INDEX, make_float (pt / 10));
c2f5bfd6 2519
c2f5bfd6
KH		 2520 font_sort_entites (entities, prefer, frame, spec);
2521 }
2522
2523 return AREF (entities, 0);
2524}
2525
2526Lisp_Object
2527font_open_for_lface (f, lface, entity)
2528 FRAME_PTR f;
2529 Lisp_Object *lface;
2530 Lisp_Object entity;
2531{
9331887d
KH		 2532 double pt = XINT (lface[LFACE_HEIGHT_INDEX]);
2533 int size;
c2f5bfd6 2534
9331887d
KH		 2535 pt /= 10;
2536 size = POINT_TO_PIXEL (pt, f->resy);
c2f5bfd6
KH		 2537 return font_open_entity (f, entity, size);
2538}
2539
2540void
2541font_load_for_face (f, face)
2542 FRAME_PTR f;
2543 struct face *face;
2544{
ef18374f 2545 Lisp_Object font_object = face->lface[LFACE_FONT_INDEX];
c2f5bfd6 2546
ef18374f 2547 if (NILP (font_object))
c2f5bfd6 2548 {
ef18374f 2549 Lisp_Object entity = font_find_for_lface (f, face->lface, Qnil);
c2f5bfd6 2550
ef18374f
KH		 2551 if (! NILP (entity))
2552 font_object = font_open_for_lface (f, face->lface, entity);
2553 }
c2f5bfd6 2554
ef18374f
KH		 2555 if (! NILP (font_object))
2556 {
2557 struct font *font = XSAVE_VALUE (font_object)->pointer;
2558
2559 face->font = font->font.font;
2560 face->font_info = (struct font_info *) font;
2561 face->font_info_id = 0;
2562 face->font_name = font->font.full_name;
2563 }
2564 else
2565 {
2566 face->font = NULL;
2567 face->font_info = NULL;
2568 face->font_info_id = -1;
2569 face->font_name = NULL;
2570 add_to_log ("Unable to load font for a face%s", null_string, Qnil);
c2f5bfd6 2571 }
c2f5bfd6
KH		 2572}
2573
2574void
2575font_prepare_for_face (f, face)
2576 FRAME_PTR f;
2577 struct face *face;
2578{
2579 struct font *font = (struct font *) face->font_info;
2580
2581 if (font->driver->prepare_face)
2582 font->driver->prepare_face (f, face);
2583}
2584
2585void
2586font_done_for_face (f, face)
2587 FRAME_PTR f;
2588 struct face *face;
2589{
2590 struct font *font = (struct font *) face->font_info;
2591
2592 if (font->driver->done_face)
2593 font->driver->done_face (f, face);
2594 face->extra = NULL;
2595}
2596
2597Lisp_Object
2598font_open_by_name (f, name)
2599 FRAME_PTR f;
2600 char *name;
2601{
ef18374f 2602 Lisp_Object args[2];
a9262bb8 2603 Lisp_Object spec, prefer, size, entities;
c2f5bfd6 2604 Lisp_Object frame;
a9262bb8 2605 int i;
ef18374f 2606 int pixel_size;
c2f5bfd6
KH		 2607
2608 XSETFRAME (frame, f);
a9262bb8 2609
ef18374f
KH		 2610 args[0] = QCname;
2611 args[1] = make_unibyte_string (name, strlen (name));
2612 spec = Ffont_spec (2, args);
a9262bb8
KH		 2613 prefer = scratch_font_prefer;
2614 for (i = FONT_WEIGHT_INDEX; i < FONT_SIZE_INDEX; i++)
2615 if (NILP (AREF (spec, i)))
2616 ASET (prefer, i, make_number (100));
2617 size = AREF (spec, FONT_SIZE_INDEX);
2618 if (NILP (size))
2619 pixel_size = 0;
2620 else if (INTEGERP (size))
2621 pixel_size = XINT (size);
2622 else /* FLOATP (size) */
ef18374f 2623 {
9331887d 2624 double pt = XFLOAT_DATA (size);
a9262bb8
KH		 2625
2626 pixel_size = POINT_TO_PIXEL (pt, f->resy);
2627 size = make_number (pixel_size);
2628 ASET (spec, FONT_SIZE_INDEX, size);
ef18374f 2629 }
a9262bb8 2630 if (pixel_size == 0)
ef18374f 2631 {
9331887d 2632 pixel_size = POINT_TO_PIXEL (12.0, f->resy);
a9262bb8 2633 size = make_number (pixel_size);
ef18374f 2634 }
a9262bb8 2635 ASET (prefer, FONT_SIZE_INDEX, size);
9331887d
KH		 2636 if (NILP (AREF (spec, FONT_REGISTRY_INDEX)))
2637 ASET (spec, FONT_REGISTRY_INDEX, Qiso8859_1);
a9262bb8
KH		 2638
2639 entities = Flist_fonts (spec, frame, make_number (1), prefer);
2640 return (NILP (entities)
2641 ? Qnil
2642 : font_open_entity (f, XCAR (entities), pixel_size));
c2f5bfd6
KH		 2643}
2644
2645
2646/* Register font-driver DRIVER. This function is used in two ways.
2647
2648 The first is with frame F non-NULL. In this case, DRIVER is
2649 registered to be used for drawing characters on F. All frame
2650 creaters (e.g. Fx_create_frame) must call this function at least
2651 once with an available font-driver.
2652
2653 The second is with frame F NULL. In this case, DRIVER is globally
2654 registered in the variable `font_driver_list'. All font-driver
2655 implementations must call this function in its syms_of_XXXX
2656 (e.g. syms_of_xfont). */
2657
2658void
2659register_font_driver (driver, f)
2660 struct font_driver *driver;
2661 FRAME_PTR f;
2662{
2663 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
2664 struct font_driver_list *prev, *list;
2665
2666 if (f && ! driver->draw)
2667 error ("Unsable font driver for a frame: %s",
2668 SDATA (SYMBOL_NAME (driver->type)));
2669
2670 for (prev = NULL, list = root; list; prev = list, list = list->next)
2671 if (list->driver->type == driver->type)
2672 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
2673
2674 list = malloc (sizeof (struct font_driver_list));
2675 list->driver = driver;
2676 list->next = NULL;
2677 if (prev)
2678 prev->next = list;
2679 else if (f)
2680 f->font_driver_list = list;
2681 else
2682 font_driver_list = list;
2683 num_font_drivers++;
2684}
2685
2686/* Free font-driver list on frame F. It doesn't free font-drivers
2687 themselves. */
2688
2689void
2690free_font_driver_list (f)
2691 FRAME_PTR f;
2692{
2693 while (f->font_driver_list)
2694 {
2695 struct font_driver_list *next = f->font_driver_list->next;
2696
2697 free (f->font_driver_list);
2698 f->font_driver_list = next;
2699 }
2700}
2701
10d16101
KH		 2702Lisp_Object
2703font_at (c, pos, face, w, object)
2704 int c;
2705 EMACS_INT pos;
2706 struct face *face;
2707 struct window *w;
2708 Lisp_Object object;
2709{
2710 FRAME_PTR f;
2711 int face_id;
2712 int dummy;
2713
2714 f = XFRAME (w->frame);
2715 if (! face)
2716 {
2717 if (STRINGP (object))
2718 face_id = face_at_string_position (w, object, pos, 0, -1, -1, &dummy,
2719 DEFAULT_FACE_ID, 0);
2720 else
2721 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy,
2722 pos + 100, 0);
2723 face = FACE_FROM_ID (f, face_id);
2724 }
2725 face_id = FACE_FOR_CHAR (f, face, c, pos, object);
2726 face = FACE_FROM_ID (f, face_id);
2727 if (! face->font_info)
2728 return Qnil;
2729 return font_lispy_object ((struct font *) face->font_info);
2730}
2731
c2f5bfd6
KH		 2732\f
2733/* Lisp API */
2734
2735DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0,
2736 doc: /* Return t if object is a font-spec or font-entity. */)
2737 (object)
2738 Lisp_Object object;
2739{
2740 return (FONTP (object) ? Qt : Qnil);
2741}
2742
2743DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
2744 doc: /* Return a newly created font-spec with specified arguments as properties.
2745usage: (font-spec &rest properties) */)
2746 (nargs, args)
2747 int nargs;
2748 Lisp_Object *args;
2749{
2750 Lisp_Object spec = Fmake_vector (make_number (FONT_SPEC_MAX), Qnil);
c2f5bfd6
KH		 2751 int i;
2752
2753 for (i = 0; i < nargs; i += 2)
2754 {
2755 enum font_property_index prop;
2756 Lisp_Object key = args[i], val = args[i + 1];
2757
ec6fe57c 2758 prop = get_font_prop_index (key, 0);
c2f5bfd6 2759 if (prop < FONT_EXTRA_INDEX)
ec6fe57c 2760 ASET (spec, prop, val);
c2f5bfd6 2761 else
4485a28e
KH		 2762 {
2763 if (EQ (key, QCname))
ec6fe57c
KH		 2764 {
2765 CHECK_STRING (val);
2766 font_parse_name ((char *) SDATA (val), spec);
2767 }
9331887d 2768 else
ec6fe57c 2769 font_put_extra (spec, key, val);
4485a28e 2770 }
c2f5bfd6 2771 }
ec6fe57c 2772 CHECK_VALIDATE_FONT_SPEC (spec);
c2f5bfd6
KH		 2773 return spec;
2774}
2775
2776
2777DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
2778 doc: /* Return the value of FONT's PROP property.
2779FONT may be a font-spec or font-entity.
2780If FONT is font-entity and PROP is :extra, always nil is returned. */)
2781 (font, prop)
2782 Lisp_Object font, prop;
2783{
2784 enum font_property_index idx;
2785
10d16101
KH		 2786 if (FONT_OBJECT_P (font))
2787 font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity;
2788 else
2789 CHECK_FONT (font);
ec6fe57c 2790 idx = get_font_prop_index (prop, 0);
c2f5bfd6
KH		 2791 if (idx < FONT_EXTRA_INDEX)
2792 return AREF (font, idx);
2793 if (FONT_ENTITY_P (font))
2794 return Qnil;
2795 return Fcdr (Fassoc (AREF (font, FONT_EXTRA_INDEX), prop));
2796}
2797
2798
2799DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
2800 doc: /* Set one property of FONT-SPEC: give property PROP value VALUE. */)
2801 (font_spec, prop, val)
2802 Lisp_Object font_spec, prop, val;
2803{
2804 enum font_property_index idx;
2805 Lisp_Object extra, slot;
2806
2807 CHECK_FONT_SPEC (font_spec);
ec6fe57c 2808 idx = get_font_prop_index (prop, 0);
c2f5bfd6
KH		 2809 if (idx < FONT_EXTRA_INDEX)
2810 return ASET (font_spec, idx, val);
2811 extra = AREF (font_spec, FONT_EXTRA_INDEX);
2812 slot = Fassoc (extra, prop);
2813 if (NILP (slot))
2814 extra = Fcons (Fcons (prop, val), extra);
2815 else
2816 Fsetcdr (slot, val);
2817 return val;
2818}
2819
2820DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
2821 doc: /* List available fonts matching FONT-SPEC on the current frame.
2822Optional 2nd argument FRAME specifies the target frame.
2823Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
ec6fe57c
KH		 2824Optional 4th argument PREFER, if non-nil, is a font-spec
2825to which closeness fonts are sorted. */)
c2f5bfd6
KH		 2826 (font_spec, frame, num, prefer)
2827 Lisp_Object font_spec, frame, num, prefer;
2828{
2829 Lisp_Object vec, list, tail;
2830 int n = 0, i, len;
2831
2832 if (NILP (frame))
2833 frame = selected_frame;
2834 CHECK_LIVE_FRAME (frame);
2835 CHECK_VALIDATE_FONT_SPEC (font_spec);
2836 if (! NILP (num))
2837 {
2838 CHECK_NUMBER (num);
2839 n = XINT (num);
2840 if (n <= 0)
2841 return Qnil;
2842 }
2843 if (! NILP (prefer))
2844 CHECK_FONT (prefer);
2845
2846 vec = font_list_entities (frame, font_spec);
2847 len = ASIZE (vec);
2848 if (len == 0)
2849 return Qnil;
2850 if (len == 1)
2851 return Fcons (AREF (vec, 0), Qnil);
2852
2853 if (! NILP (prefer))
2854 vec = font_sort_entites (vec, prefer, frame, font_spec);
2855
2856 list = tail = Fcons (AREF (vec, 0), Qnil);
2857 if (n == 0 || n > len)
2858 n = len;
2859 for (i = 1; i < n; i++)
2860 {
2861 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
2862
2863 XSETCDR (tail, val);
2864 tail = val;
2865 }
2866 return list;
2867}
2868
2869DEFUN ("list-families", Flist_families, Slist_families, 0, 1, 0,
2870 doc: /* List available font families on the current frame.
2871Optional 2nd argument FRAME specifies the target frame. */)
2872 (frame)
2873 Lisp_Object frame;
2874{
2875 FRAME_PTR f;
2876 struct font_driver_list *driver_list;
2877 Lisp_Object list;
2878
2879 if (NILP (frame))
2880 frame = selected_frame;
2881 CHECK_LIVE_FRAME (frame);
2882 f = XFRAME (frame);
2883 list = Qnil;
2884 for (driver_list = f->font_driver_list; driver_list;
2885 driver_list = driver_list->next)
2886 if (driver_list->driver->list_family)
2887 {
2888 Lisp_Object val = driver_list->driver->list_family (frame);
2889
2890 if (NILP (list))
2891 list = val;
2892 else
2893 {
2894 Lisp_Object tail = list;
2895
2896 for (; CONSP (val); val = XCDR (val))
2897 if (NILP (Fmemq (XCAR (val), tail)))
2898 list = Fcons (XCAR (val), list);
2899 }
2900 }
2901 return list;
2902}
2903
2904DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
2905 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
2906Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
2907 (font_spec, frame)
2908 Lisp_Object font_spec, frame;
2909{
2910 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
2911
2912 if (CONSP (val))
2913 val = XCAR (val);
2914 return val;
2915}
2916
2917DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 1, 0,
2918 doc: /* Return XLFD name of FONT.
2919FONT is a font-spec, font-entity, or font-object.
2920If the name is too long for XLFD (maximum 255 chars), return nil. */)
2921 (font)
2922 Lisp_Object font;
2923{
2924 char name[256];
2925 int pixel_size = 0;
2926
2927 if (FONT_SPEC_P (font))
2928 CHECK_VALIDATE_FONT_SPEC (font);
2929 else if (FONT_ENTITY_P (font))
2930 CHECK_FONT (font);
2931 else
2932 {
2933 struct font *fontp;
2934
2935 CHECK_FONT_GET_OBJECT (font, fontp);
2936 font = fontp->entity;
2937 pixel_size = fontp->pixel_size;
2938 }
2939
2940 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
2941 return Qnil;
2942 return build_string (name);
2943}
2944
2945DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
2946 doc: /* Clear font cache. */)
2947 ()
2948{
2949 Lisp_Object list, frame;
2950
2951 FOR_EACH_FRAME (list, frame)
2952 {
2953 FRAME_PTR f = XFRAME (frame);
2954 struct font_driver_list *driver_list = f->font_driver_list;
2955
2956 for (; driver_list; driver_list = driver_list->next)
2957 {
2958 Lisp_Object cache = driver_list->driver->get_cache (frame);
2959 Lisp_Object tail, elt;
2960
2961 for (tail = XCDR (cache); CONSP (tail); tail = XCDR (tail))
2962 {
2963 elt = XCAR (tail);
2964 if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
2965 {
2966 Lisp_Object vec = XCDR (elt);
2967 int i;
2968
2969 for (i = 0; i < ASIZE (vec); i++)
2970 {
2971 Lisp_Object entity = AREF (vec, i);
2972 Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
2973
2974 for (; CONSP (objlist); objlist = XCDR (objlist))
2975 {
2976 Lisp_Object val = XCAR (objlist);
2977 struct Lisp_Save_Value *p = XSAVE_VALUE (val);
2978 struct font *font = p->pointer;
2979
2980 xassert (font
2981 && driver_list->driver == font->driver);
2982 driver_list->driver->close (f, font);
2983 p->pointer = NULL;
2984 p->integer = 0;
2985 }
2986 if (driver_list->driver->free_entity)
2987 driver_list->driver->free_entity (entity);
2988 }
2989 }
2990 }
2991 XSETCDR (cache, Qnil);
2992 }
2993 }
2994
2995 return Qnil;
2996}
2997
2998DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table,
2999 Sinternal_set_font_style_table, 2, 2, 0,
3000 doc: /* Set font style table for PROP to TABLE.
3001PROP must be `:weight', `:slant', or `:width'.
3002TABLE must be an alist of symbols vs the corresponding numeric values
3003sorted by numeric values. */)
3004 (prop, table)
3005 Lisp_Object prop, table;
3006{
3007 int table_index;
3008 int numeric;
3009 Lisp_Object tail, val;
3010
3011 CHECK_SYMBOL (prop);
3012 table_index = (EQ (prop, QCweight) ? 0
3013 : EQ (prop, QCslant) ? 1
3014 : EQ (prop, QCwidth) ? 2
3015 : 3);
3016 if (table_index >= ASIZE (font_style_table))
3017 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop)));
3018 table = Fcopy_sequence (table);
3019 numeric = -1;
3020 for (tail = table; ! NILP (tail); tail = Fcdr (tail))
3021 {
3022 prop = Fcar (Fcar (tail));
3023 val = Fcdr (Fcar (tail));
3024 CHECK_SYMBOL (prop);
3025 CHECK_NATNUM (val);
3026 if (numeric > XINT (val))
3027 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop)));
3028 numeric = XINT (val);
3029 XSETCAR (tail, Fcons (prop, val));
3030 }
3031 ASET (font_style_table, table_index, table);
3032 return Qnil;
3033}
3034
3035DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0,
3036 doc: /* Return a newly created glyph-string for FONT-OBJECT with NUM glyphs.
3037FONT-OBJECT may be nil if it is not yet known. */)
3038 (font_object, num)
3039 Lisp_Object font_object, num;
3040{
3041 Lisp_Object gstring, g;
3042 int len;
3043 int i;
3044
3045 if (! NILP (font_object))
3046 CHECK_FONT_OBJECT (font_object);
3047 CHECK_NATNUM (num);
3048
3049 len = XINT (num) + 1;
3050 gstring = Fmake_vector (make_number (len), Qnil);
3051 g = Fmake_vector (make_number (6), Qnil);
3052 ASET (g, 0, font_object);
3053 ASET (gstring, 0, g);
3054 for (i = 1; i < len; i++)
10d16101 3055 ASET (gstring, i, Fmake_vector (make_number (8), Qnil));
c2f5bfd6
KH		 3056 return gstring;
3057}
3058
3059DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
3060 doc: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3061START and END specifies the region to extract characters.
3062If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3063where to extract characters.
3064FONT-OBJECT may be nil if GSTRING already already contains one. */)
3065 (gstring, font_object, start, end, object)
3066 Lisp_Object gstring, font_object, start, end, object;
3067{
3068 int len, i, c;
3069 unsigned code;
3070 struct font *font;
3071
3072 CHECK_VECTOR (gstring);
3073 if (NILP (font_object))
10d16101 3074 font_object = LGSTRING_FONT (gstring);
c2f5bfd6
KH		 3075 CHECK_FONT_GET_OBJECT (font_object, font);
3076
3077 if (STRINGP (object))
3078 {
3079 const unsigned char *p;
3080
3081 CHECK_NATNUM (start);
3082 CHECK_NATNUM (end);
3083 if (XINT (start) > XINT (end)
3084 || XINT (end) > ASIZE (object)
10d16101 3085 || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
c2f5bfd6
KH		 3086 args_out_of_range (start, end);
3087
3088 len = XINT (end) - XINT (start);
3089 p = SDATA (object) + string_char_to_byte (object, XINT (start));
3090 for (i = 0; i < len; i++)
3091 {
3092 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
3093
3094 c = STRING_CHAR_ADVANCE (p);
3095 code = font->driver->encode_char (font, c);
3096 if (code > MOST_POSITIVE_FIXNUM)
3097 error ("Glyph code 0x%X is too large", code);
10d16101
KH		 3098 LGLYPH_SET_FROM (g, make_number (i));
3099 LGLYPH_SET_TO (g, make_number (i + 1));
c2f5bfd6
KH		 3100 LGLYPH_SET_CHAR (g, make_number (c));
3101 LGLYPH_SET_CODE (g, make_number (code));
3102 }
3103 }
3104 else
3105 {
3106 int pos, pos_byte;
3107
3108 if (! NILP (object))
3109 Fset_buffer (object);
3110 validate_region (&start, &end);
10d16101 3111 if (XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
c2f5bfd6
KH		 3112 args_out_of_range (start, end);
3113 len = XINT (end) - XINT (start);
3114 pos = XINT (start);
3115 pos_byte = CHAR_TO_BYTE (pos);
3116 for (i = 0; i < len; i++)
3117 {
3118 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
3119
3120 FETCH_CHAR_ADVANCE (c, pos, pos_byte);
3121 code = font->driver->encode_char (font, c);
3122 if (code > MOST_POSITIVE_FIXNUM)
3123 error ("Glyph code 0x%X is too large", code);
10d16101
KH		 3124 LGLYPH_SET_FROM (g, make_number (i));
3125 LGLYPH_SET_TO (g, make_number (i + 1));
c2f5bfd6
KH		 3126 LGLYPH_SET_CHAR (g, make_number (c));
3127 LGLYPH_SET_CODE (g, make_number (code));
3128 }
3129 }
10d16101
KH		 3130 for (i = LGSTRING_LENGTH (gstring) - 1; i >= len; i--)
3131 {
3132 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
3133
3134 LGLYPH_SET_FROM (g, Qnil);
3135 }
c2f5bfd6
KH		 3136 return Qnil;
3137}
3138
3139
3140#ifdef FONT_DEBUG
3141
3142DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
3143 doc: /* Open FONT-ENTITY. */)
3144 (font_entity, size, frame)
3145 Lisp_Object font_entity;
3146 Lisp_Object size;
3147 Lisp_Object frame;
3148{
3149 int isize;
3150
3151 CHECK_FONT_ENTITY (font_entity);
3152 if (NILP (size))
3153 size = AREF (font_entity, FONT_SIZE_INDEX);
3154 CHECK_NUMBER (size);
3155 if (NILP (frame))
3156 frame = selected_frame;
3157 CHECK_LIVE_FRAME (frame);
3158
3159 isize = XINT (size);
3160 if (isize < 0)
3161 isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
3162
3163 return font_open_entity (XFRAME (frame), font_entity, isize);
3164}
3165
3166DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
3167 doc: /* Close FONT-OBJECT. */)
3168 (font_object, frame)
3169 Lisp_Object font_object, frame;
3170{
3171 CHECK_FONT_OBJECT (font_object);
3172 if (NILP (frame))
3173 frame = selected_frame;
3174 CHECK_LIVE_FRAME (frame);
3175 font_close_object (XFRAME (frame), font_object);
3176 return Qnil;
3177}
3178
3179DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
3180 doc: /* Return information about FONT-OBJECT. */)
3181 (font_object)
3182 Lisp_Object font_object;
3183{
3184 struct font *font;
3185 Lisp_Object val;
3186
3187 CHECK_FONT_GET_OBJECT (font_object, font);
3188
3189 val = Fmake_vector (make_number (9), Qnil);
3190 ASET (val, 0, Ffont_xlfd_name (font_object));
3191 if (font->file_name)
3192 ASET (val, 1, make_unibyte_string (font->file_name,
3193 strlen (font->file_name)));
3194 ASET (val, 2, make_number (font->pixel_size));
3195 ASET (val, 3, make_number (font->font.size));
3196 ASET (val, 4, make_number (font->ascent));
3197 ASET (val, 5, make_number (font->descent));
3198 ASET (val, 6, make_number (font->font.space_width));
3199 ASET (val, 7, make_number (font->font.average_width));
3200 if (font->driver->otf_capability)
3201 ASET (val, 8, font->driver->otf_capability (font));
3202 return val;
3203}
3204
3205DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
3206 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3207Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3208 (font_object, string)
3209 Lisp_Object font_object, string;
3210{
3211 struct font *font;
3212 int i, len;
3213 Lisp_Object vec;
3214
3215 CHECK_FONT_GET_OBJECT (font_object, font);
3216 CHECK_STRING (string);
3217 len = SCHARS (string);
3218 vec = Fmake_vector (make_number (len), Qnil);
3219 for (i = 0; i < len; i++)
3220 {
3221 Lisp_Object ch = Faref (string, make_number (i));
3222 Lisp_Object val;
3223 int c = XINT (ch);
3224 unsigned code;
3225 struct font_metrics metrics;
3226
3227 code = font->driver->encode_char (font, c);
3228 if (code == FONT_INVALID_CODE)
3229 continue;
3230 val = Fmake_vector (make_number (6), Qnil);
3231 if (code <= MOST_POSITIVE_FIXNUM)
3232 ASET (val, 0, make_number (code));
3233 else
3234 ASET (val, 0, Fcons (make_number (code >> 16),
3235 make_number (code & 0xFFFF)));
3236 font->driver->text_extents (font, &code, 1, &metrics);
3237 ASET (val, 1, make_number (metrics.lbearing));
3238 ASET (val, 2, make_number (metrics.rbearing));
3239 ASET (val, 3, make_number (metrics.width));
3240 ASET (val, 4, make_number (metrics.ascent));
3241 ASET (val, 5, make_number (metrics.descent));
3242 ASET (vec, i, val);
3243 }
3244 return vec;
3245}
3246
ec6fe57c
KH		 3247DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
3248 doc: /* Return t iff font-spec SPEC matches with FONT.
3249FONT is a font-spec, font-entity, or font-object. */)
3250 (spec, font)
3251 Lisp_Object spec, font;
3252{
3253 CHECK_FONT_SPEC (spec);
3254 if (FONT_OBJECT_P (font))
3255 font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity;
3256 else if (! FONT_ENTITY_P (font))
3257 CHECK_FONT_SPEC (font);
3258
3259 return (font_match_p (spec, font) ? Qt : Qnil);
3260}
3261
10d16101
KH		 3262DEFUN ("font-at", Ffont_at, Sfont_at, 1, 2, 0,
3263 doc: /* Return a font-object for displaying a character at POSISTION.
3264Optional second arg WINDOW, if non-nil, is a window displaying
3265the current buffer. It defaults to the currently selected window. */)
3266 (position, window)
3267 Lisp_Object position, window;
3268{
3269 struct window *w;
3270 EMACS_INT pos, pos_byte;
3271 int c;
3272
3273 CHECK_NUMBER_COERCE_MARKER (position);
3274 pos = XINT (position);
3275 if (pos < BEGV || pos >= ZV)
3276 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
3277 pos_byte = CHAR_TO_BYTE (pos);
3278 c = FETCH_CHAR (pos_byte);
3279 if (NILP (window))
3280 window = selected_window;
3281 CHECK_LIVE_WINDOW (window);
3282 w = XWINDOW (selected_window);
3283
3284 return font_at (c, pos, NULL, w, Qnil);
3285}
3286
c2f5bfd6
KH		 3287#if 0
3288DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
3289 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
3290The value is a number of glyphs drawn.
3291Type C-l to recover what previously shown. */)
3292 (font_object, string)
3293 Lisp_Object font_object, string;
3294{
3295 Lisp_Object frame = selected_frame;
3296 FRAME_PTR f = XFRAME (frame);
3297 struct font *font;
3298 struct face *face;
3299 int i, len, width;
3300 unsigned *code;
3301
3302 CHECK_FONT_GET_OBJECT (font_object, font);
3303 CHECK_STRING (string);
3304 len = SCHARS (string);
3305 code = alloca (sizeof (unsigned) * len);
3306 for (i = 0; i < len; i++)
3307 {
3308 Lisp_Object ch = Faref (string, make_number (i));
3309 Lisp_Object val;
3310 int c = XINT (ch);
3311
3312 code[i] = font->driver->encode_char (font, c);
3313 if (code[i] == FONT_INVALID_CODE)
3314 break;
3315 }
3316 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
3317 face->fontp = font;
3318 if (font->driver->prepare_face)
3319 font->driver->prepare_face (f, face);
3320 width = font->driver->text_extents (font, code, i, NULL);
3321 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
3322 if (font->driver->done_face)
3323 font->driver->done_face (f, face);
3324 face->fontp = NULL;
3325 return make_number (len);
3326}
3327#endif
3328
3329#endif /* FONT_DEBUG */
3330
3331\f
3332extern void syms_of_ftfont P_ (());
3333extern void syms_of_xfont P_ (());
3334extern void syms_of_xftfont P_ (());
3335extern void syms_of_ftxfont P_ (());
3336extern void syms_of_bdffont P_ (());
3337extern void syms_of_w32font P_ (());
3338extern void syms_of_atmfont P_ (());
3339
3340void
3341syms_of_font ()
3342{
3343 sort_shift_bits[FONT_SLANT_INDEX] = 0;
3344 sort_shift_bits[FONT_WEIGHT_INDEX] = 7;
3345 sort_shift_bits[FONT_SIZE_INDEX] = 14;
3346 sort_shift_bits[FONT_WIDTH_INDEX] = 21;
3347 sort_shift_bits[FONT_ADSTYLE_INDEX] = 28;
3348 sort_shift_bits[FONT_FOUNDRY_INDEX] = 29;
3349 sort_shift_bits[FONT_FAMILY_INDEX] = 30;
3350 sort_shift_bits[FONT_REGISTRY_INDEX] = 31;
fe5ddfbc 3351 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
c2f5bfd6
KH		 3352
3353 staticpro (&font_style_table);
3354 font_style_table = Fmake_vector (make_number (3), Qnil);
3355
3356 staticpro (&font_family_alist);
3357 font_family_alist = Qnil;
3358
3359 DEFSYM (Qfontp, "fontp");
3360
1bb1d99b
KH		 3361 DEFSYM (Qiso8859_1, "iso8859-1");
3362 DEFSYM (Qiso10646_1, "iso10646-1");
3363 DEFSYM (Qunicode_bmp, "unicode-bmp");
3364
c2f5bfd6
KH		 3365 DEFSYM (QCotf, ":otf");
3366 DEFSYM (QClanguage, ":language");
3367 DEFSYM (QCscript, ":script");
3368
3369 DEFSYM (QCfoundry, ":foundry");
3370 DEFSYM (QCadstyle, ":adstyle");
3371 DEFSYM (QCregistry, ":registry");
9331887d
KH		 3372 DEFSYM (QCspacing, ":spacing");
3373 DEFSYM (QCdpi, ":dpi");
ec6fe57c 3374 DEFSYM (QCscalable, ":scalable");
c2f5bfd6
KH		 3375 DEFSYM (QCextra, ":extra");
3376
ec6fe57c
KH		 3377 DEFSYM (Qc, "c");
3378 DEFSYM (Qm, "m");
3379 DEFSYM (Qp, "p");
3380 DEFSYM (Qd, "d");
3381
c2f5bfd6
KH		 3382 staticpro (&null_string);
3383 null_string = build_string ("");
3384 staticpro (&null_vector);
3385 null_vector = Fmake_vector (make_number (0), Qnil);
3386
3387 staticpro (&scratch_font_spec);
3388 scratch_font_spec = Ffont_spec (0, NULL);
3389 staticpro (&scratch_font_prefer);
3390 scratch_font_prefer = Ffont_spec (0, NULL);
3391
3392 defsubr (&Sfontp);
3393 defsubr (&Sfont_spec);
3394 defsubr (&Sfont_get);
3395 defsubr (&Sfont_put);
3396 defsubr (&Slist_fonts);
3397 defsubr (&Slist_families);
3398 defsubr (&Sfind_font);
3399 defsubr (&Sfont_xlfd_name);
3400 defsubr (&Sclear_font_cache);
3401 defsubr (&Sinternal_set_font_style_table);
3402 defsubr (&Sfont_make_gstring);
3403 defsubr (&Sfont_fill_gstring);
3404
3405#ifdef FONT_DEBUG
3406 defsubr (&Sopen_font);
3407 defsubr (&Sclose_font);
3408 defsubr (&Squery_font);
3409 defsubr (&Sget_font_glyphs);
ec6fe57c 3410 defsubr (&Sfont_match_p);
10d16101 3411 defsubr (&Sfont_at);
c2f5bfd6
KH		 3412#if 0
3413 defsubr (&Sdraw_string);
3414#endif
3415#endif /* FONT_DEBUG */
3416
3417#ifdef HAVE_FREETYPE
3418 syms_of_ftfont ();
3419#ifdef HAVE_X_WINDOWS
3420 syms_of_xfont ();
3421 syms_of_ftxfont ();
3422#ifdef HAVE_XFT
3423 syms_of_xftfont ();
3424#endif /* HAVE_XFT */
3425#endif /* HAVE_X_WINDOWS */
3426#else /* not HAVE_FREETYPE */
3427#ifdef HAVE_X_WINDOWS
3428 syms_of_xfont ();
3429#endif /* HAVE_X_WINDOWS */
3430#endif /* not HAVE_FREETYPE */
3431#ifdef HAVE_BDFFONT
3432 syms_of_bdffont ();
3433#endif /* HAVE_BDFFONT */
3434#ifdef WINDOWSNT
3435 syms_of_w32font ();
3436#endif /* WINDOWSNT */
3437#ifdef MAC_OS
3438 syms_of_atmfont ();
3439#endif /* MAC_OS */
3440}
885b7d09
MB		 3441
3442/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
3443 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.