90400
|
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
|
|
7 This file is part of GNU Emacs.
|
|
8
|
|
9 GNU Emacs is free software; you can redistribute it and/or modify
|
|
10 it under the terms of the GNU General Public License as published by
|
|
11 the Free Software Foundation; either version 2, or (at your option)
|
|
12 any later version.
|
|
13
|
|
14 GNU Emacs is distributed in the hope that it will be useful,
|
|
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
17 GNU General Public License for more details.
|
|
18
|
|
19 You should have received a copy of the GNU General Public License
|
|
20 along with GNU Emacs; see the file COPYING. If not, write to
|
|
21 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
22 Boston, 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"
|
|
32 #include "dispextern.h"
|
|
33 #include "charset.h"
|
|
34 #include "character.h"
|
|
35 #include "composite.h"
|
|
36 #include "fontset.h"
|
|
37 #include "font.h"
|
|
38
|
|
39 #define FONT_DEBUG
|
|
40
|
|
41 #ifdef FONT_DEBUG
|
|
42 #undef xassert
|
|
43 #define xassert(X) do {if (!(X)) abort ();} while (0)
|
|
44 #else
|
|
45 #define xassert(X) (void) 0
|
|
46 #endif
|
|
47
|
|
48 int enable_font_backend;
|
|
49
|
|
50 Lisp_Object Qfontp;
|
|
51
|
|
52 /* Like CHECK_FONT_SPEC but also validate properties of the font-spec,
|
|
53 and set X to the validated result. */
|
|
54
|
|
55 #define CHECK_VALIDATE_FONT_SPEC(x) \
|
|
56 do { \
|
|
57 if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); \
|
|
58 x = font_prop_validate (x); \
|
|
59 } while (0)
|
|
60
|
|
61 /* Number of pt per inch (from the TeXbook). */
|
|
62 #define PT_PER_INCH 72.27
|
|
63
|
|
64 /* Return a pixel size corresponding to POINT size (1/10 pt unit) on
|
|
65 resolution RESY. */
|
|
66 #define POINT_TO_PIXEL(POINT, RESY) ((POINT) * (RESY) / PT_PER_INCH / 10 + 0.5)
|
|
67
|
|
68 #define PIXEL_TO_POINT(PIXEL, RESY) ((PIXEL) * PT_PER_INCH * 10 / (RESY) + 0.5)
|
|
69
|
|
70 /* Special string of zero length. It is used to specify a NULL name
|
|
71 in a font properties (e.g. adstyle). We don't use the symbol of
|
|
72 NULL name because it's confusing (Lisp printer prints nothing for
|
|
73 it). */
|
|
74 Lisp_Object null_string;
|
|
75
|
|
76 /* Special vector of zero length. This is repeatedly used by (struct
|
|
77 font_driver *)->list when a specified font is not found. */
|
|
78 Lisp_Object null_vector;
|
|
79
|
|
80 /* Vector of 3 elements. Each element is an alist for one of font
|
|
81 style properties (weight, slant, width). The alist contains a
|
|
82 mapping between symbolic property values (e.g. `medium' for weight)
|
|
83 and numeric property values (e.g. 100). So, it looks like this:
|
|
84 [((thin . 0) ... (heavy . 210))
|
|
85 ((ro . 0) ... (ot . 210))
|
|
86 ((ultracondensed . 50) ... (wide . 200))] */
|
|
87 static Lisp_Object font_style_table;
|
|
88
|
|
89 /* Alist of font family vs the corresponding aliases.
|
|
90 Each element has this form:
|
|
91 (FAMILY ALIAS1 ALIAS2 ...) */
|
|
92
|
|
93 static Lisp_Object font_family_alist;
|
|
94
|
|
95 /* Symbols representing keys of normal font properties. */
|
|
96 extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth, QCsize, QCname;
|
|
97 Lisp_Object QCfoundry, QCadstyle, QCregistry, QCextra;
|
|
98 /* Symbols representing keys of font extra info. */
|
|
99 Lisp_Object QCotf, QClanguage, QCscript;
|
|
100
|
|
101 /* List of all font drivers. All font-backends (XXXfont.c) call
|
|
102 add_font_driver in syms_of_XXXfont to register the font-driver
|
|
103 here. */
|
|
104 static struct font_driver_list *font_driver_list;
|
|
105
|
|
106 static Lisp_Object prop_name_to_numeric P_ ((enum font_property_index,
|
|
107 Lisp_Object));
|
|
108 static Lisp_Object prop_numeric_to_name P_ ((enum font_property_index, int));
|
|
109 static Lisp_Object font_open_entity P_ ((FRAME_PTR, Lisp_Object, int));
|
|
110
|
|
111 /* Number of registered font drivers. */
|
|
112 static int num_font_drivers;
|
|
113
|
|
114 /* Return a numeric value corresponding to PROP's NAME (symbol). If
|
|
115 NAME is not registered in font_style_table, return Qnil. PROP must
|
|
116 be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
|
|
117
|
|
118 static Lisp_Object
|
|
119 prop_name_to_numeric (prop, name)
|
|
120 enum font_property_index prop;
|
|
121 Lisp_Object name;
|
|
122 {
|
|
123 int table_index = prop - FONT_WEIGHT_INDEX;
|
|
124 Lisp_Object val;
|
|
125
|
|
126 val = assq_no_quit (name, AREF (font_style_table, table_index));
|
|
127 return (NILP (val) ? Qnil : XCDR (val));
|
|
128 }
|
|
129
|
|
130
|
|
131 /* Return a name (symbol) corresponding to PROP's NUMERIC value. If
|
|
132 no name is registered for NUMERIC in font_style_table, return a
|
|
133 symbol of integer name (e.g. `123'). PROP must be one of
|
|
134 FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
|
|
135
|
|
136 static Lisp_Object
|
|
137 prop_numeric_to_name (prop, numeric)
|
|
138 enum font_property_index prop;
|
|
139 int numeric;
|
|
140 {
|
|
141 int table_index = prop - FONT_WEIGHT_INDEX;
|
|
142 Lisp_Object table = AREF (font_style_table, table_index);
|
|
143 char buf[10];
|
|
144
|
|
145 while (! NILP (table))
|
|
146 {
|
|
147 if (XINT (XCDR (XCAR (table))) >= numeric)
|
|
148 {
|
|
149 if (XINT (XCDR (XCAR (table))) == numeric)
|
|
150 return XCAR (XCAR (table));
|
|
151 else
|
|
152 break;
|
|
153 }
|
|
154 table = XCDR (table);
|
|
155 }
|
|
156 sprintf (buf, "%d", numeric);
|
|
157 return intern (buf);
|
|
158 }
|
|
159
|
|
160
|
|
161 /* Return a symbol whose name is STR (length LEN). If STR contains
|
|
162 uppercase letters, downcase them in advance. */
|
|
163
|
|
164 Lisp_Object
|
|
165 intern_downcase (str, len)
|
|
166 char *str;
|
|
167 int len;
|
|
168 {
|
|
169 char *buf;
|
|
170 int i;
|
|
171
|
|
172 for (i = 0; i < len; i++)
|
|
173 if (isupper (str[i]))
|
|
174 break;
|
|
175 if (i == len)
|
|
176 return Fintern (make_unibyte_string (str, len), Qnil);
|
|
177 buf = alloca (len);
|
|
178 if (! buf)
|
|
179 return Fintern (null_string, Qnil);
|
|
180 bcopy (str, buf, len);
|
|
181 for (; i < len; i++)
|
|
182 if (isascii (buf[i]))
|
|
183 buf[i] = tolower (buf[i]);
|
|
184 return Fintern (make_unibyte_string (buf, len), Qnil);
|
|
185 }
|
|
186
|
|
187 extern Lisp_Object Vface_alternative_font_family_alist;
|
|
188
|
|
189 static void
|
|
190 build_font_family_alist ()
|
|
191 {
|
|
192 Lisp_Object alist = Vface_alternative_font_family_alist;
|
|
193
|
|
194 for (; CONSP (alist); alist = XCDR (alist))
|
|
195 {
|
|
196 Lisp_Object tail, elt;
|
|
197
|
|
198 for (tail = XCAR (alist), elt = Qnil ; CONSP (tail); tail = XCDR (tail))
|
|
199 elt = nconc2 (elt, Fcons (Fintern (XCAR (tail), Qnil), Qnil));
|
|
200 font_family_alist = Fcons (elt, font_family_alist);
|
|
201 }
|
|
202 }
|
|
203
|
|
204
|
|
205 /* Font property validater. */
|
|
206
|
|
207 static Lisp_Object
|
|
208 font_prop_validate_type (prop, val)
|
|
209 enum font_property_index prop;
|
|
210 Lisp_Object val;
|
|
211 {
|
|
212 return (SYMBOLP (val) ? val : Qerror);
|
|
213 }
|
|
214
|
|
215 static Lisp_Object
|
|
216 font_prop_validate_symbol (prop, val)
|
|
217 enum font_property_index prop;
|
|
218 Lisp_Object val;
|
|
219 {
|
|
220 if (STRINGP (val))
|
|
221 val = (SCHARS (val) == 0 ? null_string
|
|
222 : intern_downcase ((char *) SDATA (val), SBYTES (val)));
|
|
223 else if (SYMBOLP (val))
|
|
224 {
|
|
225 if (SCHARS (SYMBOL_NAME (val)) == 0)
|
|
226 val = null_string;
|
|
227 }
|
|
228 else
|
|
229 val = Qerror;
|
|
230 return val;
|
|
231 }
|
|
232
|
|
233 static Lisp_Object
|
|
234 font_prop_validate_style (prop, val)
|
|
235 enum font_property_index prop;
|
|
236 Lisp_Object val;
|
|
237 {
|
|
238 if (! INTEGERP (val))
|
|
239 {
|
|
240 if (STRINGP (val))
|
|
241 val = intern_downcase ((char *) SDATA (val), SBYTES (val));
|
|
242 if (! SYMBOLP (val))
|
|
243 val = Qerror;
|
|
244 else
|
|
245 {
|
|
246 val = prop_name_to_numeric (prop, val);
|
|
247 if (NILP (val))
|
|
248 val = Qerror;
|
|
249 }
|
|
250 }
|
|
251 return val;
|
|
252 }
|
|
253
|
|
254 static Lisp_Object
|
|
255 font_prop_validate_size (prop, val)
|
|
256 enum font_property_index prop;
|
|
257 Lisp_Object val;
|
|
258 {
|
|
259 return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0)
|
|
260 ? val : Qerror);
|
|
261 }
|
|
262
|
|
263 static Lisp_Object
|
|
264 font_prop_validate_extra (prop, val)
|
|
265 enum font_property_index prop;
|
|
266 Lisp_Object val;
|
|
267 {
|
|
268 Lisp_Object tail;
|
|
269
|
|
270 for (tail = val; CONSP (tail); tail = XCDR (tail))
|
|
271 {
|
|
272 Lisp_Object key = Fcar (XCAR (tail)), this_val = Fcdr (XCAR (tail));
|
|
273
|
|
274 if (NILP (this_val))
|
|
275 return Qnil;
|
|
276 if (EQ (key, QClanguage))
|
|
277 if (! SYMBOLP (this_val))
|
|
278 {
|
|
279 for (; CONSP (this_val); this_val = XCDR (this_val))
|
|
280 if (! SYMBOLP (XCAR (this_val)))
|
|
281 return Qerror;
|
|
282 if (! NILP (this_val))
|
|
283 return Qerror;
|
|
284 }
|
|
285 if (EQ (key, QCotf))
|
|
286 if (! STRINGP (this_val))
|
|
287 return Qerror;
|
|
288 }
|
|
289 return (NILP (tail) ? val : Qerror);
|
|
290 }
|
|
291
|
|
292
|
|
293 struct
|
|
294 {
|
|
295 Lisp_Object *key;
|
|
296 Lisp_Object (*validater) P_ ((enum font_property_index prop,
|
|
297 Lisp_Object val));
|
|
298 } font_property_table[FONT_SPEC_MAX] =
|
|
299 { { &QCtype, font_prop_validate_type },
|
|
300 { &QCfoundry, font_prop_validate_symbol },
|
|
301 { &QCfamily, font_prop_validate_symbol },
|
|
302 { &QCadstyle, font_prop_validate_symbol },
|
|
303 { &QCregistry, font_prop_validate_symbol },
|
|
304 { &QCweight, font_prop_validate_style },
|
|
305 { &QCslant, font_prop_validate_style },
|
|
306 { &QCwidth, font_prop_validate_style },
|
|
307 { &QCsize, font_prop_validate_size },
|
|
308 { &QCextra, font_prop_validate_extra }
|
|
309 };
|
|
310
|
|
311 static enum font_property_index
|
|
312 check_font_prop_name (key)
|
|
313 Lisp_Object key;
|
|
314 {
|
|
315 enum font_property_index i;
|
|
316
|
|
317 for (i = FONT_TYPE_INDEX; i < FONT_SPEC_MAX; i++)
|
|
318 if (EQ (key, *font_property_table[i].key))
|
|
319 break;
|
|
320 return i;
|
|
321 }
|
|
322
|
|
323 static Lisp_Object
|
|
324 font_prop_validate (spec)
|
|
325 Lisp_Object spec;
|
|
326 {
|
|
327 enum font_property_index i;
|
|
328 Lisp_Object val;
|
|
329
|
|
330 for (i = FONT_TYPE_INDEX; i <= FONT_EXTRA_INDEX; i++)
|
|
331 {
|
|
332 if (! NILP (AREF (spec, i)))
|
|
333 {
|
|
334 val = (font_property_table[i].validater) (i, AREF (spec, i));
|
|
335 if (EQ (val, Qerror))
|
|
336 Fsignal (Qerror, list3 (build_string ("invalid font property"),
|
|
337 *font_property_table[i].key,
|
|
338 AREF (spec, i)));
|
|
339 ASET (spec, i, val);
|
|
340 }
|
|
341 }
|
|
342 return spec;
|
|
343 }
|
|
344
|
|
345
|
|
346 /* Font name parser and unparser */
|
|
347
|
|
348 /* An enumerator for each field of an XLFD font name. */
|
|
349
|
|
350 enum xlfd_field_index
|
|
351 {
|
|
352 XLFD_FOUNDRY_INDEX,
|
|
353 XLFD_FAMILY_INDEX,
|
|
354 XLFD_WEIGHT_INDEX,
|
|
355 XLFD_SLANT_INDEX,
|
|
356 XLFD_SWIDTH_INDEX,
|
|
357 XLFD_ADSTYLE_INDEX,
|
|
358 XLFD_PIXEL_SIZE_INDEX,
|
|
359 XLFD_POINT_SIZE_INDEX,
|
|
360 XLFD_RESX_INDEX,
|
|
361 XLFD_RESY_INDEX,
|
|
362 XLFD_SPACING_INDEX,
|
|
363 XLFD_AVGWIDTH_INDEX,
|
|
364 XLFD_REGISTRY_INDEX,
|
|
365 XLFD_ENCODING_INDEX,
|
|
366 XLFD_LAST_INDEX
|
|
367 };
|
|
368
|
|
369 /* Return a symbol interned by string at STR and bytes LEN.
|
|
370 If LEN == 0, return a null string.
|
|
371 If the string is "*", return Qnil.
|
|
372 It is assured that LEN < 256. */
|
|
373
|
|
374 static Lisp_Object
|
|
375 intern_font_field (f, xlfd)
|
|
376 char *f[XLFD_LAST_INDEX + 1];
|
|
377 int xlfd;
|
|
378 {
|
|
379 char *str = f[xlfd] + 1;
|
|
380 int len;
|
|
381
|
|
382 if (xlfd != XLFD_RESY_INDEX)
|
|
383 len = f[xlfd + 1] - f[xlfd] - 1;
|
|
384 else
|
|
385 len = f[XLFD_REGISTRY_INDEX] - f[xlfd] - 1;
|
|
386
|
|
387 if (len == 0)
|
|
388 return null_string;
|
|
389 if (*str == '*' && len == 1)
|
|
390 return Qnil;
|
|
391 return intern_downcase (str, len);
|
|
392 }
|
|
393
|
|
394 /* Parse P pointing the pixel/point size field of the form
|
|
395 `[A B C D]' which specifies a transformation matrix:
|
|
396
|
|
397 A B 0
|
|
398 C D 0
|
|
399 0 0 1
|
|
400
|
|
401 by which all glyphs of the font are transformed. The spec says
|
|
402 that scalar value N for the pixel/point size is equivalent to:
|
|
403 A = N * resx/resy, B = C = 0, D = N.
|
|
404
|
|
405 Return the scalar value N if the form is valid. Otherwise return
|
|
406 -1. */
|
|
407
|
|
408 static int
|
|
409 parse_matrix (p)
|
|
410 char *p;
|
|
411 {
|
|
412 double matrix[4];
|
|
413 char *end;
|
|
414 int i;
|
|
415
|
|
416 for (i = 0, p++; i < 4 && *p && *p != ']'; i++)
|
|
417 {
|
|
418 if (*p == '~')
|
|
419 matrix[i] = - strtod (p + 1, &end);
|
|
420 else
|
|
421 matrix[i] = strtod (p, &end);
|
|
422 p = end;
|
|
423 }
|
|
424 return (i == 4 ? (int) matrix[3] : -1);
|
|
425 }
|
|
426
|
|
427 /* Parse NAME (null terminated) as XLFD format, and store information
|
|
428 in FONT (font-spec or font-entity). If NAME is successfully
|
|
429 parsed, return 2 (non-scalable font), 1 (scalable vector font), or
|
|
430 0 (auto-scaled font). Otherwise return -1.
|
|
431
|
|
432 If FONT is a font-entity, store RESY-SPACING-AVWIDTH information as
|
|
433 a symbol in FONT_EXTRA_INDEX.
|
|
434
|
|
435 If MERGE is nonzero, set a property of FONT only when it's nil. */
|
|
436
|
|
437 int
|
|
438 font_parse_xlfd (name, font, merge)
|
|
439 char *name;
|
|
440 Lisp_Object font;
|
|
441 int merge;
|
|
442 {
|
|
443 int len = strlen (name);
|
|
444 int i, j;
|
|
445 int pixel_size, resy, avwidth;
|
|
446 double point_size;
|
|
447 char *f[XLFD_LAST_INDEX + 1];
|
|
448 Lisp_Object val;
|
|
449 int first_wildcard_field = -1, last_wildcard_field = XLFD_LAST_INDEX;
|
|
450
|
|
451 if (len > 255)
|
|
452 /* Maximum XLFD name length is 255. */
|
|
453 return -1;
|
|
454 for (i = 0; *name; name++)
|
|
455 if (*name == '-'
|
|
456 && i < XLFD_LAST_INDEX)
|
|
457 {
|
|
458 f[i] = name;
|
|
459 if (name[1] == '*' && (! name[2] || name[2] == '-'))
|
|
460 {
|
|
461 if (first_wildcard_field < 0)
|
|
462 first_wildcard_field = i;
|
|
463 last_wildcard_field = i;
|
|
464 }
|
|
465 i++;
|
|
466 }
|
|
467
|
|
468 f[XLFD_LAST_INDEX] = name;
|
|
469 if (i < XLFD_LAST_INDEX)
|
|
470 {
|
|
471 /* Not a fully specified XLFD. */
|
|
472 if (first_wildcard_field < 0 )
|
|
473 /* No wild card. */
|
|
474 return -1;
|
|
475 i--;
|
|
476 if (last_wildcard_field < i)
|
|
477 {
|
|
478 /* Shift fields after the last wildcard field. */
|
|
479 for (j = XLFD_LAST_INDEX - 1; j > last_wildcard_field; j--, i--)
|
|
480 f[j] = f[i];
|
|
481 /* Make all fields between the first and last wildcard fieled
|
|
482 also wildcard fields. */
|
|
483 for (j--; j > first_wildcard_field; j--)
|
|
484 f[j] = "-*";
|
|
485 }
|
|
486 }
|
|
487 f[XLFD_ENCODING_INDEX] = f[XLFD_LAST_INDEX];
|
|
488
|
|
489 if (! merge || NILP (AREF (font, FONT_FOUNDRY_INDEX)))
|
|
490 ASET (font, FONT_FOUNDRY_INDEX, intern_font_field (f, XLFD_FOUNDRY_INDEX));
|
|
491 if (! merge || NILP (AREF (font, FONT_FAMILY_INDEX)))
|
|
492 ASET (font, FONT_FAMILY_INDEX, intern_font_field (f, XLFD_FAMILY_INDEX));
|
|
493 if (! merge || NILP (AREF (font, FONT_ADSTYLE_INDEX)))
|
|
494 ASET (font, FONT_ADSTYLE_INDEX, intern_font_field (f, XLFD_ADSTYLE_INDEX));
|
|
495 if (! merge || NILP (AREF (font, FONT_REGISTRY_INDEX)))
|
|
496 ASET (font, FONT_REGISTRY_INDEX, intern_font_field (f, XLFD_REGISTRY_INDEX));
|
|
497
|
|
498 for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX;
|
|
499 j <= XLFD_SWIDTH_INDEX; i++, j++)
|
|
500 if (! merge || NILP (AREF (font, i)))
|
|
501 {
|
|
502 if (isdigit(f[j][1]))
|
|
503 val = make_number (atoi (f[j] + 1));
|
|
504 else
|
|
505 {
|
|
506 Lisp_Object sym = intern_font_field (f, j);
|
|
507
|
|
508 val = prop_name_to_numeric (i, sym);
|
|
509 if (NILP (val))
|
|
510 val = sym;
|
|
511 }
|
|
512 ASET (font, i, val);
|
|
513 }
|
|
514
|
|
515 if (f[XLFD_PIXEL_SIZE_INDEX][1] == '*')
|
|
516 pixel_size = -1; /* indicates "unspecified" */
|
|
517 else if (f[XLFD_PIXEL_SIZE_INDEX][1] == '[')
|
|
518 pixel_size = parse_matrix (f[XLFD_PIXEL_SIZE_INDEX] + 1);
|
|
519 else if (isdigit (f[XLFD_PIXEL_SIZE_INDEX][1]))
|
|
520 pixel_size = strtod (f[XLFD_PIXEL_SIZE_INDEX] + 1, NULL);
|
|
521 else
|
|
522 pixel_size = -1;
|
|
523
|
|
524 if (pixel_size < 0 && FONT_ENTITY_P (font))
|
|
525 return -1;
|
|
526
|
|
527 if (f[XLFD_POINT_SIZE_INDEX][1] == '*')
|
|
528 point_size = -1; /* indicates "unspecified" */
|
|
529 else if (f[XLFD_POINT_SIZE_INDEX][1] == '[')
|
|
530 point_size = parse_matrix (f[XLFD_POINT_SIZE_INDEX] + 1);
|
|
531 else if (isdigit (f[XLFD_POINT_SIZE_INDEX][1]))
|
|
532 point_size = strtod (f[XLFD_POINT_SIZE_INDEX] + 1, NULL);
|
|
533 else
|
|
534 point_size = -1;
|
|
535
|
|
536 if (f[XLFD_RESY_INDEX][1] == '*')
|
|
537 resy = -1; /* indicates "unspecified" */
|
|
538 else
|
|
539 resy = strtod (f[XLFD_RESY_INDEX] + 1, NULL);
|
|
540
|
|
541 if (f[XLFD_AVGWIDTH_INDEX][1] == '*')
|
|
542 avwidth = -1; /* indicates "unspecified" */
|
|
543 else if (f[XLFD_AVGWIDTH_INDEX][1] == '~')
|
|
544 avwidth = - strtod (f[XLFD_AVGWIDTH_INDEX] + 2, NULL);
|
|
545 else
|
|
546 avwidth = strtod (f[XLFD_AVGWIDTH_INDEX] + 1, NULL);
|
|
547
|
|
548 if (! merge || NILP (AREF (font, FONT_SIZE_INDEX)))
|
|
549 {
|
|
550 if (pixel_size >= 0)
|
|
551 ASET (font, FONT_SIZE_INDEX, make_number (pixel_size));
|
|
552 else
|
|
553 {
|
|
554 if (point_size >= 0)
|
|
555 {
|
|
556 if (resy > 0)
|
|
557 {
|
|
558 pixel_size = POINT_TO_PIXEL (point_size, resy);
|
|
559 ASET (font, FONT_SIZE_INDEX, make_number (pixel_size));
|
|
560 }
|
|
561 else
|
|
562 {
|
|
563 ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10));
|
|
564 }
|
|
565 }
|
|
566 else
|
|
567 ASET (font, FONT_SIZE_INDEX, Qnil);
|
|
568 }
|
|
569 }
|
|
570
|
|
571 if (FONT_ENTITY_P (font)
|
|
572 && EQ (AREF (font, FONT_TYPE_INDEX), Qx))
|
|
573 ASET (font, FONT_EXTRA_INDEX, intern_font_field (f, XLFD_RESY_INDEX));
|
|
574
|
|
575 return (avwidth > 0 ? 2 : resy == 0);
|
|
576 }
|
|
577
|
|
578 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
|
|
579 length), and return the name length. If FONT_SIZE_INDEX of FONT is
|
|
580 0, use PIXEL_SIZE instead. */
|
|
581
|
|
582 int
|
|
583 font_unparse_xlfd (font, pixel_size, name, nbytes)
|
|
584 Lisp_Object font;
|
|
585 char *name;
|
|
586 int nbytes;
|
|
587 {
|
|
588 char *f[XLFD_REGISTRY_INDEX + 1], *pixel_point;
|
|
589 char work[256];
|
|
590 Lisp_Object val;
|
|
591 int i, j, len = 0;
|
|
592
|
|
593 xassert (FONTP (font));
|
|
594
|
|
595 for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX;
|
|
596 i++, j++)
|
|
597 {
|
|
598 if (i == FONT_ADSTYLE_INDEX)
|
|
599 j = XLFD_ADSTYLE_INDEX;
|
|
600 else if (i == FONT_REGISTRY_INDEX)
|
|
601 j = XLFD_REGISTRY_INDEX;
|
|
602 val = AREF (font, i);
|
|
603 if (NILP (val))
|
|
604 f[j] = "*", len += 2;
|
|
605 else
|
|
606 {
|
|
607 if (SYMBOLP (val))
|
|
608 val = SYMBOL_NAME (val);
|
|
609 f[j] = (char *) SDATA (val), len += SBYTES (val) + 1;
|
|
610 }
|
|
611 }
|
|
612
|
|
613 for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX;
|
|
614 i++, j++)
|
|
615 {
|
|
616 val = AREF (font, i);
|
|
617 if (NILP (val))
|
|
618 f[j] = "*", len += 2;
|
|
619 else
|
|
620 {
|
|
621 if (INTEGERP (val))
|
|
622 val = prop_numeric_to_name (i, XINT (val));
|
|
623 if (SYMBOLP (val))
|
|
624 val = SYMBOL_NAME (val);
|
|
625 xassert (STRINGP (val));
|
|
626 f[j] = (char *) SDATA (val), len += SBYTES (val) + 1;
|
|
627 }
|
|
628 }
|
|
629
|
|
630 val = AREF (font, FONT_SIZE_INDEX);
|
|
631 xassert (NUMBERP (val) || NILP (val));
|
|
632 if (INTEGERP (val))
|
|
633 {
|
|
634 i = XINT (val);
|
|
635 if (i > 0)
|
|
636 len += sprintf (work, "%d", i) + 1;
|
|
637 else /* i == 0 */
|
|
638 len += sprintf (work, "%d-*", pixel_size) + 1;
|
|
639 pixel_point = work;
|
|
640 }
|
|
641 else if (FLOATP (val))
|
|
642 {
|
|
643 i = XFLOAT_DATA (val) * 10;
|
|
644 len += sprintf (work, "*-%d", i) + 1;
|
|
645 pixel_point = work;
|
|
646 }
|
|
647 else
|
|
648 pixel_point = "*-*", len += 4;
|
|
649
|
|
650 if (FONT_ENTITY_P (font)
|
|
651 && EQ (AREF (font, FONT_TYPE_INDEX), Qx))
|
|
652 {
|
|
653 /* Setup names for RESY-SPACING-AVWIDTH. */
|
|
654 val = AREF (font, FONT_EXTRA_INDEX);
|
|
655 if (SYMBOLP (val) && ! NILP (val))
|
|
656 {
|
|
657 val = SYMBOL_NAME (val);
|
|
658 f[XLFD_RESY_INDEX] = (char *) SDATA (val), len += SBYTES (val) + 1;
|
|
659 }
|
|
660 else
|
|
661 f[XLFD_RESY_INDEX] = "*-*-*", len += 6;
|
|
662 }
|
|
663 else
|
|
664 f[XLFD_RESY_INDEX] = "*-*-*", len += 6;
|
|
665
|
|
666 len += 3; /* for "-*" of resx, and terminating '\0'. */
|
|
667 if (len >= nbytes)
|
|
668 return -1;
|
|
669 return sprintf (name, "-%s-%s-%s-%s-%s-%s-%s-*-%s-%s",
|
|
670 f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
|
|
671 f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
|
|
672 f[XLFD_SWIDTH_INDEX],
|
|
673 f[XLFD_ADSTYLE_INDEX], pixel_point,
|
|
674 f[XLFD_RESY_INDEX], f[XLFD_REGISTRY_INDEX]);
|
|
675 }
|
|
676
|
|
677 void
|
|
678 font_merge_old_spec (name, family, registry, spec)
|
|
679 Lisp_Object name, family, registry, spec;
|
|
680 {
|
|
681 if (STRINGP (name))
|
|
682 {
|
|
683 if (font_parse_xlfd ((char *) SDATA (name), spec, 1) < 0)
|
|
684 {
|
|
685 Lisp_Object extra = Fcons (Fcons (QCname, name), Qnil);
|
|
686
|
|
687 ASET (spec, FONT_EXTRA_INDEX, extra);
|
|
688 }
|
|
689 }
|
|
690 else
|
|
691 {
|
|
692 if (! NILP (family))
|
|
693 {
|
|
694 int len;
|
|
695 char *p0, *p1;
|
|
696
|
|
697 xassert (STRINGP (family));
|
|
698 len = SBYTES (family);
|
|
699 p0 = (char *) SDATA (family);
|
|
700 p1 = index (p0, '-');
|
|
701 if (p1)
|
|
702 {
|
|
703 if (NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
|
|
704 ASET (spec, FONT_FOUNDRY_INDEX,
|
|
705 intern_downcase (p0, p1 - p0));
|
|
706 if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
|
|
707 ASET (spec, FONT_FAMILY_INDEX,
|
|
708 intern_downcase (p1 + 1, len - (p1 + 1 - p0)));
|
|
709 }
|
|
710 else if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
|
|
711 ASET (spec, FONT_FAMILY_INDEX, intern_downcase (p0, len));
|
|
712 }
|
|
713 if (! NILP (registry)
|
|
714 && NILP (AREF (spec, FONT_REGISTRY_INDEX)))
|
|
715 ASET (spec, FONT_REGISTRY_INDEX,
|
|
716 intern_downcase ((char *) SDATA (registry), SBYTES (registry)));
|
|
717 }
|
|
718 }
|
|
719
|
|
720
|
|
721 /* OTF handler */
|
|
722
|
|
723 #ifdef HAVE_LIBOTF
|
|
724 #include <otf.h>
|
|
725
|
|
726 struct otf_list
|
|
727 {
|
|
728 Lisp_Object entity;
|
|
729 OTF *otf;
|
|
730 struct otf_list *next;
|
|
731 };
|
|
732
|
|
733 static struct otf_list *otf_list;
|
|
734
|
|
735 static Lisp_Object
|
|
736 otf_tag_symbol (tag)
|
|
737 OTF_Tag tag;
|
|
738 {
|
|
739 char name[5];
|
|
740
|
|
741 OTF_tag_name (tag, name);
|
|
742 return Fintern (make_unibyte_string (name, 4), Qnil);
|
|
743 }
|
|
744
|
|
745 static OTF *
|
|
746 otf_open (entity, file)
|
|
747 Lisp_Object entity;
|
|
748 char *file;
|
|
749 {
|
|
750 struct otf_list *list = otf_list;
|
|
751
|
|
752 while (list && ! EQ (list->entity, entity))
|
|
753 list = list->next;
|
|
754 if (! list)
|
|
755 {
|
|
756 list = malloc (sizeof (struct otf_list));
|
|
757 list->entity = entity;
|
|
758 list->otf = file ? OTF_open (file) : NULL;
|
|
759 list->next = otf_list;
|
|
760 otf_list = list;
|
|
761 }
|
|
762 return list->otf;
|
|
763 }
|
|
764
|
|
765
|
|
766 /* Return a list describing which scripts/languages FONT supports by
|
|
767 which GSUB/GPOS features of OpenType tables. See the comment of
|
|
768 (sturct font_driver).otf_capability. */
|
|
769
|
|
770 Lisp_Object
|
|
771 font_otf_capability (font)
|
|
772 struct font *font;
|
|
773 {
|
|
774 OTF *otf;
|
|
775 Lisp_Object capability = Fcons (Qnil, Qnil);
|
|
776 int i;
|
|
777
|
|
778 otf = otf_open (font->entity, font->file_name);
|
|
779 if (! otf)
|
|
780 return Qnil;
|
|
781 for (i = 0; i < 2; i++)
|
|
782 {
|
|
783 OTF_GSUB_GPOS *gsub_gpos;
|
|
784 Lisp_Object script_list = Qnil;
|
|
785 int j;
|
|
786
|
|
787 if (OTF_get_features (otf, i == 0) < 0)
|
|
788 continue;
|
|
789 gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
|
|
790 for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
|
|
791 {
|
|
792 OTF_Script *script = gsub_gpos->ScriptList.Script + j;
|
|
793 Lisp_Object langsys_list = Qnil;
|
|
794 Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
|
|
795 int k;
|
|
796
|
|
797 for (k = script->LangSysCount; k >= 0; k--)
|
|
798 {
|
|
799 OTF_LangSys *langsys;
|
|
800 Lisp_Object feature_list = Qnil;
|
|
801 Lisp_Object langsys_tag;
|
|
802 int l;
|
|
803
|
|
804 if (j == script->LangSysCount)
|
|
805 {
|
|
806 langsys = &script->DefaultLangSys;
|
|
807 langsys_tag = Qnil;
|
|
808 }
|
|
809 else
|
|
810 {
|
|
811 langsys = script->LangSys + k;
|
|
812 langsys_tag
|
|
813 = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
|
|
814 }
|
|
815 for (l = langsys->FeatureCount -1; l >= 0; l--)
|
|
816 {
|
|
817 OTF_Feature *feature
|
|
818 = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
|
|
819 Lisp_Object feature_tag
|
|
820 = otf_tag_symbol (feature->FeatureTag);
|
|
821
|
|
822 feature_list = Fcons (feature_tag, feature_list);
|
|
823 }
|
|
824 langsys_list = Fcons (Fcons (langsys_tag, feature_list),
|
|
825 langsys_list);
|
|
826 }
|
|
827 script_list = Fcons (Fcons (script_tag, langsys_list),
|
|
828 script_list);
|
|
829 }
|
|
830
|
|
831 if (i == 0)
|
|
832 XSETCAR (capability, script_list);
|
|
833 else
|
|
834 XSETCDR (capability, script_list);
|
|
835 }
|
|
836
|
|
837 return capability;
|
|
838 }
|
|
839
|
|
840 static int
|
|
841 parse_gsub_gpos_spec (spec, script, langsys, features)
|
|
842 Lisp_Object spec;
|
|
843 char **script, **langsys, **features;
|
|
844 {
|
|
845 Lisp_Object val;
|
|
846 int len;
|
|
847 char *p;
|
|
848 int asterisk;
|
|
849
|
|
850 val = XCAR (spec);
|
|
851 *script = (char *) SDATA (SYMBOL_NAME (val));
|
|
852 spec = XCDR (spec);
|
|
853 val = XCAR (spec);
|
|
854 *langsys = NILP (val) ? NULL : (char *) SDATA (SYMBOL_NAME (val));
|
|
855 spec = XCDR (spec);
|
|
856 len = XINT (Flength (spec));
|
|
857 *features = p = malloc (6 * len);
|
|
858 if (! p)
|
|
859 return -1;
|
|
860
|
|
861 for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
|
|
862 {
|
|
863 val = XCAR (spec);
|
|
864 if (SREF (SYMBOL_NAME (val), 0) == '*')
|
|
865 {
|
|
866 asterisk = 1;
|
|
867 p += sprintf (p, ",*");
|
|
868 }
|
|
869 else if (! asterisk)
|
|
870 p += sprintf (p, ",%s", SDATA (SYMBOL_NAME (val)));
|
|
871 else
|
|
872 p += sprintf (p, ",~%s", SDATA (SYMBOL_NAME (val)));
|
|
873 }
|
|
874 return 0;
|
|
875 }
|
|
876
|
|
877 #define DEVICE_DELTA(table, size) \
|
|
878 (((size) >= (table).StartSize && (size) <= (table).EndSize) \
|
|
879 ? (table).DeltaValue[(size) >= (table).StartSize] \
|
|
880 : 0)
|
|
881
|
|
882 void
|
|
883 adjust_anchor (struct font *font, OTF_Anchor *anchor,
|
|
884 unsigned code, int size, int *x, int *y)
|
|
885 {
|
|
886 if (anchor->AnchorFormat == 2)
|
|
887 {
|
|
888 int x0, y0;
|
|
889
|
|
890 if (font->driver->anchor_point (font, code, anchor->f.f1.AnchorPoint,
|
|
891 &x0, &y0) >= 0)
|
|
892 *x = x0, *y = y0;
|
|
893 }
|
|
894 else if (anchor->AnchorFormat == 3)
|
|
895 {
|
|
896 if (anchor->f.f2.XDeviceTable.offset)
|
|
897 *x += DEVICE_DELTA (anchor->f.f2.XDeviceTable, size);
|
|
898 if (anchor->f.f2.YDeviceTable.offset)
|
|
899 *y += DEVICE_DELTA (anchor->f.f2.YDeviceTable, size);
|
|
900 }
|
|
901 }
|
|
902
|
|
903
|
|
904 /* Drive FONT's OTF GSUB features according to GSUB_SPEC. See the
|
|
905 comment of (sturct font_driver).otf_gsub. */
|
|
906
|
|
907 int
|
|
908 font_otf_gsub (font, gsub_spec, gstring_in, from, to, gstring_out, idx)
|
|
909 struct font *font;
|
|
910 Lisp_Object gsub_spec;
|
|
911 Lisp_Object gstring_in;
|
|
912 int from, to;
|
|
913 Lisp_Object gstring_out;
|
|
914 int idx;
|
|
915 {
|
|
916 int len;
|
|
917 int i;
|
|
918 OTF *otf;
|
|
919 OTF_GlyphString otf_gstring;
|
|
920 OTF_Glyph *g;
|
|
921 char *script, *langsys, *features;
|
|
922
|
|
923 otf = otf_open (font->entity, font->file_name);
|
|
924 if (! otf)
|
|
925 return 0;
|
|
926 if (OTF_get_table (otf, "head") < 0)
|
|
927 return 0;
|
|
928 if (OTF_check_table (otf, "GSUB") < 0)
|
|
929 return 0;
|
|
930 if (parse_gsub_gpos_spec (gsub_spec, &script, &langsys, &features) < 0)
|
|
931 return 0;
|
|
932 len = to - from;
|
|
933 otf_gstring.size = otf_gstring.used = len;
|
|
934 otf_gstring.glyphs = (OTF_Glyph *) malloc (sizeof (OTF_Glyph) * len);
|
|
935 memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * len);
|
|
936 for (i = 0; i < len; i++)
|
|
937 {
|
|
938 Lisp_Object g = LGSTRING_GLYPH (gstring_in, from + i);
|
|
939
|
|
940 otf_gstring.glyphs[i].c = XINT (LGLYPH_CHAR (g));
|
|
941 otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (g));
|
|
942 }
|
|
943
|
|
944 OTF_drive_gdef (otf, &otf_gstring);
|
|
945 if (OTF_drive_gsub (otf, &otf_gstring, script, langsys, features) < 0)
|
|
946 {
|
|
947 free (otf_gstring.glyphs);
|
|
948 return 0;
|
|
949 }
|
|
950 if (ASIZE (gstring_out) < idx + otf_gstring.used)
|
|
951 {
|
|
952 free (otf_gstring.glyphs);
|
|
953 return -1;
|
|
954 }
|
|
955
|
|
956 for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used;)
|
|
957 {
|
|
958 int i0 = g->f.index.from, i1 = g->f.index.to;
|
|
959 Lisp_Object glyph = LGSTRING_GLYPH (gstring_in, from + i0);
|
|
960 Lisp_Object min_idx = AREF (glyph, 0);
|
|
961 Lisp_Object max_idx = AREF (glyph, 1);
|
|
962
|
|
963 if (i0 < i1)
|
|
964 {
|
|
965 int min_idx_i = XINT (min_idx), max_idx_i = XINT (max_idx);
|
|
966
|
|
967 for (i0++; i0 <= i1; i0++)
|
|
968 {
|
|
969 glyph = LGSTRING_GLYPH (gstring_in, from + i0);
|
|
970 if (min_idx_i > XINT (AREF (glyph, 0)))
|
|
971 min_idx_i = XINT (AREF (glyph, 0));
|
|
972 if (max_idx_i < XINT (AREF (glyph, 1)))
|
|
973 max_idx_i = XINT (AREF (glyph, 1));
|
|
974 }
|
|
975 min_idx = make_number (min_idx_i);
|
|
976 max_idx = make_number (max_idx_i);
|
|
977 i0 = g->f.index.from;
|
|
978 }
|
|
979 for (; i < otf_gstring.used && g->f.index.from == i0; i++, g++)
|
|
980 {
|
|
981 glyph = LGSTRING_GLYPH (gstring_out, idx + i);
|
|
982 ASET (glyph, 0, min_idx);
|
|
983 ASET (glyph, 1, max_idx);
|
|
984 LGLYPH_SET_CHAR (glyph, make_number (g->c));
|
|
985 LGLYPH_SET_CODE (glyph, make_number (g->glyph_id));
|
|
986 }
|
|
987 }
|
|
988
|
|
989 free (otf_gstring.glyphs);
|
|
990 return i;
|
|
991 }
|
|
992
|
|
993 /* Drive FONT's OTF GPOS features according to GPOS_SPEC. See the
|
|
994 comment of (sturct font_driver).otf_gpos. */
|
|
995
|
|
996 int
|
|
997 font_otf_gpos (font, gpos_spec, gstring, from, to)
|
|
998 struct font *font;
|
|
999 Lisp_Object gpos_spec;
|
|
1000 Lisp_Object gstring;
|
|
1001 int from, to;
|
|
1002 {
|
|
1003 int len;
|
|
1004 int i;
|
|
1005 OTF *otf;
|
|
1006 OTF_GlyphString otf_gstring;
|
|
1007 OTF_Glyph *g;
|
|
1008 char *script, *langsys, *features;
|
|
1009 Lisp_Object glyph;
|
|
1010 int u, size;
|
|
1011 Lisp_Object base, mark;
|
|
1012
|
|
1013 otf = otf_open (font->entity, font->file_name);
|
|
1014 if (! otf)
|
|
1015 return 0;
|
|
1016 if (OTF_get_table (otf, "head") < 0)
|
|
1017 return 0;
|
|
1018 if (OTF_check_table (otf, "GPOS") < 0)
|
|
1019 return 0;
|
|
1020 if (parse_gsub_gpos_spec (gpos_spec, &script, &langsys, &features) < 0)
|
|
1021 return 0;
|
|
1022 len = to - from;
|
|
1023 otf_gstring.size = otf_gstring.used = len;
|
|
1024 otf_gstring.glyphs = (OTF_Glyph *) malloc (sizeof (OTF_Glyph) * len);
|
|
1025 memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * len);
|
|
1026 for (i = 0; i < len; i++)
|
|
1027 {
|
|
1028 glyph = LGSTRING_GLYPH (gstring, from + i);
|
|
1029 otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (glyph));
|
|
1030 }
|
|
1031
|
|
1032 OTF_drive_gdef (otf, &otf_gstring);
|
|
1033
|
|
1034 if (OTF_drive_gpos (otf, &otf_gstring, script, langsys, features) < 0)
|
|
1035 {
|
|
1036 free (otf_gstring.glyphs);
|
|
1037 return 0;
|
|
1038 }
|
|
1039
|
|
1040 u = otf->head->unitsPerEm;
|
|
1041 size = font->pixel_size;
|
|
1042 base = mark = Qnil;
|
|
1043 for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used; i++, g++)
|
|
1044 {
|
|
1045 Lisp_Object prev;
|
|
1046 int xoff = 0, yoff = 0, width_adjust = 0;
|
|
1047
|
|
1048 if (! g->glyph_id)
|
|
1049 continue;
|
|
1050
|
|
1051 glyph = LGSTRING_GLYPH (gstring, from + i);
|
|
1052 switch (g->positioning_type)
|
|
1053 {
|
|
1054 case 0:
|
|
1055 break;
|
|
1056 case 1: case 2:
|
|
1057 {
|
|
1058 int format = g->f.f1.format;
|
|
1059
|
|
1060 if (format & OTF_XPlacement)
|
|
1061 xoff = g->f.f1.value->XPlacement * size / u;
|
|
1062 if (format & OTF_XPlaDevice)
|
|
1063 xoff += DEVICE_DELTA (g->f.f1.value->XPlaDevice, size);
|
|
1064 if (format & OTF_YPlacement)
|
|
1065 yoff = - (g->f.f1.value->YPlacement * size / u);
|
|
1066 if (format & OTF_YPlaDevice)
|
|
1067 yoff -= DEVICE_DELTA (g->f.f1.value->YPlaDevice, size);
|
|
1068 if (format & OTF_XAdvance)
|
|
1069 width_adjust += g->f.f1.value->XAdvance * size / u;
|
|
1070 if (format & OTF_XAdvDevice)
|
|
1071 width_adjust += DEVICE_DELTA (g->f.f1.value->XAdvDevice, size);
|
|
1072 }
|
|
1073 break;
|
|
1074 case 3:
|
|
1075 /* Not yet supported. */
|
|
1076 break;
|
|
1077 case 4: case 5:
|
|
1078 if (NILP (base))
|
|
1079 break;
|
|
1080 prev = base;
|
|
1081 goto label_adjust_anchor;
|
|
1082 default: /* i.e. case 6 */
|
|
1083 if (NILP (mark))
|
|
1084 break;
|
|
1085 prev = mark;
|
|
1086
|
|
1087 label_adjust_anchor:
|
|
1088 {
|
|
1089 int base_x, base_y, mark_x, mark_y, width;
|
|
1090 unsigned code;
|
|
1091
|
|
1092 base_x = g->f.f4.base_anchor->XCoordinate * size / u;
|
|
1093 base_y = g->f.f4.base_anchor->YCoordinate * size / u;
|
|
1094 mark_x = g->f.f4.mark_anchor->XCoordinate * size / u;
|
|
1095 mark_y = g->f.f4.mark_anchor->YCoordinate * size / u;
|
|
1096
|
|
1097 code = XINT (LGLYPH_CODE (prev));
|
|
1098 if (g->f.f4.base_anchor->AnchorFormat != 1)
|
|
1099 adjust_anchor (font, g->f.f4.base_anchor,
|
|
1100 code, size, &base_x, &base_y);
|
|
1101 if (g->f.f4.mark_anchor->AnchorFormat != 1)
|
|
1102 adjust_anchor (font, g->f.f4.mark_anchor,
|
|
1103 code, size, &mark_x, &mark_y);
|
|
1104
|
|
1105 if (NILP (LGLYPH_WIDTH (prev)))
|
|
1106 {
|
|
1107 width = font->driver->text_extents (font, &code, 1, NULL);
|
|
1108 LGLYPH_SET_WIDTH (prev, make_number (width));
|
|
1109 }
|
|
1110 xoff = XINT (LGLYPH_XOFF (prev)) + (base_x - width) - mark_x;
|
|
1111 yoff = XINT (LGLYPH_YOFF (prev)) + mark_y - base_y;
|
|
1112 }
|
|
1113 }
|
|
1114 if (g->GlyphClass == OTF_GlyphClass0)
|
|
1115 base = mark = glyph;
|
|
1116 else if (g->GlyphClass == OTF_GlyphClassMark)
|
|
1117 mark = glyph;
|
|
1118 else
|
|
1119 base = glyph;
|
|
1120
|
|
1121 LGLYPH_SET_XOFF (glyph, make_number (xoff));
|
|
1122 LGLYPH_SET_YOFF (glyph, make_number (yoff));
|
|
1123 LGLYPH_SET_WADJUST (glyph, make_number (width_adjust));
|
|
1124 }
|
|
1125
|
|
1126 free (otf_gstring.glyphs);
|
|
1127 return 0;
|
|
1128 }
|
|
1129
|
|
1130 #endif /* HAVE_LIBOTF */
|
|
1131
|
|
1132
|
|
1133 /* glyph-string handler */
|
|
1134
|
|
1135 /* GSTRING is a vector of this form:
|
|
1136 [ [FONT-OBJECT LBEARING RBEARING WITH ASCENT DESCENT] GLYPH ... ]
|
|
1137 and GLYPH is a vector of this form:
|
|
1138 [ FROM-IDX TO-IDX C CODE X-OFF Y-OFF WIDTH WADJUST ]
|
|
1139 where
|
|
1140 FROM-IDX and TO-IDX are used internally and should not be touched.
|
|
1141 C is a character of the glyph.
|
|
1142 CODE is a glyph-code of C in FONT-OBJECT.
|
|
1143 X-OFF and Y-OFF are offests to the base position for the glyph.
|
|
1144 WIDTH is a normal width of the glyph.
|
|
1145 WADJUST is an adjustment to the normal width of the glyph. */
|
|
1146
|
|
1147 struct font *
|
|
1148 font_prepare_composition (cmp)
|
|
1149 struct composition *cmp;
|
|
1150 {
|
|
1151 Lisp_Object gstring
|
|
1152 = AREF (XHASH_TABLE (composition_hash_table)->key_and_value,
|
|
1153 cmp->hash_index * 2);
|
|
1154 struct font *font = XSAVE_VALUE (LGSTRING_FONT (gstring))->pointer;
|
|
1155 int len = LGSTRING_LENGTH (gstring);
|
|
1156 int i;
|
|
1157
|
|
1158 cmp->font = font;
|
|
1159 cmp->lbearing = cmp->rbearing = cmp->pixel_width = 0;
|
|
1160 cmp->ascent = font->ascent;
|
|
1161 cmp->descent = font->descent;
|
|
1162
|
|
1163 for (i = 0; i < len; i++)
|
|
1164 {
|
|
1165 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
|
|
1166 unsigned code = XINT (LGLYPH_CODE (g));
|
|
1167 struct font_metrics metrics;
|
|
1168
|
|
1169 font->driver->text_extents (font, &code, 1, &metrics);
|
|
1170 LGLYPH_SET_WIDTH (g, make_number (metrics.width));
|
|
1171 metrics.lbearing += XINT (LGLYPH_XOFF (g));
|
|
1172 metrics.rbearing += XINT (LGLYPH_XOFF (g));
|
|
1173 metrics.ascent += XINT (LGLYPH_YOFF (g));
|
|
1174 metrics.descent += XINT (LGLYPH_YOFF (g));
|
|
1175
|
|
1176 if (cmp->lbearing > cmp->pixel_width + metrics.lbearing)
|
|
1177 cmp->lbearing = cmp->pixel_width + metrics.lbearing;
|
|
1178 if (cmp->rbearing < cmp->pixel_width + metrics.rbearing)
|
|
1179 cmp->rbearing = cmp->pixel_width + metrics.rbearing;
|
|
1180 if (cmp->ascent < metrics.ascent)
|
|
1181 cmp->ascent = metrics.ascent;
|
|
1182 if (cmp->descent < metrics.descent)
|
|
1183 cmp->descent = metrics.descent;
|
|
1184 cmp->pixel_width += metrics.width + XINT (LGLYPH_WADJUST (g));
|
|
1185 }
|
|
1186 LGSTRING_SET_LBEARING (gstring, make_number (cmp->lbearing));
|
|
1187 LGSTRING_SET_RBEARING (gstring, make_number (cmp->rbearing));
|
|
1188 LGSTRING_SET_WIDTH (gstring, make_number (cmp->pixel_width));
|
|
1189 LGSTRING_SET_ASCENT (gstring, make_number (cmp->ascent));
|
|
1190 LGSTRING_SET_DESCENT (gstring, make_number (cmp->descent));
|
|
1191
|
|
1192 return font;
|
|
1193 }
|
|
1194
|
|
1195 int
|
|
1196 font_gstring_produce (old, from, to, new, idx, code, n)
|
|
1197 Lisp_Object old;
|
|
1198 int from, to;
|
|
1199 Lisp_Object new;
|
|
1200 int idx;
|
|
1201 unsigned *code;
|
|
1202 int n;
|
|
1203 {
|
|
1204 Lisp_Object min_idx, max_idx;
|
|
1205 int i;
|
|
1206
|
|
1207 if (idx + n > ASIZE (new))
|
|
1208 return -1;
|
|
1209 if (from == to)
|
|
1210 {
|
|
1211 if (from == 0)
|
|
1212 {
|
|
1213 min_idx = make_number (0);
|
|
1214 max_idx = make_number (1);
|
|
1215 }
|
|
1216 else
|
|
1217 {
|
|
1218 min_idx = AREF (AREF (old, from - 1), 0);
|
|
1219 max_idx = AREF (AREF (old, from - 1), 1);
|
|
1220 }
|
|
1221 }
|
|
1222 else if (from + 1 == to)
|
|
1223 {
|
|
1224 min_idx = AREF (AREF (old, from), 0);
|
|
1225 max_idx = AREF (AREF (old, from), 1);
|
|
1226 }
|
|
1227 else
|
|
1228 {
|
|
1229 int min_idx_i = XINT (AREF (AREF (old, from), 0));
|
|
1230 int max_idx_i = XINT (AREF (AREF (old, from), 1));
|
|
1231
|
|
1232 for (i = from + 1; i < to; i++)
|
|
1233 {
|
|
1234 if (min_idx_i > XINT (AREF (AREF (old, i), 0)))
|
|
1235 min_idx_i = XINT (AREF (AREF (old, i), 0));
|
|
1236 if (max_idx_i < XINT (AREF (AREF (old, i), 1)))
|
|
1237 max_idx_i = XINT (AREF (AREF (old, i), 1));
|
|
1238 }
|
|
1239 min_idx = make_number (min_idx_i);
|
|
1240 max_idx = make_number (max_idx_i);
|
|
1241 }
|
|
1242
|
|
1243 for (i = 0; i < n; i++)
|
|
1244 {
|
|
1245 ASET (AREF (new, idx + i), 0, min_idx);
|
|
1246 ASET (AREF (new, idx + i), 1, max_idx);
|
|
1247 ASET (AREF (new, idx + i), 2, make_number (code[i]));
|
|
1248 }
|
|
1249
|
|
1250 return 0;
|
|
1251 }
|
|
1252
|
|
1253 /* Font sorting */
|
|
1254
|
|
1255 static unsigned font_score P_ ((Lisp_Object, Lisp_Object));
|
|
1256 static int font_compare P_ ((const void *, const void *));
|
|
1257 static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object,
|
|
1258 Lisp_Object, Lisp_Object));
|
|
1259
|
|
1260 /* We sort fonts by scoring each of them against a specified
|
|
1261 font-spec. The score value is 32 bit (`unsigned'), and the smaller
|
|
1262 the value is, the closer the font is to the font-spec.
|
|
1263
|
|
1264 Each 1-bit in the highest 4 bits of the score is used for atomic
|
|
1265 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
|
|
1266
|
|
1267 Each 7-bit in the lowest 28 bits are used for numeric properties
|
|
1268 WEIGHT, SLANT, WIDTH, and SIZE. */
|
|
1269
|
|
1270 /* How many bits to shift to store the difference value of each font
|
|
1271 property in a score. */
|
|
1272 static int sort_shift_bits[FONT_SIZE_INDEX + 1];
|
|
1273
|
|
1274 /* Score font-entity ENTITY against font-spec SPEC. The return value
|
|
1275 indicates how different ENTITY is compared with SPEC. */
|
|
1276
|
|
1277 static unsigned
|
|
1278 font_score (entity, spec)
|
|
1279 Lisp_Object entity, spec;
|
|
1280 {
|
|
1281 unsigned score = 0;
|
|
1282 int i;
|
|
1283 /* Score atomic fields. Maximum difference is 1. */
|
|
1284 for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
|
|
1285 {
|
|
1286 Lisp_Object val = AREF (spec, i);
|
|
1287
|
|
1288 if (! NILP (val)
|
|
1289 && ! EQ (val, AREF (entity, i)))
|
|
1290 score |= 1 << sort_shift_bits[i];
|
|
1291 }
|
|
1292
|
|
1293 /* Score numeric fields. Maximum difference is 127. */
|
|
1294 for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
|
|
1295 {
|
|
1296 Lisp_Object spec_val = AREF (spec, i);
|
|
1297 Lisp_Object entity_val = AREF (entity, i);
|
|
1298
|
|
1299 if (! NILP (spec_val) && ! EQ (spec_val, entity_val))
|
|
1300 {
|
|
1301 if (! INTEGERP (entity_val))
|
|
1302 score |= 127 << sort_shift_bits[i];
|
|
1303 else if (i < FONT_SIZE_INDEX
|
|
1304 || XINT (entity_val) != 0)
|
|
1305 {
|
|
1306 int diff = XINT (entity_val) - XINT (spec_val);
|
|
1307
|
|
1308 if (diff < 0)
|
|
1309 diff = - diff;
|
|
1310 score |= min (diff, 127) << sort_shift_bits[i];
|
|
1311 }
|
|
1312 }
|
|
1313 }
|
|
1314
|
|
1315 return score;
|
|
1316 }
|
|
1317
|
|
1318
|
|
1319 /* The comparison function for qsort. */
|
|
1320
|
|
1321 static int
|
|
1322 font_compare (d1, d2)
|
|
1323 const void *d1, *d2;
|
|
1324 {
|
|
1325 return (*(unsigned *) d1 < *(unsigned *) d2
|
|
1326 ? -1 : *(unsigned *) d1 > *(unsigned *) d2);
|
|
1327 }
|
|
1328
|
|
1329
|
|
1330 /* The structure for elements being sorted by qsort. */
|
|
1331 struct font_sort_data
|
|
1332 {
|
|
1333 unsigned score;
|
|
1334 Lisp_Object entity;
|
|
1335 };
|
|
1336
|
|
1337
|
|
1338 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
|
|
1339 If PREFER specifies a point-size, calculate the corresponding
|
|
1340 pixel-size from the Y-resolution of FRAME before sorting. If SPEC
|
|
1341 is not nil, it is a font-spec to get the font-entities in VEC. */
|
|
1342
|
|
1343 static Lisp_Object
|
|
1344 font_sort_entites (vec, prefer, frame, spec)
|
|
1345 Lisp_Object vec, prefer, frame, spec;
|
|
1346 {
|
|
1347 Lisp_Object size;
|
|
1348 int len, i;
|
|
1349 struct font_sort_data *data;
|
|
1350 int prefer_is_copy = 0;
|
|
1351 USE_SAFE_ALLOCA;
|
|
1352
|
|
1353 len = ASIZE (vec);
|
|
1354 if (len <= 1)
|
|
1355 return vec;
|
|
1356
|
|
1357 size = AREF (spec, FONT_SIZE_INDEX);
|
|
1358 if (FLOATP (size))
|
|
1359 {
|
|
1360 double point_size = XFLOAT_DATA (size) * 10;
|
|
1361 int pixel_size = POINT_TO_PIXEL (point_size, XFRAME (frame)->resy);
|
|
1362
|
|
1363 prefer = Fcopy_sequence (prefer);
|
|
1364 ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size));
|
|
1365 prefer_is_copy = 1;
|
|
1366 }
|
|
1367
|
|
1368 if (! NILP (spec))
|
|
1369 {
|
|
1370 /* As it is assured that all fonts in VEC match with SPEC, we
|
|
1371 should ignore properties specified in SPEC. So, set the
|
|
1372 corresponding properties in PREFER nil. */
|
|
1373 for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
|
|
1374 if (! NILP (AREF (spec, i)) && ! NILP (AREF (prefer, i)))
|
|
1375 break;
|
|
1376 if (i <= FONT_SIZE_INDEX)
|
|
1377 {
|
|
1378 if (! prefer_is_copy)
|
|
1379 prefer = Fcopy_sequence (prefer);
|
|
1380 for (; i <= FONT_SIZE_INDEX; i++)
|
|
1381 if (! NILP (AREF (spec, i)) && ! NILP (AREF (prefer, i)))
|
|
1382 ASET (prefer, i, Qnil);
|
|
1383 }
|
|
1384 }
|
|
1385
|
|
1386 /* Scoring and sorting. */
|
|
1387 SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len);
|
|
1388 for (i = 0; i < len; i++)
|
|
1389 {
|
|
1390 data[i].entity = AREF (vec, i);
|
|
1391 data[i].score = font_score (data[i].entity, prefer);
|
|
1392 }
|
|
1393 qsort (data, len, sizeof *data, font_compare);
|
|
1394 for (i = 0; i < len; i++)
|
|
1395 ASET (vec, i, data[i].entity);
|
|
1396 SAFE_FREE ();
|
|
1397
|
|
1398 return vec;
|
|
1399 }
|
|
1400
|
|
1401
|
|
1402 /* API of Font Service Layer. */
|
|
1403
|
|
1404 void
|
|
1405 font_update_sort_order (order)
|
|
1406 int *order;
|
|
1407 {
|
|
1408 int i, shift_bits = 21;
|
|
1409
|
|
1410 for (i = 0; i < 4; i++, shift_bits -= 7)
|
|
1411 {
|
|
1412 int xlfd_idx = order[i];
|
|
1413
|
|
1414 if (xlfd_idx == XLFD_WEIGHT_INDEX)
|
|
1415 sort_shift_bits[FONT_WEIGHT_INDEX] = shift_bits;
|
|
1416 else if (xlfd_idx == XLFD_SLANT_INDEX)
|
|
1417 sort_shift_bits[FONT_SLANT_INDEX] = shift_bits;
|
|
1418 else if (xlfd_idx == XLFD_SWIDTH_INDEX)
|
|
1419 sort_shift_bits[FONT_WIDTH_INDEX] = shift_bits;
|
|
1420 else
|
|
1421 sort_shift_bits[FONT_SIZE_INDEX] = shift_bits;
|
|
1422 }
|
|
1423 }
|
|
1424
|
|
1425 Lisp_Object
|
|
1426 font_symbolic_weight (font)
|
|
1427 Lisp_Object font;
|
|
1428 {
|
|
1429 Lisp_Object weight = AREF (font, FONT_WEIGHT_INDEX);
|
|
1430
|
|
1431 if (INTEGERP (weight))
|
|
1432 weight = prop_numeric_to_name (FONT_WEIGHT_INDEX, XINT (weight));
|
|
1433 return weight;
|
|
1434 }
|
|
1435
|
|
1436 Lisp_Object
|
|
1437 font_symbolic_slant (font)
|
|
1438 Lisp_Object font;
|
|
1439 {
|
|
1440 Lisp_Object slant = AREF (font, FONT_SLANT_INDEX);
|
|
1441
|
|
1442 if (INTEGERP (slant))
|
|
1443 slant = prop_numeric_to_name (FONT_SLANT_INDEX, XINT (slant));
|
|
1444 return slant;
|
|
1445 }
|
|
1446
|
|
1447 Lisp_Object
|
|
1448 font_symbolic_width (font)
|
|
1449 Lisp_Object font;
|
|
1450 {
|
|
1451 Lisp_Object width = AREF (font, FONT_WIDTH_INDEX);
|
|
1452
|
|
1453 if (INTEGERP (width))
|
|
1454 width = prop_numeric_to_name (FONT_WIDTH_INDEX, XINT (width));
|
|
1455 return width;
|
|
1456 }
|
|
1457
|
|
1458 Lisp_Object
|
|
1459 font_find_object (font)
|
|
1460 struct font *font;
|
|
1461 {
|
|
1462 Lisp_Object tail, elt;
|
|
1463
|
|
1464 for (tail = AREF (font->entity, FONT_OBJLIST_INDEX); CONSP (tail);
|
|
1465 tail = XCDR (tail))
|
|
1466 {
|
|
1467 elt = XCAR (tail);
|
|
1468 if (font == XSAVE_VALUE (elt)->pointer
|
|
1469 && XSAVE_VALUE (elt)->integer > 0)
|
|
1470 return elt;
|
|
1471 }
|
|
1472 abort ();
|
|
1473 return Qnil;
|
|
1474 }
|
|
1475
|
|
1476 static Lisp_Object scratch_font_spec, scratch_font_prefer;
|
|
1477
|
|
1478 /* Return a vector of font-entities matching with SPEC on frame F. */
|
|
1479
|
|
1480 static Lisp_Object
|
|
1481 font_list_entities (frame, spec)
|
|
1482 Lisp_Object frame, spec;
|
|
1483 {
|
|
1484 FRAME_PTR f = XFRAME (frame);
|
|
1485 struct font_driver_list *driver_list = f->font_driver_list;
|
|
1486 Lisp_Object ftype, family, alternate_familes;
|
|
1487 Lisp_Object *vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
|
|
1488 int i;
|
|
1489
|
|
1490 if (! vec)
|
|
1491 return null_vector;
|
|
1492
|
|
1493 family = AREF (spec, FONT_FAMILY_INDEX);
|
|
1494 if (NILP (family))
|
|
1495 alternate_familes = Qnil;
|
|
1496 else
|
|
1497 {
|
|
1498 if (NILP (font_family_alist)
|
|
1499 && !NILP (Vface_alternative_font_family_alist))
|
|
1500 build_font_family_alist ();
|
|
1501 alternate_familes = assq_no_quit (family, font_family_alist);
|
|
1502 if (! NILP (alternate_familes))
|
|
1503 alternate_familes = XCDR (alternate_familes);
|
|
1504 }
|
|
1505 xassert (ASIZE (spec) == FONT_SPEC_MAX);
|
|
1506 ftype = AREF (spec, FONT_TYPE_INDEX);
|
|
1507
|
|
1508 for (i = 0; driver_list; driver_list = driver_list->next)
|
|
1509 if (NILP (ftype) || EQ (driver_list->driver->type, ftype))
|
|
1510 {
|
|
1511 Lisp_Object cache = driver_list->driver->get_cache (frame);
|
|
1512 Lisp_Object tail = alternate_familes;
|
|
1513 Lisp_Object val;
|
|
1514
|
|
1515 xassert (CONSP (cache));
|
|
1516 ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type);
|
|
1517 ASET (spec, FONT_FAMILY_INDEX, family);
|
|
1518
|
|
1519 while (1)
|
|
1520 {
|
|
1521 val = assoc_no_quit (spec, XCDR (cache));
|
|
1522 if (CONSP (val))
|
|
1523 val = XCDR (val);
|
|
1524 else
|
|
1525 {
|
|
1526 val = driver_list->driver->list (frame, spec);
|
|
1527 if (VECTORP (val))
|
|
1528 XSETCDR (cache, Fcons (Fcons (Fcopy_sequence (spec), val),
|
|
1529 XCDR (cache)));
|
|
1530 }
|
|
1531 if (VECTORP (val) && ASIZE (val) > 0)
|
|
1532 {
|
|
1533 vec[i++] = val;
|
|
1534 break;
|
|
1535 }
|
|
1536 if (NILP (tail))
|
|
1537 break;
|
|
1538 ASET (spec, FONT_FAMILY_INDEX, XCAR (tail));
|
|
1539 tail = XCDR (tail);
|
|
1540 }
|
|
1541 }
|
|
1542 ASET (spec, FONT_TYPE_INDEX, ftype);
|
|
1543 ASET (spec, FONT_FAMILY_INDEX, family);
|
|
1544 return (i > 0 ? Fvconcat (i, vec) : null_vector);
|
|
1545 }
|
|
1546
|
|
1547 static int num_fonts;
|
|
1548
|
|
1549 static Lisp_Object
|
|
1550 font_open_entity (f, entity, pixel_size)
|
|
1551 FRAME_PTR f;
|
|
1552 Lisp_Object entity;
|
|
1553 int pixel_size;
|
|
1554 {
|
|
1555 struct font_driver_list *driver_list;
|
|
1556 Lisp_Object objlist, size, val;
|
|
1557 struct font *font;
|
|
1558
|
|
1559 size = AREF (entity, FONT_SIZE_INDEX);
|
|
1560 xassert (NATNUMP (size));
|
|
1561 if (XINT (size) != 0)
|
|
1562 pixel_size = XINT (size);
|
|
1563
|
|
1564 for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
|
|
1565 objlist = XCDR (objlist))
|
|
1566 {
|
|
1567 font = XSAVE_VALUE (XCAR (objlist))->pointer;
|
|
1568 if (font->pixel_size == pixel_size)
|
|
1569 {
|
|
1570 XSAVE_VALUE (XCAR (objlist))->integer++;
|
|
1571 return XCAR (objlist);
|
|
1572 }
|
|
1573 }
|
|
1574
|
|
1575 xassert (FONT_ENTITY_P (entity));
|
|
1576 val = AREF (entity, FONT_TYPE_INDEX);
|
|
1577 for (driver_list = f->font_driver_list;
|
|
1578 driver_list && ! EQ (driver_list->driver->type, val);
|
|
1579 driver_list = driver_list->next);
|
|
1580 if (! driver_list)
|
|
1581 return Qnil;
|
|
1582
|
|
1583 font = driver_list->driver->open (f, entity, pixel_size);
|
|
1584 if (! font)
|
|
1585 return Qnil;
|
|
1586 val = make_save_value (font, 1);
|
|
1587 ASET (entity, FONT_OBJLIST_INDEX,
|
|
1588 Fcons (val, AREF (entity, FONT_OBJLIST_INDEX)));
|
|
1589 num_fonts++;
|
|
1590 return val;
|
|
1591 }
|
|
1592
|
|
1593 void
|
|
1594 font_close_object (f, font_object)
|
|
1595 FRAME_PTR f;
|
|
1596 Lisp_Object font_object;
|
|
1597 {
|
|
1598 struct font *font;
|
|
1599 Lisp_Object objlist = AREF (font->entity, FONT_OBJLIST_INDEX);
|
|
1600 Lisp_Object tail, prev = Qnil;
|
|
1601
|
|
1602 for (prev = Qnil, tail = objlist; CONSP (tail);
|
|
1603 prev = tail, tail = XCDR (tail))
|
|
1604 if (EQ (font_object, XCAR (tail)))
|
|
1605 {
|
|
1606 struct Lisp_Save_Value *p = XSAVE_VALUE (font_object);
|
|
1607
|
|
1608 xassert (p->integer > 0);
|
|
1609 p->integer--;
|
|
1610 if (p->integer == 0)
|
|
1611 {
|
|
1612 if (font->driver->close)
|
|
1613 font->driver->close (f, p->pointer);
|
|
1614 p->pointer = NULL;
|
|
1615 if (NILP (prev))
|
|
1616 ASET (font->entity, FONT_OBJLIST_INDEX, XCDR (objlist));
|
|
1617 else
|
|
1618 XSETCDR (prev, XCDR (objlist));
|
|
1619 }
|
|
1620 break;
|
|
1621 }
|
|
1622 }
|
|
1623
|
|
1624 int
|
|
1625 font_has_char (f, font_entity, c)
|
|
1626 FRAME_PTR f;
|
|
1627 Lisp_Object font_entity;
|
|
1628 int c;
|
|
1629 {
|
|
1630 Lisp_Object type = AREF (font_entity, FONT_TYPE_INDEX);
|
|
1631 struct font_driver_list *driver_list;
|
|
1632
|
|
1633 for (driver_list = f->font_driver_list;
|
|
1634 driver_list && ! EQ (driver_list->driver->type, type);
|
|
1635 driver_list = driver_list->next);
|
|
1636 if (! driver_list)
|
|
1637 return -1;
|
|
1638 return driver_list->driver->has_char (font_entity, c);
|
|
1639 }
|
|
1640
|
|
1641 unsigned
|
|
1642 font_encode_char (font_object, c)
|
|
1643 Lisp_Object font_object;
|
|
1644 int c;
|
|
1645 {
|
|
1646 struct font *font = XSAVE_VALUE (font_object)->pointer;
|
|
1647
|
|
1648 return font->driver->encode_char (font, c);
|
|
1649 }
|
|
1650
|
|
1651 char *
|
|
1652 font_get_name (font_object)
|
|
1653 Lisp_Object font_object;
|
|
1654 {
|
|
1655 struct font *font = XSAVE_VALUE (font_object)->pointer;
|
|
1656
|
|
1657 return (font->font.full_name ? font->font.full_name
|
|
1658 : font->file_name ? font->file_name
|
|
1659 : "");
|
|
1660 }
|
|
1661
|
|
1662 Lisp_Object
|
|
1663 font_get_frame (font)
|
|
1664 Lisp_Object font;
|
|
1665 {
|
|
1666 if (FONT_OBJECT_P (font))
|
|
1667 font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity;
|
|
1668 xassert (FONT_ENTITY_P (font));
|
|
1669 return AREF (font, FONT_FRAME_INDEX);
|
|
1670 }
|
|
1671
|
|
1672 extern Lisp_Object Qunspecified, Qignore_defface;
|
|
1673
|
|
1674 Lisp_Object
|
|
1675 font_find_for_lface (f, lface, spec)
|
|
1676 FRAME_PTR f;
|
|
1677 Lisp_Object *lface;
|
|
1678 Lisp_Object spec;
|
|
1679 {
|
|
1680 Lisp_Object attrs[LFACE_SLANT_INDEX + 1];
|
|
1681 Lisp_Object frame, val, entities;
|
|
1682 int i;
|
|
1683 unsigned char try_unspecified[FONT_SPEC_MAX];
|
|
1684
|
|
1685 for (i = 0; i <= LFACE_SLANT_INDEX; i++)
|
|
1686 {
|
|
1687 val = lface[i];
|
|
1688 if (EQ (val, Qunspecified) || EQ (val, Qignore_defface))
|
|
1689 val = Qnil;
|
|
1690 attrs[i] = val;
|
|
1691 }
|
|
1692 if (NILP (spec))
|
|
1693 for (i = 0; i < FONT_SPEC_MAX; i++)
|
|
1694 ASET (scratch_font_spec, i, Qnil);
|
|
1695 else
|
|
1696 for (i = 0; i < FONT_SPEC_MAX; i++)
|
|
1697 ASET (scratch_font_spec, i, AREF (spec, i));
|
|
1698
|
|
1699 /* If SPEC doesn't specify a specific property, it can be tried with
|
|
1700 nil even if FACE specifies it. */
|
|
1701 for (i = FONT_FOUNDRY_INDEX; i <= FONT_SIZE_INDEX; i++)
|
|
1702 try_unspecified[i] = NILP (AREF (scratch_font_spec, i));
|
|
1703
|
|
1704 if (STRINGP (attrs[LFACE_FONT_INDEX]))
|
|
1705 font_merge_old_spec (attrs[LFACE_FONT_INDEX], Qnil, Qnil,
|
|
1706 scratch_font_spec);
|
|
1707 if (NILP (AREF (scratch_font_spec, FONT_FAMILY_INDEX))
|
|
1708 && ! NILP (attrs[LFACE_FAMILY_INDEX]))
|
|
1709 font_merge_old_spec (Qnil, attrs[LFACE_FAMILY_INDEX], Qnil,
|
|
1710 scratch_font_spec);
|
|
1711 if (NILP (AREF (scratch_font_spec, FONT_REGISTRY_INDEX)))
|
|
1712 {
|
|
1713 ASET (scratch_font_spec, FONT_REGISTRY_INDEX, intern ("iso8859-1"));
|
|
1714 try_unspecified[FONT_REGISTRY_INDEX] = 0;
|
|
1715 }
|
|
1716
|
|
1717 for (i = FONT_FAMILY_INDEX; i <= FONT_SIZE_INDEX; i++)
|
|
1718 if (try_unspecified[i]
|
|
1719 && NILP (AREF (scratch_font_spec, i)))
|
|
1720 try_unspecified[i] = 0;
|
|
1721
|
|
1722 XSETFRAME (frame, f);
|
|
1723 entities = font_list_entities (frame, scratch_font_spec);
|
|
1724 while (ASIZE (entities) == 0)
|
|
1725 {
|
|
1726 if (try_unspecified[FONT_WEIGHT_INDEX]
|
|
1727 || try_unspecified[FONT_SLANT_INDEX]
|
|
1728 || try_unspecified[FONT_WIDTH_INDEX]
|
|
1729 || try_unspecified[FONT_SIZE_INDEX])
|
|
1730 {
|
|
1731 for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
|
|
1732 {
|
|
1733 try_unspecified[i] = 0;
|
|
1734 ASET (scratch_font_spec, i, Qnil);
|
|
1735 }
|
|
1736 entities = font_list_entities (frame, scratch_font_spec);
|
|
1737 }
|
|
1738 else if (try_unspecified[FONT_FOUNDRY_INDEX])
|
|
1739 {
|
|
1740 try_unspecified[FONT_FOUNDRY_INDEX] = 0;
|
|
1741 ASET (scratch_font_spec, FONT_FOUNDRY_INDEX, Qnil);
|
|
1742 entities = font_list_entities (frame, scratch_font_spec);
|
|
1743 }
|
|
1744 else if (try_unspecified[FONT_FAMILY_INDEX])
|
|
1745 {
|
|
1746 try_unspecified[FONT_FAMILY_INDEX] = 0;
|
|
1747 ASET (scratch_font_spec, FONT_FAMILY_INDEX, Qnil);
|
|
1748 entities = font_list_entities (frame, scratch_font_spec);
|
|
1749 }
|
|
1750 else
|
|
1751 return Qnil;
|
|
1752 }
|
|
1753
|
|
1754 if (ASIZE (entities) > 1)
|
|
1755 {
|
|
1756 Lisp_Object prefer = scratch_font_prefer;
|
|
1757
|
|
1758 for (i = 0; i < FONT_WEIGHT_INDEX; i++)
|
|
1759 ASET (prefer, i, Qnil);
|
|
1760 if (! NILP (attrs[LFACE_WEIGHT_INDEX]))
|
|
1761 ASET (prefer, FONT_WEIGHT_INDEX,
|
|
1762 font_prop_validate_style (FONT_WEIGHT_INDEX,
|
|
1763 attrs[LFACE_WEIGHT_INDEX]));
|
|
1764 if (! NILP (attrs[LFACE_SLANT_INDEX]))
|
|
1765 ASET (prefer, FONT_SLANT_INDEX,
|
|
1766 font_prop_validate_style (FONT_SLANT_INDEX,
|
|
1767 attrs[LFACE_SLANT_INDEX]));
|
|
1768 if (! NILP (attrs[LFACE_SWIDTH_INDEX]))
|
|
1769 ASET (prefer, FONT_WIDTH_INDEX,
|
|
1770 font_prop_validate_style (FONT_WIDTH_INDEX,
|
|
1771 attrs[LFACE_SWIDTH_INDEX]));
|
|
1772 if (! NILP (attrs[LFACE_HEIGHT_INDEX]))
|
|
1773 {
|
|
1774 int size;
|
|
1775
|
|
1776 val = attrs[LFACE_HEIGHT_INDEX];
|
|
1777 size = POINT_TO_PIXEL (XINT (val), f->resy);
|
|
1778 ASET (prefer, FONT_SIZE_INDEX, make_number (size));
|
|
1779 }
|
|
1780 font_sort_entites (entities, prefer, frame, spec);
|
|
1781 }
|
|
1782
|
|
1783 return AREF (entities, 0);
|
|
1784 }
|
|
1785
|
|
1786 Lisp_Object
|
|
1787 font_open_for_lface (f, lface, entity)
|
|
1788 FRAME_PTR f;
|
|
1789 Lisp_Object *lface;
|
|
1790 Lisp_Object entity;
|
|
1791 {
|
|
1792 int pt = XINT (lface[LFACE_HEIGHT_INDEX]);
|
|
1793 int size = POINT_TO_PIXEL (pt, f->resy);
|
|
1794
|
|
1795 return font_open_entity (f, entity, size);
|
|
1796 }
|
|
1797
|
|
1798 void
|
|
1799 font_load_for_face (f, face)
|
|
1800 FRAME_PTR f;
|
|
1801 struct face *face;
|
|
1802 {
|
|
1803 Lisp_Object entity;
|
|
1804
|
|
1805 face->font_info_id = -1;
|
|
1806 face->font_info = NULL;
|
|
1807 face->font = NULL;
|
|
1808 face->font_name = NULL;
|
|
1809
|
|
1810 entity = font_find_for_lface (f, face->lface, Qnil);
|
|
1811 if (! NILP (entity))
|
|
1812 {
|
|
1813 Lisp_Object font_object = font_open_for_lface (f, face->lface, entity);
|
|
1814
|
|
1815 if (! NILP (font_object))
|
|
1816 {
|
|
1817 struct font *font = XSAVE_VALUE (font_object)->pointer;
|
|
1818
|
|
1819 face->font = font->font.font;
|
|
1820 face->font_info = (struct font_info *) font;
|
|
1821 face->font_info_id = 0;
|
|
1822 face->font_name = font->font.full_name;
|
|
1823 }
|
|
1824 }
|
|
1825 if (! face->font)
|
|
1826 add_to_log ("Unable to load font for a face%s", null_string, Qnil);
|
|
1827 }
|
|
1828
|
|
1829 void
|
|
1830 font_prepare_for_face (f, face)
|
|
1831 FRAME_PTR f;
|
|
1832 struct face *face;
|
|
1833 {
|
|
1834 struct font *font = (struct font *) face->font_info;
|
|
1835
|
|
1836 if (font->driver->prepare_face)
|
|
1837 font->driver->prepare_face (f, face);
|
|
1838 }
|
|
1839
|
|
1840 void
|
|
1841 font_done_for_face (f, face)
|
|
1842 FRAME_PTR f;
|
|
1843 struct face *face;
|
|
1844 {
|
|
1845 struct font *font = (struct font *) face->font_info;
|
|
1846
|
|
1847 if (font->driver->done_face)
|
|
1848 font->driver->done_face (f, face);
|
|
1849 face->extra = NULL;
|
|
1850 }
|
|
1851
|
|
1852 Lisp_Object
|
|
1853 font_open_by_name (f, name)
|
|
1854 FRAME_PTR f;
|
|
1855 char *name;
|
|
1856 {
|
|
1857 Lisp_Object spec = Ffont_spec (0, NULL);
|
|
1858 Lisp_Object entities = Qnil;
|
|
1859 Lisp_Object frame;
|
|
1860 int pixel_size;
|
|
1861
|
|
1862 XSETFRAME (frame, f);
|
|
1863
|
|
1864 ASET (spec, FONT_EXTRA_INDEX,
|
|
1865 Fcons (Fcons (QCname, make_unibyte_string (name, strlen (name))),
|
|
1866 Qnil));
|
|
1867 entities = font_list_entities (frame, spec);
|
|
1868 if (ASIZE (entities) == 0)
|
|
1869 return Qnil;
|
|
1870 pixel_size = XINT (AREF (AREF (entities, 0), FONT_SIZE_INDEX));
|
|
1871 if (pixel_size == 0)
|
|
1872 pixel_size = 12;
|
|
1873 return font_open_entity (f, AREF (entities, 0), pixel_size);
|
|
1874 }
|
|
1875
|
|
1876
|
|
1877 /* Register font-driver DRIVER. This function is used in two ways.
|
|
1878
|
|
1879 The first is with frame F non-NULL. In this case, DRIVER is
|
|
1880 registered to be used for drawing characters on F. All frame
|
|
1881 creaters (e.g. Fx_create_frame) must call this function at least
|
|
1882 once with an available font-driver.
|
|
1883
|
|
1884 The second is with frame F NULL. In this case, DRIVER is globally
|
|
1885 registered in the variable `font_driver_list'. All font-driver
|
|
1886 implementations must call this function in its syms_of_XXXX
|
|
1887 (e.g. syms_of_xfont). */
|
|
1888
|
|
1889 void
|
|
1890 register_font_driver (driver, f)
|
|
1891 struct font_driver *driver;
|
|
1892 FRAME_PTR f;
|
|
1893 {
|
|
1894 struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
|
|
1895 struct font_driver_list *prev, *list;
|
|
1896
|
|
1897 if (f && ! driver->draw)
|
|
1898 error ("Unsable font driver for a frame: %s",
|
|
1899 SDATA (SYMBOL_NAME (driver->type)));
|
|
1900
|
|
1901 for (prev = NULL, list = root; list; prev = list, list = list->next)
|
|
1902 if (list->driver->type == driver->type)
|
|
1903 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
|
|
1904
|
|
1905 list = malloc (sizeof (struct font_driver_list));
|
|
1906 list->driver = driver;
|
|
1907 list->next = NULL;
|
|
1908 if (prev)
|
|
1909 prev->next = list;
|
|
1910 else if (f)
|
|
1911 f->font_driver_list = list;
|
|
1912 else
|
|
1913 font_driver_list = list;
|
|
1914 num_font_drivers++;
|
|
1915 }
|
|
1916
|
|
1917 /* Free font-driver list on frame F. It doesn't free font-drivers
|
|
1918 themselves. */
|
|
1919
|
|
1920 void
|
|
1921 free_font_driver_list (f)
|
|
1922 FRAME_PTR f;
|
|
1923 {
|
|
1924 while (f->font_driver_list)
|
|
1925 {
|
|
1926 struct font_driver_list *next = f->font_driver_list->next;
|
|
1927
|
|
1928 free (f->font_driver_list);
|
|
1929 f->font_driver_list = next;
|
|
1930 }
|
|
1931 }
|
|
1932
|
|
1933
|
|
1934 /* Lisp API */
|
|
1935
|
|
1936 DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0,
|
|
1937 doc: /* Return t if object is a font-spec or font-entity. */)
|
|
1938 (object)
|
|
1939 Lisp_Object object;
|
|
1940 {
|
|
1941 return (FONTP (object) ? Qt : Qnil);
|
|
1942 }
|
|
1943
|
|
1944 DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
|
|
1945 doc: /* Return a newly created font-spec with specified arguments as properties.
|
|
1946 usage: (font-spec &rest properties) */)
|
|
1947 (nargs, args)
|
|
1948 int nargs;
|
|
1949 Lisp_Object *args;
|
|
1950 {
|
|
1951 Lisp_Object spec = Fmake_vector (make_number (FONT_SPEC_MAX), Qnil);
|
|
1952 Lisp_Object extra = Qnil;
|
|
1953 int i;
|
|
1954
|
|
1955 for (i = 0; i < nargs; i += 2)
|
|
1956 {
|
|
1957 enum font_property_index prop;
|
|
1958 Lisp_Object key = args[i], val = args[i + 1];
|
|
1959
|
|
1960 prop = check_font_prop_name (key);
|
|
1961 if (prop < FONT_EXTRA_INDEX)
|
|
1962 ASET (spec, prop, (font_property_table[prop].validater) (prop, val));
|
|
1963 else
|
|
1964 extra = Fcons (Fcons (key, val), extra);
|
|
1965 }
|
|
1966 ASET (spec, FONT_EXTRA_INDEX, extra);
|
|
1967 return spec;
|
|
1968 }
|
|
1969
|
|
1970
|
|
1971 DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
|
|
1972 doc: /* Return the value of FONT's PROP property.
|
|
1973 FONT may be a font-spec or font-entity.
|
|
1974 If FONT is font-entity and PROP is :extra, always nil is returned. */)
|
|
1975 (font, prop)
|
|
1976 Lisp_Object font, prop;
|
|
1977 {
|
|
1978 enum font_property_index idx;
|
|
1979
|
|
1980 CHECK_FONT (font);
|
|
1981 idx = check_font_prop_name (prop);
|
|
1982 if (idx < FONT_EXTRA_INDEX)
|
|
1983 return AREF (font, idx);
|
|
1984 if (FONT_ENTITY_P (font))
|
|
1985 return Qnil;
|
|
1986 return Fcdr (Fassoc (AREF (font, FONT_EXTRA_INDEX), prop));
|
|
1987 }
|
|
1988
|
|
1989
|
|
1990 DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
|
|
1991 doc: /* Set one property of FONT-SPEC: give property PROP value VALUE. */)
|
|
1992 (font_spec, prop, val)
|
|
1993 Lisp_Object font_spec, prop, val;
|
|
1994 {
|
|
1995 enum font_property_index idx;
|
|
1996 Lisp_Object extra, slot;
|
|
1997
|
|
1998 CHECK_FONT_SPEC (font_spec);
|
|
1999 idx = check_font_prop_name (prop);
|
|
2000 if (idx < FONT_EXTRA_INDEX)
|
|
2001 return ASET (font_spec, idx, val);
|
|
2002 extra = AREF (font_spec, FONT_EXTRA_INDEX);
|
|
2003 slot = Fassoc (extra, prop);
|
|
2004 if (NILP (slot))
|
|
2005 extra = Fcons (Fcons (prop, val), extra);
|
|
2006 else
|
|
2007 Fsetcdr (slot, val);
|
|
2008 return val;
|
|
2009 }
|
|
2010
|
|
2011 DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
|
|
2012 doc: /* List available fonts matching FONT-SPEC on the current frame.
|
|
2013 Optional 2nd argument FRAME specifies the target frame.
|
|
2014 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
|
|
2015 Optional 4th argument PREFER, if non-nil, is a font-spec to sort fonts
|
|
2016 by closeness to PREFER. */)
|
|
2017 (font_spec, frame, num, prefer)
|
|
2018 Lisp_Object font_spec, frame, num, prefer;
|
|
2019 {
|
|
2020 Lisp_Object vec, list, tail;
|
|
2021 int n = 0, i, len;
|
|
2022
|
|
2023 if (NILP (frame))
|
|
2024 frame = selected_frame;
|
|
2025 CHECK_LIVE_FRAME (frame);
|
|
2026 CHECK_VALIDATE_FONT_SPEC (font_spec);
|
|
2027 if (! NILP (num))
|
|
2028 {
|
|
2029 CHECK_NUMBER (num);
|
|
2030 n = XINT (num);
|
|
2031 if (n <= 0)
|
|
2032 return Qnil;
|
|
2033 }
|
|
2034 if (! NILP (prefer))
|
|
2035 CHECK_FONT (prefer);
|
|
2036
|
|
2037 vec = font_list_entities (frame, font_spec);
|
|
2038 len = ASIZE (vec);
|
|
2039 if (len == 0)
|
|
2040 return Qnil;
|
|
2041 if (len == 1)
|
|
2042 return Fcons (AREF (vec, 0), Qnil);
|
|
2043
|
|
2044 if (! NILP (prefer))
|
|
2045 vec = font_sort_entites (vec, prefer, frame, font_spec);
|
|
2046
|
|
2047 list = tail = Fcons (AREF (vec, 0), Qnil);
|
|
2048 if (n == 0 || n > len)
|
|
2049 n = len;
|
|
2050 for (i = 1; i < n; i++)
|
|
2051 {
|
|
2052 Lisp_Object val = Fcons (AREF (vec, i), Qnil);
|
|
2053
|
|
2054 XSETCDR (tail, val);
|
|
2055 tail = val;
|
|
2056 }
|
|
2057 return list;
|
|
2058 }
|
|
2059
|
|
2060 DEFUN ("list-families", Flist_families, Slist_families, 0, 1, 0,
|
|
2061 doc: /* List available font families on the current frame.
|
|
2062 Optional 2nd argument FRAME specifies the target frame. */)
|
|
2063 (frame)
|
|
2064 Lisp_Object frame;
|
|
2065 {
|
|
2066 FRAME_PTR f;
|
|
2067 struct font_driver_list *driver_list;
|
|
2068 Lisp_Object list;
|
|
2069
|
|
2070 if (NILP (frame))
|
|
2071 frame = selected_frame;
|
|
2072 CHECK_LIVE_FRAME (frame);
|
|
2073 f = XFRAME (frame);
|
|
2074 list = Qnil;
|
|
2075 for (driver_list = f->font_driver_list; driver_list;
|
|
2076 driver_list = driver_list->next)
|
|
2077 if (driver_list->driver->list_family)
|
|
2078 {
|
|
2079 Lisp_Object val = driver_list->driver->list_family (frame);
|
|
2080
|
|
2081 if (NILP (list))
|
|
2082 list = val;
|
|
2083 else
|
|
2084 {
|
|
2085 Lisp_Object tail = list;
|
|
2086
|
|
2087 for (; CONSP (val); val = XCDR (val))
|
|
2088 if (NILP (Fmemq (XCAR (val), tail)))
|
|
2089 list = Fcons (XCAR (val), list);
|
|
2090 }
|
|
2091 }
|
|
2092 return list;
|
|
2093 }
|
|
2094
|
|
2095 DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
|
|
2096 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
|
|
2097 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
|
|
2098 (font_spec, frame)
|
|
2099 Lisp_Object font_spec, frame;
|
|
2100 {
|
|
2101 Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil);
|
|
2102
|
|
2103 if (CONSP (val))
|
|
2104 val = XCAR (val);
|
|
2105 return val;
|
|
2106 }
|
|
2107
|
|
2108 DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 1, 0,
|
|
2109 doc: /* Return XLFD name of FONT.
|
|
2110 FONT is a font-spec, font-entity, or font-object.
|
|
2111 If the name is too long for XLFD (maximum 255 chars), return nil. */)
|
|
2112 (font)
|
|
2113 Lisp_Object font;
|
|
2114 {
|
|
2115 char name[256];
|
|
2116 int pixel_size = 0;
|
|
2117
|
|
2118 if (FONT_SPEC_P (font))
|
|
2119 CHECK_VALIDATE_FONT_SPEC (font);
|
|
2120 else if (FONT_ENTITY_P (font))
|
|
2121 CHECK_FONT (font);
|
|
2122 else
|
|
2123 {
|
|
2124 struct font *fontp;
|
|
2125
|
|
2126 CHECK_FONT_GET_OBJECT (font, fontp);
|
|
2127 font = fontp->entity;
|
|
2128 pixel_size = fontp->pixel_size;
|
|
2129 }
|
|
2130
|
|
2131 if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
|
|
2132 return Qnil;
|
|
2133 return build_string (name);
|
|
2134 }
|
|
2135
|
|
2136 DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
|
|
2137 doc: /* Clear font cache. */)
|
|
2138 ()
|
|
2139 {
|
|
2140 Lisp_Object list, frame;
|
|
2141
|
|
2142 FOR_EACH_FRAME (list, frame)
|
|
2143 {
|
|
2144 FRAME_PTR f = XFRAME (frame);
|
|
2145 struct font_driver_list *driver_list = f->font_driver_list;
|
|
2146
|
|
2147 for (; driver_list; driver_list = driver_list->next)
|
|
2148 {
|
|
2149 Lisp_Object cache = driver_list->driver->get_cache (frame);
|
|
2150 Lisp_Object tail, elt;
|
|
2151
|
|
2152 for (tail = XCDR (cache); CONSP (tail); tail = XCDR (tail))
|
|
2153 {
|
|
2154 elt = XCAR (tail);
|
|
2155 if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
|
|
2156 {
|
|
2157 Lisp_Object vec = XCDR (elt);
|
|
2158 int i;
|
|
2159
|
|
2160 for (i = 0; i < ASIZE (vec); i++)
|
|
2161 {
|
|
2162 Lisp_Object entity = AREF (vec, i);
|
|
2163 Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
|
|
2164
|
|
2165 for (; CONSP (objlist); objlist = XCDR (objlist))
|
|
2166 {
|
|
2167 Lisp_Object val = XCAR (objlist);
|
|
2168 struct Lisp_Save_Value *p = XSAVE_VALUE (val);
|
|
2169 struct font *font = p->pointer;
|
|
2170
|
|
2171 xassert (font
|
|
2172 && driver_list->driver == font->driver);
|
|
2173 driver_list->driver->close (f, font);
|
|
2174 p->pointer = NULL;
|
|
2175 p->integer = 0;
|
|
2176 }
|
|
2177 if (driver_list->driver->free_entity)
|
|
2178 driver_list->driver->free_entity (entity);
|
|
2179 }
|
|
2180 }
|
|
2181 }
|
|
2182 XSETCDR (cache, Qnil);
|
|
2183 }
|
|
2184 }
|
|
2185
|
|
2186 return Qnil;
|
|
2187 }
|
|
2188
|
|
2189 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table,
|
|
2190 Sinternal_set_font_style_table, 2, 2, 0,
|
|
2191 doc: /* Set font style table for PROP to TABLE.
|
|
2192 PROP must be `:weight', `:slant', or `:width'.
|
|
2193 TABLE must be an alist of symbols vs the corresponding numeric values
|
|
2194 sorted by numeric values. */)
|
|
2195 (prop, table)
|
|
2196 Lisp_Object prop, table;
|
|
2197 {
|
|
2198 int table_index;
|
|
2199 int numeric;
|
|
2200 Lisp_Object tail, val;
|
|
2201
|
|
2202 CHECK_SYMBOL (prop);
|
|
2203 table_index = (EQ (prop, QCweight) ? 0
|
|
2204 : EQ (prop, QCslant) ? 1
|
|
2205 : EQ (prop, QCwidth) ? 2
|
|
2206 : 3);
|
|
2207 if (table_index >= ASIZE (font_style_table))
|
|
2208 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop)));
|
|
2209 table = Fcopy_sequence (table);
|
|
2210 numeric = -1;
|
|
2211 for (tail = table; ! NILP (tail); tail = Fcdr (tail))
|
|
2212 {
|
|
2213 prop = Fcar (Fcar (tail));
|
|
2214 val = Fcdr (Fcar (tail));
|
|
2215 CHECK_SYMBOL (prop);
|
|
2216 CHECK_NATNUM (val);
|
|
2217 if (numeric > XINT (val))
|
|
2218 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop)));
|
|
2219 numeric = XINT (val);
|
|
2220 XSETCAR (tail, Fcons (prop, val));
|
|
2221 }
|
|
2222 ASET (font_style_table, table_index, table);
|
|
2223 return Qnil;
|
|
2224 }
|
|
2225
|
|
2226 DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0,
|
|
2227 doc: /* Return a newly created glyph-string for FONT-OBJECT with NUM glyphs.
|
|
2228 FONT-OBJECT may be nil if it is not yet known. */)
|
|
2229 (font_object, num)
|
|
2230 Lisp_Object font_object, num;
|
|
2231 {
|
|
2232 Lisp_Object gstring, g;
|
|
2233 int len;
|
|
2234 int i;
|
|
2235
|
|
2236 if (! NILP (font_object))
|
|
2237 CHECK_FONT_OBJECT (font_object);
|
|
2238 CHECK_NATNUM (num);
|
|
2239
|
|
2240 len = XINT (num) + 1;
|
|
2241 gstring = Fmake_vector (make_number (len), Qnil);
|
|
2242 g = Fmake_vector (make_number (6), Qnil);
|
|
2243 ASET (g, 0, font_object);
|
|
2244 ASET (gstring, 0, g);
|
|
2245 for (i = 1; i < len; i++)
|
|
2246 ASET (gstring, i, Fmake_vector (make_number (8), make_number (0)));
|
|
2247 return gstring;
|
|
2248 }
|
|
2249
|
|
2250 DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
|
|
2251 doc: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
|
|
2252 START and END specifies the region to extract characters.
|
|
2253 If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
|
|
2254 where to extract characters.
|
|
2255 FONT-OBJECT may be nil if GSTRING already already contains one. */)
|
|
2256 (gstring, font_object, start, end, object)
|
|
2257 Lisp_Object gstring, font_object, start, end, object;
|
|
2258 {
|
|
2259 int len, i, c;
|
|
2260 unsigned code;
|
|
2261 struct font *font;
|
|
2262
|
|
2263 CHECK_VECTOR (gstring);
|
|
2264 if (NILP (font_object))
|
|
2265 font_object = Faref (Faref (gstring, make_number (0)), make_number (0));
|
|
2266 CHECK_FONT_GET_OBJECT (font_object, font);
|
|
2267
|
|
2268 if (STRINGP (object))
|
|
2269 {
|
|
2270 const unsigned char *p;
|
|
2271
|
|
2272 CHECK_NATNUM (start);
|
|
2273 CHECK_NATNUM (end);
|
|
2274 if (XINT (start) > XINT (end)
|
|
2275 || XINT (end) > ASIZE (object)
|
|
2276 || XINT (end) - XINT (start) >= XINT (Flength (gstring)))
|
|
2277 args_out_of_range (start, end);
|
|
2278
|
|
2279 len = XINT (end) - XINT (start);
|
|
2280 p = SDATA (object) + string_char_to_byte (object, XINT (start));
|
|
2281 for (i = 0; i < len; i++)
|
|
2282 {
|
|
2283 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
|
|
2284
|
|
2285 c = STRING_CHAR_ADVANCE (p);
|
|
2286 code = font->driver->encode_char (font, c);
|
|
2287 if (code > MOST_POSITIVE_FIXNUM)
|
|
2288 error ("Glyph code 0x%X is too large", code);
|
|
2289 ASET (g, 0, make_number (i));
|
|
2290 ASET (g, 1, make_number (i + 1));
|
|
2291 LGLYPH_SET_CHAR (g, make_number (c));
|
|
2292 LGLYPH_SET_CODE (g, make_number (code));
|
|
2293 }
|
|
2294 }
|
|
2295 else
|
|
2296 {
|
|
2297 int pos, pos_byte;
|
|
2298
|
|
2299 if (! NILP (object))
|
|
2300 Fset_buffer (object);
|
|
2301 validate_region (&start, &end);
|
|
2302 if (XINT (end) - XINT (start) > len)
|
|
2303 args_out_of_range (start, end);
|
|
2304 len = XINT (end) - XINT (start);
|
|
2305 pos = XINT (start);
|
|
2306 pos_byte = CHAR_TO_BYTE (pos);
|
|
2307 for (i = 0; i < len; i++)
|
|
2308 {
|
|
2309 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
|
|
2310
|
|
2311 FETCH_CHAR_ADVANCE (c, pos, pos_byte);
|
|
2312 code = font->driver->encode_char (font, c);
|
|
2313 if (code > MOST_POSITIVE_FIXNUM)
|
|
2314 error ("Glyph code 0x%X is too large", code);
|
|
2315 ASET (g, 0, make_number (i));
|
|
2316 ASET (g, 1, make_number (i + 1));
|
|
2317 LGLYPH_SET_CHAR (g, make_number (c));
|
|
2318 LGLYPH_SET_CODE (g, make_number (code));
|
|
2319 }
|
|
2320 }
|
|
2321 return Qnil;
|
|
2322 }
|
|
2323
|
|
2324
|
|
2325 #ifdef FONT_DEBUG
|
|
2326
|
|
2327 DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
|
|
2328 doc: /* Open FONT-ENTITY. */)
|
|
2329 (font_entity, size, frame)
|
|
2330 Lisp_Object font_entity;
|
|
2331 Lisp_Object size;
|
|
2332 Lisp_Object frame;
|
|
2333 {
|
|
2334 int isize;
|
|
2335
|
|
2336 CHECK_FONT_ENTITY (font_entity);
|
|
2337 if (NILP (size))
|
|
2338 size = AREF (font_entity, FONT_SIZE_INDEX);
|
|
2339 CHECK_NUMBER (size);
|
|
2340 if (NILP (frame))
|
|
2341 frame = selected_frame;
|
|
2342 CHECK_LIVE_FRAME (frame);
|
|
2343
|
|
2344 isize = XINT (size);
|
|
2345 if (isize < 0)
|
|
2346 isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
|
|
2347
|
|
2348 return font_open_entity (XFRAME (frame), font_entity, isize);
|
|
2349 }
|
|
2350
|
|
2351 DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
|
|
2352 doc: /* Close FONT-OBJECT. */)
|
|
2353 (font_object, frame)
|
|
2354 Lisp_Object font_object, frame;
|
|
2355 {
|
|
2356 CHECK_FONT_OBJECT (font_object);
|
|
2357 if (NILP (frame))
|
|
2358 frame = selected_frame;
|
|
2359 CHECK_LIVE_FRAME (frame);
|
|
2360 font_close_object (XFRAME (frame), font_object);
|
|
2361 return Qnil;
|
|
2362 }
|
|
2363
|
|
2364 DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
|
|
2365 doc: /* Return information about FONT-OBJECT. */)
|
|
2366 (font_object)
|
|
2367 Lisp_Object font_object;
|
|
2368 {
|
|
2369 struct font *font;
|
|
2370 Lisp_Object val;
|
|
2371
|
|
2372 CHECK_FONT_GET_OBJECT (font_object, font);
|
|
2373
|
|
2374 val = Fmake_vector (make_number (9), Qnil);
|
|
2375 ASET (val, 0, Ffont_xlfd_name (font_object));
|
|
2376 if (font->file_name)
|
|
2377 ASET (val, 1, make_unibyte_string (font->file_name,
|
|
2378 strlen (font->file_name)));
|
|
2379 ASET (val, 2, make_number (font->pixel_size));
|
|
2380 ASET (val, 3, make_number (font->font.size));
|
|
2381 ASET (val, 4, make_number (font->ascent));
|
|
2382 ASET (val, 5, make_number (font->descent));
|
|
2383 ASET (val, 6, make_number (font->font.space_width));
|
|
2384 ASET (val, 7, make_number (font->font.average_width));
|
|
2385 if (font->driver->otf_capability)
|
|
2386 ASET (val, 8, font->driver->otf_capability (font));
|
|
2387 return val;
|
|
2388 }
|
|
2389
|
|
2390 DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0,
|
|
2391 doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
|
|
2392 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
|
|
2393 (font_object, string)
|
|
2394 Lisp_Object font_object, string;
|
|
2395 {
|
|
2396 struct font *font;
|
|
2397 int i, len;
|
|
2398 Lisp_Object vec;
|
|
2399
|
|
2400 CHECK_FONT_GET_OBJECT (font_object, font);
|
|
2401 CHECK_STRING (string);
|
|
2402 len = SCHARS (string);
|
|
2403 vec = Fmake_vector (make_number (len), Qnil);
|
|
2404 for (i = 0; i < len; i++)
|
|
2405 {
|
|
2406 Lisp_Object ch = Faref (string, make_number (i));
|
|
2407 Lisp_Object val;
|
|
2408 int c = XINT (ch);
|
|
2409 unsigned code;
|
|
2410 struct font_metrics metrics;
|
|
2411
|
|
2412 code = font->driver->encode_char (font, c);
|
|
2413 if (code == FONT_INVALID_CODE)
|
|
2414 continue;
|
|
2415 val = Fmake_vector (make_number (6), Qnil);
|
|
2416 if (code <= MOST_POSITIVE_FIXNUM)
|
|
2417 ASET (val, 0, make_number (code));
|
|
2418 else
|
|
2419 ASET (val, 0, Fcons (make_number (code >> 16),
|
|
2420 make_number (code & 0xFFFF)));
|
|
2421 font->driver->text_extents (font, &code, 1, &metrics);
|
|
2422 ASET (val, 1, make_number (metrics.lbearing));
|
|
2423 ASET (val, 2, make_number (metrics.rbearing));
|
|
2424 ASET (val, 3, make_number (metrics.width));
|
|
2425 ASET (val, 4, make_number (metrics.ascent));
|
|
2426 ASET (val, 5, make_number (metrics.descent));
|
|
2427 ASET (vec, i, val);
|
|
2428 }
|
|
2429 return vec;
|
|
2430 }
|
|
2431
|
|
2432 #if 0
|
|
2433 DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
|
|
2434 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
|
|
2435 The value is a number of glyphs drawn.
|
|
2436 Type C-l to recover what previously shown. */)
|
|
2437 (font_object, string)
|
|
2438 Lisp_Object font_object, string;
|
|
2439 {
|
|
2440 Lisp_Object frame = selected_frame;
|
|
2441 FRAME_PTR f = XFRAME (frame);
|
|
2442 struct font *font;
|
|
2443 struct face *face;
|
|
2444 int i, len, width;
|
|
2445 unsigned *code;
|
|
2446
|
|
2447 CHECK_FONT_GET_OBJECT (font_object, font);
|
|
2448 CHECK_STRING (string);
|
|
2449 len = SCHARS (string);
|
|
2450 code = alloca (sizeof (unsigned) * len);
|
|
2451 for (i = 0; i < len; i++)
|
|
2452 {
|
|
2453 Lisp_Object ch = Faref (string, make_number (i));
|
|
2454 Lisp_Object val;
|
|
2455 int c = XINT (ch);
|
|
2456
|
|
2457 code[i] = font->driver->encode_char (font, c);
|
|
2458 if (code[i] == FONT_INVALID_CODE)
|
|
2459 break;
|
|
2460 }
|
|
2461 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
|
|
2462 face->fontp = font;
|
|
2463 if (font->driver->prepare_face)
|
|
2464 font->driver->prepare_face (f, face);
|
|
2465 width = font->driver->text_extents (font, code, i, NULL);
|
|
2466 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
|
|
2467 if (font->driver->done_face)
|
|
2468 font->driver->done_face (f, face);
|
|
2469 face->fontp = NULL;
|
|
2470 return make_number (len);
|
|
2471 }
|
|
2472 #endif
|
|
2473
|
|
2474 #endif /* FONT_DEBUG */
|
|
2475
|
|
2476
|
|
2477 extern void syms_of_ftfont P_ (());
|
|
2478 extern void syms_of_xfont P_ (());
|
|
2479 extern void syms_of_xftfont P_ (());
|
|
2480 extern void syms_of_ftxfont P_ (());
|
|
2481 extern void syms_of_bdffont P_ (());
|
|
2482 extern void syms_of_w32font P_ (());
|
|
2483 extern void syms_of_atmfont P_ (());
|
|
2484
|
|
2485 void
|
|
2486 syms_of_font ()
|
|
2487 {
|
|
2488 sort_shift_bits[FONT_SLANT_INDEX] = 0;
|
|
2489 sort_shift_bits[FONT_WEIGHT_INDEX] = 7;
|
|
2490 sort_shift_bits[FONT_SIZE_INDEX] = 14;
|
|
2491 sort_shift_bits[FONT_WIDTH_INDEX] = 21;
|
|
2492 sort_shift_bits[FONT_ADSTYLE_INDEX] = 28;
|
|
2493 sort_shift_bits[FONT_FOUNDRY_INDEX] = 29;
|
|
2494 sort_shift_bits[FONT_FAMILY_INDEX] = 30;
|
|
2495 sort_shift_bits[FONT_REGISTRY_INDEX] = 31;
|
|
2496 /* Note that sort_shift_bits[FONT_SLANT_TYPE] is never used. */
|
|
2497
|
|
2498 staticpro (&font_style_table);
|
|
2499 font_style_table = Fmake_vector (make_number (3), Qnil);
|
|
2500
|
|
2501 staticpro (&font_family_alist);
|
|
2502 font_family_alist = Qnil;
|
|
2503
|
|
2504 DEFSYM (Qfontp, "fontp");
|
|
2505
|
|
2506 DEFSYM (QCotf, ":otf");
|
|
2507 DEFSYM (QClanguage, ":language");
|
|
2508 DEFSYM (QCscript, ":script");
|
|
2509
|
|
2510 DEFSYM (QCfoundry, ":foundry");
|
|
2511 DEFSYM (QCadstyle, ":adstyle");
|
|
2512 DEFSYM (QCregistry, ":registry");
|
|
2513 DEFSYM (QCextra, ":extra");
|
|
2514
|
|
2515 staticpro (&null_string);
|
|
2516 null_string = build_string ("");
|
|
2517 staticpro (&null_vector);
|
|
2518 null_vector = Fmake_vector (make_number (0), Qnil);
|
|
2519
|
|
2520 staticpro (&scratch_font_spec);
|
|
2521 scratch_font_spec = Ffont_spec (0, NULL);
|
|
2522 staticpro (&scratch_font_prefer);
|
|
2523 scratch_font_prefer = Ffont_spec (0, NULL);
|
|
2524
|
|
2525 defsubr (&Sfontp);
|
|
2526 defsubr (&Sfont_spec);
|
|
2527 defsubr (&Sfont_get);
|
|
2528 defsubr (&Sfont_put);
|
|
2529 defsubr (&Slist_fonts);
|
|
2530 defsubr (&Slist_families);
|
|
2531 defsubr (&Sfind_font);
|
|
2532 defsubr (&Sfont_xlfd_name);
|
|
2533 defsubr (&Sclear_font_cache);
|
|
2534 defsubr (&Sinternal_set_font_style_table);
|
|
2535 defsubr (&Sfont_make_gstring);
|
|
2536 defsubr (&Sfont_fill_gstring);
|
|
2537
|
|
2538 #ifdef FONT_DEBUG
|
|
2539 defsubr (&Sopen_font);
|
|
2540 defsubr (&Sclose_font);
|
|
2541 defsubr (&Squery_font);
|
|
2542 defsubr (&Sget_font_glyphs);
|
|
2543 #if 0
|
|
2544 defsubr (&Sdraw_string);
|
|
2545 #endif
|
|
2546 #endif /* FONT_DEBUG */
|
|
2547
|
|
2548 #ifdef HAVE_FREETYPE
|
|
2549 syms_of_ftfont ();
|
|
2550 #ifdef HAVE_X_WINDOWS
|
|
2551 syms_of_xfont ();
|
|
2552 syms_of_ftxfont ();
|
|
2553 #ifdef HAVE_XFT
|
|
2554 syms_of_xftfont ();
|
|
2555 #endif /* HAVE_XFT */
|
|
2556 #endif /* HAVE_X_WINDOWS */
|
|
2557 #else /* not HAVE_FREETYPE */
|
|
2558 #ifdef HAVE_X_WINDOWS
|
|
2559 syms_of_xfont ();
|
|
2560 #endif /* HAVE_X_WINDOWS */
|
|
2561 #endif /* not HAVE_FREETYPE */
|
|
2562 #ifdef HAVE_BDFFONT
|
|
2563 syms_of_bdffont ();
|
|
2564 #endif /* HAVE_BDFFONT */
|
|
2565 #ifdef WINDOWSNT
|
|
2566 syms_of_w32font ();
|
|
2567 #endif /* WINDOWSNT */
|
|
2568 #ifdef MAC_OS
|
|
2569 syms_of_atmfont ();
|
|
2570 #endif /* MAC_OS */
|
|
2571 }
|
90427
|
2572
|
|
2573 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
|
|
2574 (do not change this comment) */
|