aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/font.c2571
-rw-r--r--src/font.h479
-rw-r--r--src/ftfont.c731
-rw-r--r--src/ftxfont.c346
-rw-r--r--src/xfont.c868
-rw-r--r--src/xftfont.c552
6 files changed, 5547 insertions, 0 deletions
diff --git a/src/font.c b/src/font.c
new file mode 100644
index 00000000000..eaf2ac0a84e
--- /dev/null
+++ b/src/font.c
@@ -0,0 +1,2571 @@
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"
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
48int enable_font_backend;
49
50Lisp_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). */
74Lisp_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. */
78Lisp_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))] */
87static 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
93static Lisp_Object font_family_alist;
94
95/* Symbols representing keys of normal font properties. */
96extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth, QCsize, QCname;
97Lisp_Object QCfoundry, QCadstyle, QCregistry, QCextra;
98/* Symbols representing keys of font extra info. */
99Lisp_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. */
104static struct font_driver_list *font_driver_list;
105
106static Lisp_Object prop_name_to_numeric P_ ((enum font_property_index,
107 Lisp_Object));
108static Lisp_Object prop_numeric_to_name P_ ((enum font_property_index, int));
109static Lisp_Object font_open_entity P_ ((FRAME_PTR, Lisp_Object, int));
110
111/* Number of registered font drivers. */
112static 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
118static Lisp_Object
119prop_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
136static Lisp_Object
137prop_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
164Lisp_Object
165intern_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
187extern Lisp_Object Vface_alternative_font_family_alist;
188
189static void
190build_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
207static Lisp_Object
208font_prop_validate_type (prop, val)
209 enum font_property_index prop;
210 Lisp_Object val;
211{
212 return (SYMBOLP (val) ? val : Qerror);
213}
214
215static Lisp_Object
216font_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
233static Lisp_Object
234font_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
254static Lisp_Object
255font_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
263static Lisp_Object
264font_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
293struct
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
311static enum font_property_index
312check_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
323static Lisp_Object
324font_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
350enum 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
374static Lisp_Object
375intern_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
408static int
409parse_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
437int
438font_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
582int
583font_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
677void
678font_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
726struct otf_list
727{
728 Lisp_Object entity;
729 OTF *otf;
730 struct otf_list *next;
731};
732
733static struct otf_list *otf_list;
734
735static Lisp_Object
736otf_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
745static OTF *
746otf_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
770Lisp_Object
771font_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
840static int
841parse_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
882void
883adjust_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
907int
908font_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
996int
997font_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
1147struct font *
1148font_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
1195int
1196font_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
1255static unsigned font_score P_ ((Lisp_Object, Lisp_Object));
1256static int font_compare P_ ((const void *, const void *));
1257static 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. */
1272static 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
1277static unsigned
1278font_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
1321static int
1322font_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. */
1331struct 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
1343static Lisp_Object
1344font_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
1404void
1405font_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
1425Lisp_Object
1426font_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
1436Lisp_Object
1437font_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
1447Lisp_Object
1448font_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
1458Lisp_Object
1459font_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
1476static Lisp_Object scratch_font_spec, scratch_font_prefer;
1477
1478/* Return a vector of font-entities matching with SPEC on frame F. */
1479
1480static Lisp_Object
1481font_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
1547static int num_fonts;
1548
1549static Lisp_Object
1550font_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
1593void
1594font_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
1624int
1625font_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
1641unsigned
1642font_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
1651char *
1652font_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
1662Lisp_Object
1663font_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
1672extern Lisp_Object Qunspecified, Qignore_defface;
1673
1674Lisp_Object
1675font_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
1786Lisp_Object
1787font_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
1798void
1799font_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
1829void
1830font_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
1840void
1841font_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
1852Lisp_Object
1853font_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
1889void
1890register_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
1920void
1921free_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
1936DEFUN ("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
1944DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
1945 doc: /* Return a newly created font-spec with specified arguments as properties.
1946usage: (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
1971DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
1972 doc: /* Return the value of FONT's PROP property.
1973FONT may be a font-spec or font-entity.
1974If 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
1990DEFUN ("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
2011DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
2012 doc: /* List available fonts matching FONT-SPEC on the current frame.
2013Optional 2nd argument FRAME specifies the target frame.
2014Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
2015Optional 4th argument PREFER, if non-nil, is a font-spec to sort fonts
2016by 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
2060DEFUN ("list-families", Flist_families, Slist_families, 0, 1, 0,
2061 doc: /* List available font families on the current frame.
2062Optional 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
2095DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
2096 doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
2097Optional 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
2108DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 1, 0,
2109 doc: /* Return XLFD name of FONT.
2110FONT is a font-spec, font-entity, or font-object.
2111If 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
2136DEFUN ("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
2189DEFUN ("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.
2192PROP must be `:weight', `:slant', or `:width'.
2193TABLE must be an alist of symbols vs the corresponding numeric values
2194sorted 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
2226DEFUN ("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.
2228FONT-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
2250DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
2251 doc: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
2252START and END specifies the region to extract characters.
2253If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
2254where to extract characters.
2255FONT-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
2327DEFUN ("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
2351DEFUN ("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
2364DEFUN ("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
2390DEFUN ("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.
2392Each 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
2433DEFUN ("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.
2435The value is a number of glyphs drawn.
2436Type 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
2477extern void syms_of_ftfont P_ (());
2478extern void syms_of_xfont P_ (());
2479extern void syms_of_xftfont P_ (());
2480extern void syms_of_ftxfont P_ (());
2481extern void syms_of_bdffont P_ (());
2482extern void syms_of_w32font P_ (());
2483extern void syms_of_atmfont P_ (());
2484
2485void
2486syms_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}
diff --git a/src/font.h b/src/font.h
new file mode 100644
index 00000000000..3af90f5ddc8
--- /dev/null
+++ b/src/font.h
@@ -0,0 +1,479 @@
1/* font.h -- Interface definition for font handling.
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#ifndef EMACS_FONT_H
25#define EMACS_FONT_H
26
27#include "ccl.h"
28
29/* We have three types of Lisp objects related to font.
30
31 FONT-SPEC
32
33 Vector (length FONT_SPEC_MAX) of font properties. Some
34 properties can be left unspecified (i.e. nil). Emacs asks
35 font-drivers to find a font by FONT-SPEC. A fontset entry
36 specifies requisite properties whereas a face specifies just
37 preferable properties. This object is fully modifiable by
38 Lisp.
39
40 FONT-ENTITY
41
42 Vector (length FONT_ENTITY_MAX) of fully specified font
43 properties that a font-driver returns upon a request of
44 FONT-SPEC.
45
46 Note: Only the method `list' of a font-driver can create this
47 object, and should never be modified by Lisp. In that sense,
48 it may be cleaner to implement it as a Lisp object of a new
49 type (e.g. struct Lisp_Font).
50
51 FONT-OBJECT
52
53 Lisp object of type Lisp_Misc_Save_Value encapsulating a
54 pointer to "struct font". This corresponds to an opened font.
55
56 Note: The note for FONT-ENTITY also applies to this.
57*/
58
59
60struct font_driver;
61struct font;
62
63/* An enumerator for each font property. This is used as an index to
64 the vector of FONT-SPEC and FONT-ENTITY.
65
66 Note: The order is important and should not be changed. */
67
68enum font_property_index
69 {
70 /* FONT-TYPE is a symbol indicating a font backend; currently `x',
71 `xft', `ftx', `freetype' are available. For windows, we need
72 `bdf' and `windows'. For Mac OS X, we need `atm'. */
73 FONT_TYPE_INDEX,
74
75 /* FONT-FOUNDRY is a foundry name (symbol). */
76 FONT_FOUNDRY_INDEX,
77
78 /* FONT-FAMILY is a family name (symbol). */
79 FONT_FAMILY_INDEX,
80
81 /* FONT-ADSTYLE is an additional style name (symbol). */
82 FONT_ADSTYLE_INDEX,
83
84 /* FONT-REGISTRY is a combination of a charset-registry and
85 charset0encoding name (symbol). */
86 FONT_REGISTRY_INDEX,
87
88 /* FONT-WEIGHT is a numeric value of weight (e.g. medium, bold) of
89 the font. The value is what defined by FC_WEIGHT_* in
90 fontconfig. */
91 FONT_WEIGHT_INDEX,
92
93 /* FONT-SLANT is a numeric value of slant (e.g. r, i, o) of the
94 font. The value is what defined by FC_SLANT_* in
95 fontconfig plus 100. */
96 FONT_SLANT_INDEX,
97
98 /* FONT-WIDTH is a numeric value of setwidth (e.g. normal,
99 condensed) of the font. The value is what defined by
100 FC_WIDTH_* in fontconfig. */
101 FONT_WIDTH_INDEX,
102
103 /* FONT-SIZE is a size of the font. If integer, it is a pixel
104 size. For a font-spec, the value can be float specifying a
105 point size. For a font-entity, the value can be zero meaning
106 that the font is scalable. */
107 FONT_SIZE_INDEX,
108
109 /* In a font-spec, the value is an alist of extra information of a
110 font such as name, OpenType features, and language coverage.
111 In a font-entity, the value is an extra infomation for
112 identifying a font (font-driver dependent). */
113 FONT_EXTRA_INDEX, /* alist alist */
114
115 /* This value is the length of font-spec vector. */
116 FONT_SPEC_MAX,
117
118 /* The followings are used only for a font-entity. */
119
120 /* Frame on which the font is found. The value is nil if the font
121 can be opend on any frame. */
122 FONT_FRAME_INDEX = FONT_SPEC_MAX,
123
124 /* List of font-objects opened from the font-entity. */
125 FONT_OBJLIST_INDEX,
126
127 /* This value is the length of font-entity vector. */
128 FONT_ENTITY_MAX
129 };
130
131extern Lisp_Object QCotf, QClanguage, QCscript;
132
133extern Lisp_Object null_string;
134extern Lisp_Object null_vector;
135
136/* Structure for an opened font. We can safely cast this structure to
137 "struft font_info". */
138
139struct font
140{
141 struct font_info font;
142
143 /* From which font-entity the font is opened. */
144 Lisp_Object entity;
145
146 /* By which pixel size the font is opened. */
147 int pixel_size;
148
149 /* Font-driver for the font. */
150 struct font_driver *driver;
151
152 /* File name of the font, or NULL if the font is not associated with
153 a file. */
154 char *file_name;
155
156 /* Charset to encode a character code into a glyph code of the
157 font. */
158 int encoding_charset;
159
160 /* Charset to check if a character code is supported by the font.
161 -1 means that the contents of the font must be looked up to
162 determine it.
163 */
164 int repertory_charet;
165
166 /* Minimum glyph width (in pixels). */
167 int min_width;
168
169 /* Ascent and descent of the font (in pixels). */
170 int ascent, descent;
171
172 /* There will be more to this structure, but they are private to a
173 font-driver. */
174};
175
176struct font_metrics
177{
178 short lbearing, rbearing, width, ascent, descent;
179};
180
181struct font_bitmap
182{
183 int rows;
184 int width;
185 int pitch;
186 unsigned char *buffer;
187 int left;
188 int top;
189 int advance;
190 void *extra;
191};
192
193/* Predicates to check various font-related objects. */
194
195#define FONTP(x) \
196 (VECTORP (x) && (ASIZE (x) == FONT_SPEC_MAX || ASIZE (x) == FONT_ENTITY_MAX))
197#define FONT_SPEC_P(x) \
198 (VECTORP (x) && ASIZE (x) == FONT_SPEC_MAX)
199#define FONT_ENTITY_P(x) \
200 (VECTORP (x) && ASIZE (x) == FONT_ENTITY_MAX)
201#define FONT_OBJECT_P(x) \
202 (XTYPE (x) == Lisp_Misc && XMISCTYPE (x) == Lisp_Misc_Save_Value)
203
204
205/* Check macros for various font-related objects. */
206
207#define CHECK_FONT(x) \
208 do { if (! FONTP (x)) x = wrong_type_argument (Qfont, x); } while (0)
209#define CHECK_FONT_SPEC(x) \
210 do { if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); } while (0)
211#define CHECK_FONT_ENTITY(x) \
212 do { if (! FONT_ENTITY_P (x)) x = wrong_type_argument (Qfont, x); } while (0)
213#define CHECK_FONT_OBJECT(x) \
214 do { if (! FONT_OBJECT_P (x)) x = wrong_type_argument (Qfont, x); } while (0)
215
216#define CHECK_FONT_GET_OBJECT(x, font) \
217 do { \
218 if (! FONT_OBJECT_P (x)) x = wrong_type_argument (Qfont, x); \
219 if (! XSAVE_VALUE (x)->pointer) error ("Font already closed"); \
220 font = XSAVE_VALUE (x)->pointer; \
221 } while (0)
222
223struct face;
224struct composition;
225
226/* Macros for lispy glyph-string. */
227#define LGSTRING_FONT(lgs) AREF (AREF ((lgs), 0), 0)
228#define LGSTRING_LBEARING(lgs) AREF (AREF ((lgs), 0), 1)
229#define LGSTRING_RBEARING(lgs) AREF (AREF ((lgs), 0), 2)
230#define LGSTRING_WIDTH(lgs) AREF (AREF ((lgs), 0), 3)
231#define LGSTRING_ASCENT(lgs) AREF (AREF ((lgs), 0), 4)
232#define LGSTRING_DESCENT(lgs) AREF (AREF ((lgs), 0), 5)
233#define LGSTRING_SET_FONT(lgs, val) ASET (AREF ((lgs), 0), 0, (val))
234#define LGSTRING_SET_LBEARING(lgs, val) ASET (AREF ((lgs), 0), 1, (val))
235#define LGSTRING_SET_RBEARING(lgs, val) ASET (AREF ((lgs), 0), 2, (val))
236#define LGSTRING_SET_WIDTH(lgs, val) ASET (AREF ((lgs), 0), 3, (val))
237#define LGSTRING_SET_ASCENT(lgs, val) ASET (AREF ((lgs), 0), 4, (val))
238#define LGSTRING_SET_DESCENT(lgs, val) ASET (AREF ((lgs), 0), 5, (val))
239
240#define LGSTRING_LENGTH(lgs) (ASIZE ((lgs)) - 1)
241#define LGSTRING_GLYPH(lgs, idx) AREF ((lgs), (idx) + 1)
242
243#define LGLYPH_CHAR(g) AREF ((g), 2)
244#define LGLYPH_CODE(g) AREF ((g), 3)
245#define LGLYPH_XOFF(g) AREF ((g), 4)
246#define LGLYPH_YOFF(g) AREF ((g), 5)
247#define LGLYPH_WIDTH(g) AREF ((g), 6)
248#define LGLYPH_WADJUST(g) AREF ((g), 7)
249#define LGLYPH_SET_CHAR(g, val) ASET ((g), 2, (val))
250#define LGLYPH_SET_CODE(g, val) ASET ((g), 3, (val))
251#define LGLYPH_SET_XOFF(g, val) ASET ((g), 4, (val))
252#define LGLYPH_SET_YOFF(g, val) ASET ((g), 5, (val))
253#define LGLYPH_SET_WIDTH(g, val) ASET ((g), 6, (val))
254#define LGLYPH_SET_WADJUST(g, val) ASET ((g), 7, (val))
255
256#define FONT_INVALID_CODE 0xFFFFFFFF
257
258struct font_driver
259{
260 /* Symbol indicating the type of the font-driver. */
261 Lisp_Object type;
262
263 /* Return a cache of font-entities on FRAME. The cache must be a
264 cons whose cdr part is the actual cache area. */
265 Lisp_Object (*get_cache) P_ ((Lisp_Object frame));
266
267 /* Parse font name NAME, store the font properties in SPEC, and
268 return 0. If the font-driver can't parse NAME, return -1. */
269 int (*parse_name) P_ ((FRAME_PTR f, char *name, Lisp_Object spec));
270
271 /* List fonts matching with FONT_SPEC on FRAME. The value is a
272 vector of font-entities. This is the sole API that allocates
273 font-entities. */
274 Lisp_Object (*list) P_ ((Lisp_Object frame, Lisp_Object font_spec));
275
276 /* List available families. The value is a list of family names
277 (symbols). The method can be NULL if the driver doesn't support
278 this facility. */
279 Lisp_Object (*list_family) P_ ((Lisp_Object frame));
280
281 /* Free FONT_EXTRA_INDEX field of FONT_ENTITY. This method can be
282 NULL if FONT_EXTRA_INDEX of FONT_ENTITY is a normal Lisp object
283 (i.e. not Lisp_Save_Value). */
284 void (*free_entity) P_ ((Lisp_Object font_entity));
285
286 /* Open a font specified by FONT_ENTITY on frame F. If the font is
287 scalable, open it with PIXEL_SIZE. */
288 struct font *(*open) P_ ((FRAME_PTR f, Lisp_Object font_entity,
289 int pixel_size));
290
291 /* Close FONT on frame F. */
292 void (*close) P_ ((FRAME_PTR f, struct font *font));
293
294 /* Prepare FACE for displaying characters by FONT on frame F. If
295 successful, return 0. Otherwise, return -1. This method can be
296 NULL if there's nothing to do. */
297 int (*prepare_face) P_ ((FRAME_PTR f, struct face *face));
298
299 /* Done FACE for displaying characters by FACE->font on frame F.
300 This method can be NULL if there's nothing to do. */
301 void (*done_face) P_ ((FRAME_PTR f, struct face *face));
302
303 /* If FONT_ENTITY has a glyph for character C, return 1. If not,
304 return 0. If a font must be opened to check it, return -1. This
305 method can be NULL if the driver always requires a font to be
306 opened for this check. In that case, we must open a font and use
307 `encode_char' method. */
308 int (*has_char) P_ ((Lisp_Object entity, int c));
309
310 /* Return a glyph code of FONT for characer C. If FONT doesn't have
311 such a glyph, return FONT_INVALID_CODE. */
312 unsigned (*encode_char) P_ ((struct font *font, int c));
313
314 /* Perform the size computation of glyphs of FONT and fillin members
315 of METRICS. The glyphs are specified by their glyph codes in
316 CODE (length NGLYPHS). */
317 int (*text_extents) P_ ((struct font *font,
318 unsigned *code, int nglyphs,
319 struct font_metrics *metrics));
320
321 /* Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
322 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
323 is nonzero, fill the background in advance. It is assured that
324 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars). */
325 int (*draw) P_ ((struct glyph_string *s, int from, int to,
326 int x, int y, int with_background));
327
328 /* Store bitmap data for glyph-code CODE of FONT in BITMAP. This
329 method can be NULL if the driver doesn't support this facility.
330 It is intended that this method is callled from the other
331 font-driver for actual drawing. */
332 int (*get_bitmap) P_ ((struct font *font, unsigned code,
333 struct font_bitmap *bitmap,
334 int bits_per_pixel));
335
336 /* Free bitmap data in BITMAP. This method can be NULL if no data
337 have to be freed. */
338 void (*free_bitmap) P_ ((struct font *font, struct font_bitmap *bitmap));
339
340 /* Return an outline data for glyph-code CODE of FONT. The format
341 of the outline data depends on the font-driver. This method can
342 be NULL if the driver doesn't support this facility. */
343 void *(*get_outline) P_ ((struct font *font, unsigned code));
344
345 /* Free OUTLINE (that is obtained by the above method). */
346 void (*free_outline) P_ ((struct font *font, void *outline));
347
348 /* Get coordinates of the INDEXth anchor point of the glyph whose
349 code is CODE. Store the coordinates in *X and *Y. Return 0 if
350 the operations was successfull. Otherwise return -1. This
351 method can be NULL if the driver doesn't support this
352 facility. */
353 int (*anchor_point) P_ ((struct font *font, unsigned code, int index,
354 int *x, int *y));
355
356 /* Return a list describing which scripts/languages FONT
357 supports by which GSUB/GPOS features of OpenType tables. */
358 Lisp_Object (*otf_capability) P_ ((struct font *font));
359
360 /* Drive FONT's OTF GSUB features according to GSUB_SPEC.
361
362 GSUB_SPEC is in this format (all elements are symbols):
363 (SCRIPT LANGSYS GSUB-FEATURE ...)
364 If one of GSUB-FEATURE is nil, apply all gsub features except for
365 already applied and listed later. For instance, if the font has
366 GSUB features nukt, haln, rphf, blwf, and half,
367 (deva nil nukt haln nil rphf)
368 applies nukt and haln in this order, then applies blwf and half
369 in the order apearing in the font. The features are of the
370 default langsys of `deva' script.
371
372 This method applies the specified features to the codes in the
373 elements of GSTRING-IN (between FROMth and TOth). The output
374 codes are stored in GSTRING-OUT at the IDXth element and the
375 following elements.
376
377 Return the number of output codes. If none of the features are
378 applicable to the input data, return 0. If GSTRING-OUT is too
379 short, return -1. */
380 int (*otf_gsub) P_ ((struct font *font, Lisp_Object gsub_spec,
381 Lisp_Object gstring_in, int from, int to,
382 Lisp_Object gstring_out, int idx));
383
384 /* Drive FONT's OTF GPOS features according to GPOS_SPEC.
385
386 GPOS_SPEC is in this format (all elements are symbols):
387 (SCRIPT LANGSYS GPOS-FEATURE ...)
388 The meaning is the same as GSUB_SPEC above.
389
390 This method applies the specified features to the codes in the
391 elements of GSTRING (between FROMth and TOth). The resulting
392 positioning information (x-offset and y-offset) is stored in the
393 slots of the elements.
394
395 Return 1 if at least one glyph has nonzero x-offset or y-offset.
396 Otherwise return 0. */
397 int (*otf_gpos) P_ ((struct font *font, Lisp_Object gpos_spec,
398 Lisp_Object gstring, int from, int to));
399};
400
401
402struct font_driver_list
403{
404 struct font_driver *driver;
405 struct font_driver_list *next;
406};
407
408extern int enable_font_backend;
409
410EXFUN (Ffont_spec, MANY);
411
412extern Lisp_Object font_symbolic_weight P_ ((Lisp_Object font));
413extern Lisp_Object font_symbolic_slant P_ ((Lisp_Object font));
414extern Lisp_Object font_symbolic_width P_ ((Lisp_Object font));
415
416extern Lisp_Object font_find_object P_ ((struct font *font));
417extern char *font_get_name P_ ((Lisp_Object));
418extern Lisp_Object font_get_frame P_ ((Lisp_Object font));
419extern int font_has_char P_ ((FRAME_PTR, Lisp_Object, int));
420extern unsigned font_encode_char P_ ((Lisp_Object, int));
421
422extern int font_set_lface_from_name P_ ((FRAME_PTR f,
423 Lisp_Object lface,
424 Lisp_Object fontname,
425 int force_p, int may_fail_p));
426extern Lisp_Object font_find_for_lface P_ ((FRAME_PTR f, Lisp_Object *lface,
427 Lisp_Object spec));
428extern Lisp_Object font_open_for_lface P_ ((FRAME_PTR f, Lisp_Object *lface,
429 Lisp_Object entity));
430extern void font_load_for_face P_ ((FRAME_PTR f, struct face *face));
431extern void font_prepare_for_face P_ ((FRAME_PTR f, struct face *face));
432extern Lisp_Object font_open_by_name P_ ((FRAME_PTR f, char *name));
433
434extern Lisp_Object intern_downcase P_ ((char *str, int len));
435extern void font_update_sort_order P_ ((int *order));
436
437extern void font_parse_old_font_spec P_ ((Lisp_Object, Lisp_Object,
438 Lisp_Object, Lisp_Object));
439
440
441extern int font_parse_xlfd P_ ((char *name, Lisp_Object font, int merge));
442extern int font_unparse_xlfd P_ ((Lisp_Object font, int pixel_size,
443 char *name, int bytes));
444extern void register_font_driver P_ ((struct font_driver *driver, FRAME_PTR f));
445extern void free_font_driver_list P_ ((FRAME_PTR f));
446
447extern struct font *font_prepare_composition P_ ((struct composition *cmp));
448
449
450#ifdef HAVE_LIBOTF
451/* This can be used as `otf_capability' method of a font-driver. */
452extern Lisp_Object font_otf_capability P_ ((struct font *font));
453/* This can be used as `otf_gsub' method of a font-driver. */
454extern int font_otf_gsub P_ ((struct font *font, Lisp_Object gsub_spec,
455 Lisp_Object gstring_in, int from, int to,
456 Lisp_Object gstring_out, int idx));
457/* This can be used as `otf_gpos' method of a font-driver. */
458extern int font_otf_gpos P_ ((struct font *font, Lisp_Object gpos_spec,
459 Lisp_Object gstring, int from, int to));
460#endif /* HAVE_LIBOTF */
461
462#ifdef HAVE_FREETYPE
463extern struct font_driver ftfont_driver;
464#endif /* HAVE_FREETYPE */
465#ifdef HAVE_X_WINDOWS
466extern struct font_driver xfont_driver;
467extern struct font_driver ftxfont_driver;
468#ifdef HAVE_XFT
469extern struct font_driver xftfont_driver;
470#endif /* HAVE_XFT */
471#endif /* HAVE_X_WINDOWS */
472#ifdef WINDOWSNT
473extern struct font_driver w32font_driver;
474#endif /* WINDOWSNT */
475#ifdef MAC_OS
476extern struct font_driver atmfont_driver;
477#endif /* MAC_OS */
478
479#endif /* not EMACS_FONT_H */
diff --git a/src/ftfont.c b/src/ftfont.c
new file mode 100644
index 00000000000..fff8dd72a49
--- /dev/null
+++ b/src/ftfont.c
@@ -0,0 +1,731 @@
1/* ftfont.c -- FreeType font driver.
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
27#include <ft2build.h>
28#include FT_FREETYPE_H
29#include FT_SIZES_H
30#include <fontconfig/fontconfig.h>
31#include <fontconfig/fcfreetype.h>
32
33#include "lisp.h"
34#include "dispextern.h"
35#include "frame.h"
36#include "blockinput.h"
37#include "character.h"
38#include "charset.h"
39#include "coding.h"
40#include "fontset.h"
41#include "font.h"
42
43Lisp_Object Qfreetype;
44
45static int fc_initialized;
46static FT_Library ft_library;
47
48static Lisp_Object freetype_font_cache;
49
50static Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp;
51
52static FcCharSet *cs_iso8859_1;
53
54/* The actual structure for FreeType font that can be casted to struct
55 font. */
56
57struct ftfont_info
58{
59 struct font font;
60 FT_Size ft_size;
61};
62
63static int
64ftfont_build_basic_charsets ()
65{
66 FcChar32 c;
67
68 cs_iso8859_1 = FcCharSetCreate ();
69 if (! cs_iso8859_1)
70 return -1;
71 for (c = ' '; c < 127; c++)
72 if (! FcCharSetAddChar (cs_iso8859_1, c))
73 return -1;
74 for (c = 192; c < 256; c++)
75 if (! FcCharSetAddChar (cs_iso8859_1, c))
76 return -1;
77 return 0;
78}
79
80static Lisp_Object ftfont_get_cache P_ ((Lisp_Object));
81static int ftfont_parse_name P_ ((FRAME_PTR, char *, Lisp_Object));
82static Lisp_Object ftfont_list P_ ((Lisp_Object, Lisp_Object));
83static Lisp_Object ftfont_list_family P_ ((Lisp_Object));
84static void ftfont_free_entity P_ ((Lisp_Object));
85static struct font *ftfont_open P_ ((FRAME_PTR, Lisp_Object, int));
86static void ftfont_close P_ ((FRAME_PTR, struct font *));
87static int ftfont_has_char P_ ((Lisp_Object, int));
88static unsigned ftfont_encode_char P_ ((struct font *, int));
89static int ftfont_text_extents P_ ((struct font *, unsigned *, int,
90 struct font_metrics *));
91static int ftfont_get_bitmap P_ ((struct font *, unsigned,
92 struct font_bitmap *, int));
93static int ftfont_anchor_point P_ ((struct font *, unsigned, int,
94 int *, int *));
95
96struct font_driver ftfont_driver =
97 {
98 (Lisp_Object) NULL, /* Qfreetype */
99 ftfont_get_cache,
100 ftfont_parse_name,
101 ftfont_list,
102 ftfont_list_family,
103 ftfont_free_entity,
104 ftfont_open,
105 ftfont_close,
106 /* We can't draw a text without device dependent functions. */
107 NULL,
108 NULL,
109 ftfont_has_char,
110 ftfont_encode_char,
111 ftfont_text_extents,
112 /* We can't draw a text without device dependent functions. */
113 NULL,
114 ftfont_get_bitmap,
115 NULL,
116 NULL,
117 NULL,
118 ftfont_anchor_point,
119#ifdef HAVE_LIBOTF
120 font_otf_capability,
121 font_otf_gsub,
122 font_otf_gpos
123#else
124 NULL,
125 NULL,
126 NULL
127#endif /* HAVE_LIBOTF */
128 };
129
130#define SYMBOL_FcChar8(SYM) (FcChar8 *) SDATA (SYMBOL_NAME (SYM))
131
132extern Lisp_Object QCname;
133
134static Lisp_Object
135ftfont_get_cache (frame)
136 Lisp_Object frame;
137{
138 if (NILP (freetype_font_cache))
139 freetype_font_cache = Fcons (Qt, Qnil);
140 return freetype_font_cache;
141}
142
143static int
144ftfont_parse_name (f, name, spec)
145 FRAME_PTR f;
146 char *name;
147 Lisp_Object spec;
148{
149 FcPattern *p;
150 FcChar8 *str;
151 int numeric;
152 double dbl;
153
154 if (name[0] == '-' || strchr (name, '*'))
155 /* It seems that NAME is XLFD. */
156 return -1;
157 p = FcNameParse ((FcChar8 *) name);
158 if (! p)
159 return -1;
160 if (FcPatternGetString (p, FC_FOUNDRY, 0, &str) == FcResultMatch)
161 ASET (spec, FONT_FOUNDRY_INDEX,
162 intern_downcase ((char *) str, strlen ((char *) str)));
163 if (FcPatternGetString (p, FC_FAMILY, 0, &str) == FcResultMatch)
164 ASET (spec, FONT_FAMILY_INDEX,
165 intern_downcase ((char *) str, strlen ((char *) str)));
166 if (FcPatternGetInteger (p, FC_WEIGHT, 0, &numeric) == FcResultMatch)
167 ASET (spec, FONT_WEIGHT_INDEX, make_number (numeric));
168 if (FcPatternGetInteger (p, FC_SLANT, 0, &numeric) == FcResultMatch)
169 ASET (spec, FONT_SLANT_INDEX, make_number (numeric + 100));
170 if (FcPatternGetInteger (p, FC_WIDTH, 0, &numeric) == FcResultMatch)
171 ASET (spec, FONT_WIDTH_INDEX, make_number (numeric));
172 if (FcPatternGetDouble (p, FC_PIXEL_SIZE, 0, &dbl) == FcResultMatch)
173 ASET (spec, FONT_SIZE_INDEX, make_number (dbl));
174 else if (FcPatternGetDouble (p, FC_SIZE, 0, &dbl) == FcResultMatch)
175 ASET (spec, FONT_SIZE_INDEX, make_float (dbl));
176 return 0;
177}
178
179static Lisp_Object
180ftfont_list (frame, spec)
181 Lisp_Object frame, spec;
182{
183 Lisp_Object val, tmp, extra, font_name;
184 int i;
185 FcPattern *pattern = NULL;
186 FcCharSet *charset = NULL;
187 FcLangSet *langset = NULL;
188 FcFontSet *fontset = NULL;
189 FcObjectSet *objset = NULL;
190 Lisp_Object registry = Qnil;
191
192 val = null_vector;
193
194 if (! fc_initialized)
195 {
196 FcInit ();
197 fc_initialized = 1;
198 }
199
200 if (! NILP (AREF (spec, FONT_ADSTYLE_INDEX)))
201 return val;
202 if (! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
203 {
204 registry = AREF (spec, FONT_REGISTRY_INDEX);
205 if (EQ (registry, Qiso8859_1))
206 {
207 if (! cs_iso8859_1
208 && ftfont_build_basic_charsets () < 0)
209 goto err;
210 charset = cs_iso8859_1;
211 registry = Qnil;
212 }
213 }
214
215 extra = AREF (spec, FONT_EXTRA_INDEX);
216 font_name = Qnil;
217 if (CONSP (extra))
218 {
219 tmp = Fassq (QCotf, extra);
220 if (! NILP (tmp))
221 return val;
222 tmp = Fassq (QClanguage, extra);
223 if (CONSP (tmp))
224 {
225 langset = FcLangSetCreate ();
226 if (! langset)
227 goto err;
228 tmp = XCDR (tmp);
229 if (SYMBOLP (tmp))
230 {
231 if (! FcLangSetAdd (langset, SYMBOL_FcChar8 (tmp)))
232 goto err;
233 }
234 else
235 while (CONSP (tmp))
236 {
237 if (SYMBOLP (XCAR (tmp))
238 && ! FcLangSetAdd (langset, SYMBOL_FcChar8 (XCAR (tmp))))
239 goto err;
240 tmp = XCDR (tmp);
241 }
242 }
243 tmp = Fassq (QCname, extra);
244 if (CONSP (tmp))
245 font_name = XCDR (tmp);
246 tmp = Fassq (QCscript, extra);
247 if (CONSP (tmp) && ! charset)
248 {
249 Lisp_Object script = XCDR (tmp);
250 Lisp_Object chars = assq_no_quit (script,
251 Vscript_representative_chars);
252
253 if (CONSP (chars))
254 {
255 charset = FcCharSetCreate ();
256 if (! charset)
257 goto err;
258 for (chars = XCDR (chars); CONSP (chars); chars = XCDR (chars))
259 if (CHARACTERP (XCAR (chars))
260 && ! FcCharSetAddChar (charset, XUINT (XCAR (chars))))
261 goto err;
262 }
263 }
264 }
265
266 if (! NILP (registry) && ! charset)
267 goto finish;
268
269 if (STRINGP (font_name))
270 {
271 if (! isalpha (SDATA (font_name)[0]))
272 goto finish;
273 pattern = FcNameParse (SDATA (font_name));
274 if (! pattern)
275 goto err;
276 }
277 else
278 {
279 pattern = FcPatternCreate ();
280 if (! pattern)
281 goto err;
282
283 tmp = AREF (spec, FONT_FOUNDRY_INDEX);
284 if (SYMBOLP (tmp) && ! NILP (tmp)
285 && ! FcPatternAddString (pattern, FC_FOUNDRY, SYMBOL_FcChar8 (tmp)))
286 goto err;
287 tmp = AREF (spec, FONT_FAMILY_INDEX);
288 if (SYMBOLP (tmp) && ! NILP (tmp)
289 && ! FcPatternAddString (pattern, FC_FAMILY, SYMBOL_FcChar8 (tmp)))
290 goto err;
291 tmp = AREF (spec, FONT_WEIGHT_INDEX);
292 if (INTEGERP (tmp)
293 && ! FcPatternAddInteger (pattern, FC_WEIGHT, XINT (tmp)))
294 goto err;
295 tmp = AREF (spec, FONT_SLANT_INDEX);
296 if (INTEGERP (tmp)
297 && XINT (tmp) >= 100
298 && ! FcPatternAddInteger (pattern, FC_SLANT, XINT (tmp) - 100))
299 goto err;
300 tmp = AREF (spec, FONT_WIDTH_INDEX);
301 if (INTEGERP (tmp)
302 && ! FcPatternAddInteger (pattern, FC_WIDTH, XINT (tmp)))
303 goto err;
304 if (! FcPatternAddBool (pattern, FC_SCALABLE, FcTrue))
305 goto err;
306 }
307
308 if (charset
309 && ! FcPatternAddCharSet (pattern, FC_CHARSET, charset))
310 goto err;
311 if (langset
312 && ! FcPatternAddLangSet (pattern, FC_LANG, langset))
313 goto err;
314 objset = FcObjectSetBuild (FC_FOUNDRY, FC_FAMILY, FC_WEIGHT, FC_SLANT,
315 FC_WIDTH, FC_PIXEL_SIZE, FC_SPACING,
316 FC_CHARSET, FC_FILE, NULL);
317 if (! objset)
318 goto err;
319
320 BLOCK_INPUT;
321 fontset = FcFontList (NULL, pattern, objset);
322 UNBLOCK_INPUT;
323 if (! fontset)
324 goto err;
325 val = Qnil;
326 for (i = 0; i < fontset->nfont; i++)
327 {
328 FcPattern *p = fontset->fonts[i];
329 FcChar8 *str, *file;
330
331 if (FcPatternGetString (p, FC_FILE, 0, &file) == FcResultMatch
332 && FcPatternGetCharSet (p, FC_CHARSET, 0, &charset) == FcResultMatch)
333 {
334 Lisp_Object entity = Fmake_vector (make_number (FONT_ENTITY_MAX),
335 null_string);
336 int numeric;
337 double dbl;
338 FcPattern *p0;
339
340 ASET (entity, FONT_TYPE_INDEX, Qfreetype);
341 ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
342 ASET (entity, FONT_FRAME_INDEX, frame);
343 ASET (entity, FONT_OBJLIST_INDEX, Qnil);
344
345 if (FcPatternGetString (p, FC_FOUNDRY, 0, &str) == FcResultMatch)
346 ASET (entity, FONT_FOUNDRY_INDEX,
347 intern_downcase ((char *) str, strlen ((char *) str)));
348 if (FcPatternGetString (p, FC_FAMILY, 0, &str) == FcResultMatch)
349 ASET (entity, FONT_FAMILY_INDEX,
350 intern_downcase ((char *) str, strlen ((char *) str)));
351 if (FcPatternGetInteger (p, FC_WEIGHT, 0, &numeric) == FcResultMatch)
352 ASET (entity, FONT_WEIGHT_INDEX, make_number (numeric));
353 if (FcPatternGetInteger (p, FC_SLANT, 0, &numeric) == FcResultMatch)
354 ASET (entity, FONT_SLANT_INDEX, make_number (numeric + 100));
355 if (FcPatternGetInteger (p, FC_WIDTH, 0, &numeric) == FcResultMatch)
356 ASET (entity, FONT_WIDTH_INDEX, make_number (numeric));
357 if (FcPatternGetDouble (p, FC_PIXEL_SIZE, 0, &dbl) == FcResultMatch)
358 ASET (entity, FONT_SIZE_INDEX, make_number (dbl));
359 else
360 ASET (entity, FONT_SIZE_INDEX, make_number (0));
361
362 if (FcPatternGetInteger (p, FC_SPACING, 0, &numeric) != FcResultMatch)
363 numeric = FC_MONO;
364 p0 = FcPatternCreate ();
365 if (! p0
366 || FcPatternAddString (p0, FC_FILE, file) == FcFalse
367 || FcPatternAddCharSet (p0, FC_CHARSET, charset) == FcFalse
368 || FcPatternAddInteger (p0, FC_SPACING, numeric) == FcFalse)
369 break;
370 ASET (entity, FONT_EXTRA_INDEX, make_save_value (p0, 0));
371
372 val = Fcons (entity, val);
373 }
374 }
375 val = Fvconcat (1, &val);
376 goto finish;
377
378 err:
379 /* We come here because of unexpected error in fontconfig API call
380 (usually insufficiency memory). */
381 val = Qnil;
382
383 finish:
384 if (charset && charset != cs_iso8859_1) FcCharSetDestroy (charset);
385 if (objset) FcObjectSetDestroy (objset);
386 if (fontset) FcFontSetDestroy (fontset);
387 if (langset) FcLangSetDestroy (langset);
388 if (pattern) FcPatternDestroy (pattern);
389
390 return val;
391}
392
393static Lisp_Object
394ftfont_list_family (frame)
395 Lisp_Object frame;
396{
397 Lisp_Object list;
398 FcPattern *pattern = NULL;
399 FcFontSet *fontset = NULL;
400 FcObjectSet *objset = NULL;
401 int i;
402
403 if (! fc_initialized)
404 {
405 FcInit ();
406 fc_initialized = 1;
407 }
408
409 pattern = FcPatternCreate ();
410 if (! pattern)
411 goto finish;
412 objset = FcObjectSetBuild (FC_FAMILY);
413 if (! objset)
414 goto finish;
415 fontset = FcFontList (NULL, pattern, objset);
416 if (! fontset)
417 goto finish;
418
419 list = Qnil;
420 for (i = 0; i < fontset->nfont; i++)
421 {
422 FcPattern *pat = fontset->fonts[i];
423 FcChar8 *str;
424
425 if (FcPatternGetString (pat, FC_FAMILY, 0, &str) == FcResultMatch)
426 list = Fcons (intern_downcase ((char *) str, strlen ((char *) str)),
427 list);
428 }
429
430 finish:
431 if (objset) FcObjectSetDestroy (objset);
432 if (fontset) FcFontSetDestroy (fontset);
433 if (pattern) FcPatternDestroy (pattern);
434
435 return list;
436}
437
438
439static void
440ftfont_free_entity (entity)
441 Lisp_Object entity;
442{
443 Lisp_Object val = AREF (entity, FONT_EXTRA_INDEX);
444 FcPattern *pattern = XSAVE_VALUE (val)->pointer;
445
446 FcPatternDestroy (pattern);
447}
448
449static struct font *
450ftfont_open (f, entity, pixel_size)
451 FRAME_PTR f;
452 Lisp_Object entity;
453 int pixel_size;
454{
455 struct ftfont_info *ftfont_info;
456 struct font *font;
457 FT_Face ft_face;
458 FT_Size ft_size;
459 FT_UInt size;
460 Lisp_Object val;
461 FcPattern *pattern;
462 FcChar8 *file;
463 int spacing;
464
465 val = AREF (entity, FONT_EXTRA_INDEX);
466 if (XTYPE (val) != Lisp_Misc
467 || XMISCTYPE (val) != Lisp_Misc_Save_Value)
468 return NULL;
469 pattern = XSAVE_VALUE (val)->pointer;
470 if (XSAVE_VALUE (val)->integer == 0)
471 {
472 /* We have not yet created FT_Face for this font. */
473 if (! ft_library
474 && FT_Init_FreeType (&ft_library) != 0)
475 return NULL;
476 if (FcPatternGetString (pattern, FC_FILE, 0, &file) != FcResultMatch)
477 return NULL;
478 if (FT_New_Face (ft_library, (char *) file, 0, &ft_face) != 0)
479 return NULL;
480 FcPatternAddFTFace (pattern, FC_FT_FACE, ft_face);
481 ft_size = ft_face->size;
482 }
483 else
484 {
485 if (FcPatternGetFTFace (pattern, FC_FT_FACE, 0, &ft_face)
486 != FcResultMatch)
487 return NULL;
488 if (FT_New_Size (ft_face, &ft_size) != 0)
489 return NULL;
490 if (FT_Activate_Size (ft_size) != 0)
491 {
492 FT_Done_Size (ft_size);
493 return NULL;
494 }
495 }
496
497 size = XINT (AREF (entity, FONT_SIZE_INDEX));
498 if (size == 0)
499 size = pixel_size;
500 if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0)
501 {
502 if (XSAVE_VALUE (val)->integer == 0)
503 FT_Done_Face (ft_face);
504 return NULL;
505 }
506
507 ftfont_info = malloc (sizeof (struct ftfont_info));
508 if (! ftfont_info)
509 return NULL;
510 ftfont_info->ft_size = ft_size;
511
512 font = (struct font *) ftfont_info;
513 font->entity = entity;
514 font->pixel_size = size;
515 font->driver = &ftfont_driver;
516 font->font.name = font->font.full_name = NULL;
517 font->file_name = (char *) file;
518 font->font.size = ft_face->size->metrics.max_advance >> 6;
519 font->ascent = ft_face->size->metrics.ascender >> 6;
520 font->descent = - ft_face->size->metrics.descender >> 6;
521 font->font.height = ft_face->size->metrics.height >> 6;
522 if (FcPatternGetInteger (pattern, FC_SPACING, 0, &spacing) != FcResultMatch
523 || spacing != FC_PROPORTIONAL)
524 font->font.average_width = font->font.space_width = font->font.size;
525 else
526 {
527 int i;
528
529 for (i = 32; i < 127; i++)
530 {
531 if (FT_Load_Char (ft_face, i, FT_LOAD_DEFAULT) != 0)
532 break;
533 if (i == 32)
534 font->font.space_width = ft_face->glyph->metrics.horiAdvance >> 6;
535 font->font.average_width += ft_face->glyph->metrics.horiAdvance >> 6;
536 }
537 if (i == 127)
538 {
539 /* The font contains all ASCII printable characters. */
540 font->font.average_width /= 95;
541 }
542 else
543 {
544 if (i == 32)
545 font->font.space_width = font->font.size;
546 font->font.average_width = font->font.size;
547 }
548 }
549
550 font->font.baseline_offset = 0;
551 font->font.relative_compose = 0;
552 font->font.default_ascent = 0;
553 font->font.vertical_centering = 0;
554
555 (XSAVE_VALUE (val)->integer)++;
556
557 return font;
558}
559
560static void
561ftfont_close (f, font)
562 FRAME_PTR f;
563 struct font *font;
564{
565 struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
566 Lisp_Object entity = font->entity;
567 Lisp_Object val = AREF (entity, FONT_EXTRA_INDEX);
568
569 (XSAVE_VALUE (val)->integer)--;
570 if (XSAVE_VALUE (val)->integer == 0)
571 FT_Done_Face (ftfont_info->ft_size->face);
572 else
573 FT_Done_Size (ftfont_info->ft_size);
574
575 free (font);
576}
577
578static int
579ftfont_has_char (entity, c)
580 Lisp_Object entity;
581 int c;
582{
583 Lisp_Object val;
584 FcPattern *pattern;
585 FcCharSet *charset;
586
587 val = AREF (entity, FONT_EXTRA_INDEX);
588 pattern = XSAVE_VALUE (val)->pointer;
589 FcPatternGetCharSet (pattern, FC_CHARSET, 0, &charset);
590
591 return (FcCharSetHasChar (charset, (FcChar32) c) == FcTrue);
592}
593
594static unsigned
595ftfont_encode_char (font, c)
596 struct font *font;
597 int c;
598{
599 struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
600 FT_Face ft_face = ftfont_info->ft_size->face;
601 FT_ULong charcode = c;
602 FT_UInt code = FT_Get_Char_Index (ft_face, charcode);
603
604 return (code > 0 ? code : 0xFFFFFFFF);
605}
606
607static int
608ftfont_text_extents (font, code, nglyphs, metrics)
609 struct font *font;
610 unsigned *code;
611 int nglyphs;
612 struct font_metrics *metrics;
613{
614 struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
615 FT_Face ft_face = ftfont_info->ft_size->face;
616 int width = 0;
617 int i;
618
619 if (ftfont_info->ft_size != ft_face->size)
620 FT_Activate_Size (ftfont_info->ft_size);
621 if (metrics)
622 bzero (metrics, sizeof (struct font_metrics));
623 for (i = 0; i < nglyphs; i++)
624 {
625 if (FT_Load_Glyph (ft_face, code[i], FT_LOAD_DEFAULT) == 0)
626 {
627 FT_Glyph_Metrics *m = &ft_face->glyph->metrics;
628
629 if (metrics)
630 {
631 if (metrics->lbearing > width + (m->horiBearingX >> 6))
632 metrics->lbearing = width + (m->horiBearingX >> 6);
633 if (metrics->rbearing
634 < width + ((m->horiBearingX + m->width) >> 6))
635 metrics->rbearing
636 = width + ((m->horiBearingX + m->width) >> 6);
637 if (metrics->ascent < (m->horiBearingY >> 6))
638 metrics->ascent = m->horiBearingY >> 6;
639 if (metrics->descent > ((m->horiBearingY + m->height) >> 6))
640 metrics->descent = (m->horiBearingY + m->height) >> 6;
641 }
642 width += m->horiAdvance >> 6;
643 }
644 else
645 {
646 width += font->font.space_width;
647 }
648 }
649 if (metrics)
650 metrics->width = width;
651
652 return width;
653}
654
655static int
656ftfont_get_bitmap (font, code, bitmap, bits_per_pixel)
657 struct font *font;
658 unsigned code;
659 struct font_bitmap *bitmap;
660 int bits_per_pixel;
661{
662 struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
663 FT_Face ft_face = ftfont_info->ft_size->face;
664 FT_Int32 load_flags = FT_LOAD_RENDER;
665
666 if (ftfont_info->ft_size != ft_face->size)
667 FT_Activate_Size (ftfont_info->ft_size);
668 if (bits_per_pixel == 1)
669 {
670#ifdef FT_LOAD_TARGET_MONO
671 load_flags |= FT_LOAD_TARGET_MONO;
672#else
673 load_flags |= FT_LOAD_MONOCHROME;
674#endif
675 }
676 else if (bits_per_pixel != 8)
677 /* We don't support such a rendering. */
678 return -1;
679
680 if (FT_Load_Glyph (ft_face, code, load_flags) != 0)
681 return -1;
682 bitmap->rows = ft_face->glyph->bitmap.rows;
683 bitmap->width = ft_face->glyph->bitmap.width;
684 bitmap->pitch = ft_face->glyph->bitmap.pitch;
685 bitmap->buffer = ft_face->glyph->bitmap.buffer;
686 bitmap->left = ft_face->glyph->bitmap_left;
687 bitmap->top = ft_face->glyph->bitmap_top;
688 bitmap->advance = ft_face->glyph->metrics.horiAdvance >> 6;
689 bitmap->extra = NULL;
690
691 return 0;
692}
693
694static int
695ftfont_anchor_point (font, code, index, x, y)
696 struct font *font;
697 unsigned code;
698 int index;
699 int *x, *y;
700{
701 struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
702 FT_Face ft_face = ftfont_info->ft_size->face;
703
704 if (ftfont_info->ft_size != ft_face->size)
705 FT_Activate_Size (ftfont_info->ft_size);
706 if (FT_Load_Glyph (ft_face, code, FT_LOAD_DEFAULT) != 0)
707 return -1;
708 if (ft_face->glyph->format != FT_GLYPH_FORMAT_OUTLINE)
709 return -1;
710 if (index >= ft_face->glyph->outline.n_points)
711 return -1;
712 *x = ft_face->glyph->outline.points[index].x;
713 *y = ft_face->glyph->outline.points[index].y;
714 return 0;
715}
716
717
718void
719syms_of_ftfont ()
720{
721 staticpro (&freetype_font_cache);
722 freetype_font_cache = Qnil;
723
724 DEFSYM (Qfreetype, "freetype");
725 DEFSYM (Qiso8859_1, "iso8859-1");
726 DEFSYM (Qiso10646_1, "iso10646-1");
727 DEFSYM (Qunicode_bmp, "unicode-bmp");
728
729 ftfont_driver.type = Qfreetype;
730 register_font_driver (&ftfont_driver, NULL);
731}
diff --git a/src/ftxfont.c b/src/ftxfont.c
new file mode 100644
index 00000000000..af6a96f7060
--- /dev/null
+++ b/src/ftxfont.c
@@ -0,0 +1,346 @@
1/* ftxfont.c -- FreeType font driver on X (without using XFT).
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 <X11/Xlib.h>
27
28#include "lisp.h"
29#include "dispextern.h"
30#include "xterm.h"
31#include "frame.h"
32#include "blockinput.h"
33#include "character.h"
34#include "charset.h"
35#include "fontset.h"
36#include "font.h"
37
38/* FTX font driver. */
39
40static Lisp_Object Qftx;
41
42/* Prototypes for helper function. */
43static int ftxfont_draw_bitmap P_ ((FRAME_PTR, GC *, struct font *, unsigned,
44 int, int, XPoint *, int, int *n));
45static void ftxfont_draw_backgrond P_ ((FRAME_PTR, struct font *, GC,
46 int, int, int));
47
48static int
49ftxfont_draw_bitmap (f, gc, font, code, x, y, p, size, n)
50 FRAME_PTR f;
51 GC *gc;
52 struct font *font;
53 unsigned code;
54 int x, y;
55 XPoint *p;
56 int size, *n;
57{
58 struct font_bitmap bitmap;
59 unsigned char *b;
60 int i, j;
61
62 if (ftfont_driver.get_bitmap (font, code, &bitmap, 1) < 0)
63 return 0;
64 for (i = 0, b = bitmap.buffer; i < bitmap.rows;
65 i++, b += bitmap.pitch)
66 {
67 if (size > 0x100)
68 {
69 for (j = 0; j < bitmap.width; j++)
70 if (b[j / 8] & (1 << (7 - (j % 8))))
71 {
72 p[n[0]].x = x + bitmap.left + j;
73 p[n[0]].y = y - bitmap.top + i;
74 if (++n[0] == 0x400)
75 {
76 XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
77 gc[0], p, size, CoordModeOrigin);
78 n[0] = 0;
79 }
80 }
81 }
82 else
83 {
84 for (j = 0; j < bitmap.width; j++)
85 {
86 int idx = (b[j] >> 5) - 1;
87
88 if (idx >= 0)
89 {
90 XPoint *pp = p + size * idx;
91
92 pp[n[idx]].x = x + bitmap.left + j;
93 pp[n[idx]].y = y - bitmap.top + i;
94 if (++(n[idx]) == 0x100)
95 {
96 XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
97 gc[idx], pp, size, CoordModeOrigin);
98 n[idx] = 0;
99 }
100 }
101 }
102 }
103 }
104
105 if (ftfont_driver.free_bitmap)
106 ftfont_driver.free_bitmap (font, &bitmap);
107
108 return bitmap.advance;
109}
110
111static void
112ftxfont_draw_backgrond (f, font, gc, x, y, width)
113 FRAME_PTR f;
114 struct font *font;
115 GC gc;
116 int x, y, width;
117{
118 XGCValues xgcv;
119
120 XGetGCValues (FRAME_X_DISPLAY (f), gc,
121 GCForeground | GCBackground, &xgcv);
122 XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.background);
123 XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
124 x, y - font->ascent, width, font->font.height);
125 XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.foreground);
126}
127
128/* Prototypes for font-driver methods. */
129static Lisp_Object ftxfont_list P_ ((Lisp_Object, Lisp_Object));
130static struct font *ftxfont_open P_ ((FRAME_PTR, Lisp_Object, int));
131static void ftxfont_close P_ ((FRAME_PTR, struct font *));
132static int ftxfont_prepare_face (FRAME_PTR, struct face *);
133static void ftxfont_done_face (FRAME_PTR, struct face *);
134
135static int ftxfont_draw P_ ((struct glyph_string *, int, int, int, int, int));
136
137struct font_driver ftxfont_driver;
138
139static Lisp_Object
140ftxfont_list (frame, spec)
141 Lisp_Object frame;
142 Lisp_Object spec;
143{
144 Lisp_Object val = ftfont_driver.list (frame, spec);
145
146 if (! NILP (val))
147 {
148 int i;
149
150 for (i = 0; i < ASIZE (val); i++)
151 ASET (AREF (val, i), FONT_TYPE_INDEX, Qftx);
152 }
153 return val;
154}
155
156static struct font *
157ftxfont_open (f, entity, pixel_size)
158 FRAME_PTR f;
159 Lisp_Object entity;
160 int pixel_size;
161{
162 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
163 struct font *font;
164 XFontStruct *xfont = malloc (sizeof (XFontStruct));
165
166 if (! xfont)
167 return NULL;
168 font = ftfont_driver.open (f, entity, pixel_size);
169 if (! font)
170 {
171 free (xfont);
172 return NULL;
173 }
174
175 xfont->fid = FRAME_FONT (f)->fid;
176 xfont->ascent = font->ascent;
177 xfont->descent = font->descent;
178 xfont->max_bounds.width = font->font.size;
179 xfont->min_bounds.width = font->min_width;
180 font->font.font = xfont;
181 font->driver = &ftxfont_driver;
182
183 dpyinfo->n_fonts++;
184
185 /* Set global flag fonts_changed_p to non-zero if the font loaded
186 has a character with a smaller width than any other character
187 before, or if the font loaded has a smaller height than any other
188 font loaded before. If this happens, it will make a glyph matrix
189 reallocation necessary. */
190 if (dpyinfo->n_fonts == 1)
191 {
192 dpyinfo->smallest_font_height = font->font.height;
193 dpyinfo->smallest_char_width = font->min_width;
194 fonts_changed_p = 1;
195 }
196 else
197 {
198 if (dpyinfo->smallest_font_height > font->font.height)
199 dpyinfo->smallest_font_height = font->font.height, fonts_changed_p |= 1;
200 if (dpyinfo->smallest_char_width > font->min_width)
201 dpyinfo->smallest_char_width = font->min_width, fonts_changed_p |= 1;
202 }
203
204 return font;
205}
206
207static void
208ftxfont_close (f, font)
209 FRAME_PTR f;
210 struct font *font;
211{
212 ftfont_driver.close (f, font);
213 FRAME_X_DISPLAY_INFO (f)->n_fonts--;
214}
215
216static int
217ftxfont_prepare_face (f, face)
218 FRAME_PTR f;
219 struct face *face;
220{
221 GC gc[6];
222 XColor colors[3];
223 XGCValues xgcv;
224 unsigned long mask = GCForeground | GCBackground | GCGraphicsExposures;
225 int i;
226
227 face->extra = NULL;
228
229 /* Here, we create 6 more GCs to simulate anti-aliasing. */
230 BLOCK_INPUT;
231 XGetGCValues (FRAME_X_DISPLAY (f), face->gc, mask, &xgcv);
232 colors[0].pixel = face->foreground;
233 colors[1].pixel = face->background;
234 XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), colors, 2);
235 for (i = 1; i < 7; i++)
236 {
237 colors[2].red = (colors[0].red * i + colors[1].red * (7 - i)) / 7;
238 colors[2].green = (colors[0].green * i + colors[1].green * (7 - i)) / 7;
239 colors[2].blue = (colors[0].blue * i + colors[1].blue * (7 - i)) / 7;
240 if (! x_alloc_nearest_color (f, FRAME_X_COLORMAP (f), &colors[2]))
241 break;
242 xgcv.foreground = colors[2].pixel;
243 gc[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
244 mask, &xgcv);
245 }
246 UNBLOCK_INPUT;
247
248 if (i < 7)
249 return -1;
250 face->extra = malloc (sizeof (GC) * 7);
251 if (! face->extra)
252 return -1;
253 for (i = 0; i < 6; i++)
254 ((GC *) face->extra)[i] = gc[i];
255 ((GC *) face->extra)[i] = face->gc;
256 return 0;
257}
258
259static void
260ftxfont_done_face (f, face)
261 FRAME_PTR f;
262 struct face *face;
263{
264 if (face->extra)
265 {
266 int i;
267
268 BLOCK_INPUT;
269 for (i = 0; i < 7; i++)
270 XFreeGC (FRAME_X_DISPLAY (f), ((GC *) face->extra)[i]);
271 UNBLOCK_INPUT;
272 free (face->extra);
273 face->extra = NULL;
274 }
275}
276
277static int
278ftxfont_draw (s, from, to, x, y, with_background)
279 struct glyph_string *s;
280 int from, to, x, y, with_background;
281{
282 FRAME_PTR f = s->f;
283 struct face *face = s->face;
284 struct font *font = (struct font *) face->font;
285 XPoint p[0x700];
286 int n[7];
287 unsigned *code;
288 int len = to - from;
289 int i;
290
291 n[0] = n[1] = n[2] = n[3] = n[4] = n[5] = n[6] = 0;
292
293 BLOCK_INPUT;
294
295 if (with_background)
296 ftxfont_draw_backgrond (f, font, s->gc, x, y, s->width);
297 code = alloca (sizeof (unsigned) * len);
298 for (i = 0; i < len; i++)
299 code[i] = ((XCHAR2B_BYTE1 (s->char2b + from + i) << 8)
300 | XCHAR2B_BYTE2 (s->char2b + from + i));
301
302 if (! face->extra)
303 {
304 for (i = 0; i < len; i++)
305 x += ftxfont_draw_bitmap (f, &face->gc, font, code[i], x, y,
306 p, 0x700, n);
307 if (n[0] > 0)
308 XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
309 face->gc, p, n[0], CoordModeOrigin);
310 }
311 else
312 {
313 GC *gc = face->extra;
314
315 for (i = 0; i < len; i++)
316 x += ftxfont_draw_bitmap (f, &face->gc, font, code[i], x, y,
317 p, 0x100, n);
318 for (i = 0; i < 7; i++)
319 if (n[i] > 0)
320 XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
321 gc[i], p + 0x100 * i, n[i], CoordModeOrigin);
322 }
323
324 UNBLOCK_INPUT;
325
326 return len;
327}
328
329
330
331void
332syms_of_ftxfont ()
333{
334 DEFSYM (Qftx, "ftx");
335
336 ftxfont_driver = ftfont_driver;
337 ftxfont_driver.type = Qftx;
338 ftxfont_driver.list = ftxfont_list;
339 ftxfont_driver.open = ftxfont_open;
340 ftxfont_driver.close = ftxfont_close;
341 ftxfont_driver.prepare_face = ftxfont_prepare_face;
342 ftxfont_driver.done_face = ftxfont_done_face;
343 ftxfont_driver.draw = ftxfont_draw;
344
345 register_font_driver (&ftxfont_driver, NULL);
346}
diff --git a/src/xfont.c b/src/xfont.c
new file mode 100644
index 00000000000..0d5d2f70b7d
--- /dev/null
+++ b/src/xfont.c
@@ -0,0 +1,868 @@
1/* xfont.c -- X core font driver.
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 <X11/Xlib.h>
27
28#include "lisp.h"
29#include "dispextern.h"
30#include "xterm.h"
31#include "frame.h"
32#include "blockinput.h"
33#include "character.h"
34#include "charset.h"
35#include "fontset.h"
36#include "font.h"
37
38
39/* X core font driver. */
40
41Lisp_Object Qx;
42
43/* Alist of font registry symbol and the corresponding charsets
44 information. The information is retrieved from
45 Vfont_encoding_alist on demand.
46
47 Eash element has the form:
48 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
49 or
50 (REGISTRY . nil)
51
52 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
53 encodes a character code to a glyph code of a font, and
54 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
55 character is supported by a font.
56
57 The latter form means that the information for REGISTRY couldn't be
58 retrieved. */
59static Lisp_Object x_font_charset_alist;
60
61/* Prototypes of support functions. */
62extern void x_clear_errors P_ ((Display *));
63
64static char *xfont_query_font P_ ((Display *, char *, Lisp_Object));
65static XCharStruct *xfont_get_pcm P_ ((XFontStruct *, XChar2b *));
66static int xfont_registry_charsets P_ ((Lisp_Object, struct charset **,
67 struct charset **));
68
69static char *
70xfont_query_font (display, name, spec)
71 Display *display;
72 char *name;
73 Lisp_Object spec;
74{
75 XFontStruct *font;
76
77 BLOCK_INPUT;
78 x_catch_errors (display);
79 font = XLoadQueryFont (display, name);
80 name = NULL;
81 if (x_had_errors_p (display))
82 {
83 /* This error is perhaps due to insufficient memory on X
84 server. Let's just ignore it. */
85 x_clear_errors (display);
86 }
87 else if (font)
88 {
89 unsigned long value;
90
91 if (XGetFontProperty (font, XA_FONT, &value))
92 {
93 char *n = (char *) XGetAtomName (display, (Atom) value);
94
95 if (font_parse_xlfd (n, spec, 0) >= 0)
96 name = n;
97 else
98 XFree (n);
99 }
100 XFreeFont (display, font);
101 }
102 x_uncatch_errors ();
103 UNBLOCK_INPUT;
104
105 return name;
106}
107
108
109/* Get metrics of character CHAR2B in XFONT. Value is null if CHAR2B
110 is not contained in the font. */
111
112static XCharStruct *
113xfont_get_pcm (xfont, char2b)
114 XFontStruct *xfont;
115 XChar2b *char2b;
116{
117 /* The result metric information. */
118 XCharStruct *pcm = NULL;
119
120 xassert (xfont && char2b);
121
122 if (xfont->per_char != NULL)
123 {
124 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
125 {
126 /* min_char_or_byte2 specifies the linear character index
127 corresponding to the first element of the per_char array,
128 max_char_or_byte2 is the index of the last character. A
129 character with non-zero CHAR2B->byte1 is not in the font.
130 A character with byte2 less than min_char_or_byte2 or
131 greater max_char_or_byte2 is not in the font. */
132 if (char2b->byte1 == 0
133 && char2b->byte2 >= xfont->min_char_or_byte2
134 && char2b->byte2 <= xfont->max_char_or_byte2)
135 pcm = xfont->per_char + char2b->byte2 - xfont->min_char_or_byte2;
136 }
137 else
138 {
139 /* If either min_byte1 or max_byte1 are nonzero, both
140 min_char_or_byte2 and max_char_or_byte2 are less than
141 256, and the 2-byte character index values corresponding
142 to the per_char array element N (counting from 0) are:
143
144 byte1 = N/D + min_byte1
145 byte2 = N\D + min_char_or_byte2
146
147 where:
148
149 D = max_char_or_byte2 - min_char_or_byte2 + 1
150 / = integer division
151 \ = integer modulus */
152 if (char2b->byte1 >= xfont->min_byte1
153 && char2b->byte1 <= xfont->max_byte1
154 && char2b->byte2 >= xfont->min_char_or_byte2
155 && char2b->byte2 <= xfont->max_char_or_byte2)
156 pcm = (xfont->per_char
157 + ((xfont->max_char_or_byte2 - xfont->min_char_or_byte2 + 1)
158 * (char2b->byte1 - xfont->min_byte1))
159 + (char2b->byte2 - xfont->min_char_or_byte2));
160 }
161 }
162 else
163 {
164 /* If the per_char pointer is null, all glyphs between the first
165 and last character indexes inclusive have the same
166 information, as given by both min_bounds and max_bounds. */
167 if (char2b->byte2 >= xfont->min_char_or_byte2
168 && char2b->byte2 <= xfont->max_char_or_byte2)
169 pcm = &xfont->max_bounds;
170 }
171
172 return ((pcm == NULL
173 || (pcm->width == 0 && (pcm->rbearing - pcm->lbearing) == 0))
174 ? NULL : pcm);
175}
176
177extern Lisp_Object find_font_encoding P_ ((Lisp_Object));
178
179/* Return encoding charset and repertory charset for REGISTRY in
180 ENCODING and REPERTORY correspondingly. If correct information for
181 REGISTRY is available, return 0. Otherwise return -1. */
182
183static int
184xfont_registry_charsets (registry, encoding, repertory)
185 Lisp_Object registry;
186 struct charset **encoding, **repertory;
187{
188 Lisp_Object val;
189 int encoding_id, repertory_id;
190
191 val = assq_no_quit (registry, x_font_charset_alist);
192 if (! NILP (val))
193 {
194 val = XCDR (val);
195 if (NILP (val))
196 return -1;
197 encoding_id = XINT (XCAR (val));
198 repertory_id = XINT (XCDR (val));
199 }
200 else
201 {
202 val = find_font_encoding (SYMBOL_NAME (registry));
203 if (SYMBOLP (val) && CHARSETP (val))
204 {
205 encoding_id = repertory_id = XINT (CHARSET_SYMBOL_ID (val));
206 }
207 else if (CONSP (val))
208 {
209 if (! CHARSETP (XCAR (val)))
210 goto invalid_entry;
211 encoding_id = XINT (CHARSET_SYMBOL_ID (XCAR (val)));
212 if (NILP (XCDR (val)))
213 repertory_id = -1;
214 else
215 {
216 if (! CHARSETP (XCDR (val)))
217 goto invalid_entry;
218 repertory_id = XINT (CHARSET_SYMBOL_ID (XCDR (val)));
219 }
220 }
221 else
222 goto invalid_entry;
223 val = Fcons (make_number (encoding_id), make_number (repertory_id));
224 x_font_charset_alist
225 = nconc2 (x_font_charset_alist, Fcons (Fcons (registry, val), Qnil));
226 }
227
228 if (encoding)
229 *encoding = CHARSET_FROM_ID (encoding_id);
230 if (repertory)
231 *repertory = repertory_id >= 0 ? CHARSET_FROM_ID (repertory_id) : NULL;
232 return 0;
233
234 invalid_entry:
235 x_font_charset_alist
236 = nconc2 (x_font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil));
237 return -1;
238}
239
240static Lisp_Object xfont_get_cache P_ ((Lisp_Object));
241static int xfont_parse_name P_ ((FRAME_PTR, char *, Lisp_Object));
242static Lisp_Object xfont_list P_ ((Lisp_Object, Lisp_Object));
243static Lisp_Object xfont_list_family P_ ((Lisp_Object));
244static struct font *xfont_open P_ ((FRAME_PTR, Lisp_Object, int));
245static void xfont_close P_ ((FRAME_PTR, struct font *));
246static int xfont_prepare_face P_ ((FRAME_PTR, struct face *));
247#if 0
248static void xfont_done_face P_ ((FRAME_PTR, struct face *));
249#endif
250static int xfont_has_char P_ ((Lisp_Object, int));
251static unsigned xfont_encode_char P_ ((struct font *, int));
252static int xfont_text_extents P_ ((struct font *, unsigned *, int,
253 struct font_metrics *));
254static int xfont_draw P_ ((struct glyph_string *, int, int, int, int, int));
255
256struct font_driver xfont_driver =
257 {
258 (Lisp_Object) NULL, /* Qx */
259 xfont_get_cache,
260 xfont_parse_name,
261 xfont_list,
262 xfont_list_family,
263 NULL,
264 xfont_open,
265 xfont_close,
266 xfont_prepare_face,
267 NULL /*xfont_done_face*/,
268 xfont_has_char,
269 xfont_encode_char,
270 xfont_text_extents,
271 xfont_draw,
272 };
273
274extern Lisp_Object QCname;
275
276static Lisp_Object
277xfont_get_cache (frame)
278 Lisp_Object frame;
279{
280 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (frame));
281
282 return (dpyinfo->name_list_element);
283}
284
285static int
286xfont_parse_name (f, name, spec)
287 FRAME_PTR f;
288 char *name;
289 Lisp_Object spec;
290{
291 if (font_parse_xlfd (name, spec, 0) >= 0)
292 return 0;
293 name = xfont_query_font (FRAME_X_DISPLAY (f), name, spec);
294 if (name)
295 {
296 XFree (name);
297 return 0;
298 }
299 return -1;
300}
301
302extern Lisp_Object Vface_alternative_font_registry_alist;
303
304static Lisp_Object
305xfont_list (frame, spec)
306 Lisp_Object frame, spec;
307{
308 FRAME_PTR f = XFRAME (frame);
309 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
310 Lisp_Object *vec, val, extra, font_name, entity;
311 char name[256], **names;
312 int i, idx, limit, num_fonts;
313 int error_occurred = 0;
314 USE_SAFE_ALLOCA;
315
316 extra = AREF (spec, FONT_EXTRA_INDEX);
317 font_name = Qnil;
318 if (CONSP (extra))
319 {
320 val = Fassq (QCotf, extra);
321 if (! NILP (val))
322 return null_vector;
323 val = Fassq (QCname, extra);
324 if (CONSP (val))
325 font_name = XCDR (val);
326 }
327
328 if (! STRINGP (font_name)
329 && font_unparse_xlfd (spec, 0, name, 256) < 0)
330 return null_vector;
331
332 BLOCK_INPUT;
333 x_catch_errors (dpyinfo->display);
334
335 if (STRINGP (font_name))
336 {
337 XFontStruct *font = XLoadQueryFont (dpyinfo->display,
338 (char *) SDATA (font_name));
339 unsigned long value;
340
341 num_fonts = 0;
342 if (x_had_errors_p (dpyinfo->display))
343 {
344 /* This error is perhaps due to insufficient memory on X
345 server. Let's just ignore it. */
346 font = NULL;
347 error_occurred = 1;
348 x_clear_errors (dpyinfo->display);
349 }
350 if (font)
351 {
352 if (XGetFontProperty (font, XA_FONT, &value))
353 {
354 char *n = (char *) XGetAtomName (dpyinfo->display, (Atom) value);
355 int len = strlen (n);
356 char *tmp;
357
358 /* If DXPC (a Differential X Protocol Compressor)
359 Ver.3.7 is running, XGetAtomName will return null
360 string. We must avoid such a name. */
361 if (len > 0)
362 {
363 num_fonts = 1;
364 names = (char **) alloca (sizeof (char *));
365 /* Some systems only allow alloca assigned to a
366 simple var. */
367 tmp = (char *) alloca (len + 1); names[0] = tmp;
368 bcopy (n, names[0], len + 1);
369 }
370 XFree (n);
371 }
372 XFreeFont (dpyinfo->display, font);
373 }
374 }
375 else
376 {
377 Lisp_Object registry = AREF (spec, FONT_REGISTRY_INDEX);
378 Lisp_Object alter = Qnil;
379 char *r = NULL;
380
381 if (! NILP (registry))
382 alter = Fassoc_string (SYMBOL_NAME (registry),
383 Vface_alternative_font_registry_alist);
384 while (1)
385 {
386 for (limit = 512, num_fonts = 0; ; limit *= 2)
387 {
388 names = XListFonts (dpyinfo->display, name, limit, &num_fonts);
389 if (x_had_errors_p (dpyinfo->display))
390 {
391 /* This error is perhaps due to insufficient memory
392 on X server. Let's just ignore it. */
393 x_clear_errors (dpyinfo->display);
394 error_occurred = 1;
395 num_fonts = 0;
396 break;
397 }
398 if (num_fonts < limit)
399 break;
400 XFreeFontNames (names);
401 }
402 if (num_fonts > 0
403 || NILP (alter))
404 break;
405
406 /* Setup for trying alternatives. */
407 if (! r
408 && ! (r = strstr (name, (char *) SDATA (SYMBOL_NAME (registry)))))
409 abort ();
410 while (1)
411 {
412 registry = Qnil;
413 alter = XCDR (alter);
414 if (NILP (alter))
415 break;
416 registry = XCAR (alter);
417 if ((r - name) + SBYTES (registry) < 255)
418 break;
419 }
420 if (NILP (registry))
421 break;
422 bcopy (SDATA (registry), r, SBYTES (registry));
423 }
424 }
425
426 x_uncatch_errors ();
427 UNBLOCK_INPUT;
428
429 if (error_occurred)
430 return Qnil;
431 if (num_fonts == 0)
432 return null_vector;
433
434 entity = Fmake_vector (make_number (FONT_ENTITY_MAX), Qnil);
435 ASET (entity, FONT_TYPE_INDEX, Qx);
436 ASET (entity, FONT_FRAME_INDEX, frame);
437
438 SAFE_ALLOCA_LISP (vec, num_fonts);
439 for (i = idx = 0; i < num_fonts; i++)
440 {
441 if (font_parse_xlfd (names[i], entity, 0) > 0)
442 vec[idx++] = Fcopy_sequence (entity);
443 }
444 if (! STRINGP (font_name))
445 {
446 BLOCK_INPUT;
447 XFreeFontNames (names);
448 UNBLOCK_INPUT;
449 }
450 val = Fvector (idx, vec);
451 SAFE_FREE ();
452
453 return val;
454}
455
456static int
457memq_no_quit (elt, list)
458 Lisp_Object elt, list;
459{
460 while (CONSP (list) && ! EQ (XCAR (list), elt))
461 list = XCDR (list);
462 return (CONSP (list));
463}
464
465static Lisp_Object
466xfont_list_family (frame)
467{
468 FRAME_PTR f = XFRAME (frame);
469 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
470 char **names;
471 int num_fonts, i;
472 Lisp_Object list;
473 char *last_family;
474 int last_len;
475
476 BLOCK_INPUT;
477 x_catch_errors (dpyinfo->display);
478 names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
479 0x8000, &num_fonts);
480 if (x_had_errors_p (dpyinfo->display))
481 {
482 /* This error is perhaps due to insufficient memory on X server.
483 Let's just ignore it. */
484 x_clear_errors (dpyinfo->display);
485 num_fonts = 0;
486 }
487
488 list = Qnil;
489 for (i = 0, last_len = 0; i < num_fonts; i++)
490 {
491 char *p0 = names[i], *p1;
492 Lisp_Object family;
493
494 p0++; /* skip the leading '-' */
495 while (*p0 && *p0 != '-') p0++; /* skip foundry */
496 if (! *p0)
497 continue;
498 p1 = ++p0;
499 while (*p1 && *p1 != '-') p1++; /* find the end of family */
500 if (! *p1 || p1 == p0)
501 continue;
502 if (last_len == p1 - p0
503 && bcmp (last_family, p0, last_len) == 0)
504 continue;
505 last_len = p1 - p0;
506 last_family = p0;
507 family = intern_downcase (p0, last_len);
508 if (! memq_no_quit (family, list))
509 list = Fcons (family, list);
510 }
511
512 XFreeFontNames (names);
513 x_uncatch_errors ();
514 UNBLOCK_INPUT;
515
516 return list;
517}
518
519static struct font *
520xfont_open (f, entity, pixel_size)
521 FRAME_PTR f;
522 Lisp_Object entity;
523 int pixel_size;
524{
525 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
526 Display *display = dpyinfo->display;
527 char name[256];
528 int len;
529 unsigned long value;
530 Lisp_Object registry;
531 struct charset *encoding, *repertory;
532 struct font *font;
533 XFontStruct *xfont;
534
535 /* At first, check if we know how to encode characters for this
536 font. */
537 registry = AREF (entity, FONT_REGISTRY_INDEX);
538 if (xfont_registry_charsets (registry, &encoding, &repertory) < 0)
539 return NULL;
540
541 if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0)
542 pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX));
543 len = font_unparse_xlfd (entity, pixel_size, name, 256);
544 if (len <= 0)
545 return NULL;
546
547 BLOCK_INPUT;
548 x_catch_errors (display);
549 xfont = XLoadQueryFont (display, name);
550 if (x_had_errors_p (display))
551 {
552 /* This error is perhaps due to insufficient memory on X server.
553 Let's just ignore it. */
554 x_clear_errors (display);
555 xfont = NULL;
556 }
557 x_uncatch_errors ();
558 UNBLOCK_INPUT;
559
560 if (! xfont)
561 return NULL;
562 font = malloc (sizeof (struct font));
563 font->font.font = xfont;
564 font->entity = entity;
565 font->pixel_size = pixel_size;
566 font->driver = &xfont_driver;
567 font->font.name = malloc (len + 1);
568 if (! font->font.name)
569 {
570 XFreeFont (display, xfont);
571 free (font);
572 return NULL;
573 }
574 bcopy (name, font->font.name, len + 1);
575 font->font.charset = encoding->id;
576 font->encoding_charset = encoding->id;
577 font->repertory_charet = repertory ? repertory->id : -1;
578 font->ascent = xfont->ascent;
579 font->descent = xfont->descent;
580
581 if (xfont->min_bounds.width == xfont->max_bounds.width)
582 {
583 /* Fixed width font. */
584 font->font.average_width = font->font.space_width
585 = xfont->min_bounds.width;
586 }
587 else
588 {
589 XChar2b char2b;
590 XCharStruct *pcm;
591
592 char2b.byte1 = 0x00, char2b.byte2 = 0x20;
593 pcm = xfont_get_pcm (xfont, &char2b);
594 if (pcm)
595 font->font.space_width = pcm->width;
596 else
597 font->font.space_width = xfont->max_bounds.width;
598
599 font->font.average_width
600 = (XGetFontProperty (xfont, dpyinfo->Xatom_AVERAGE_WIDTH, &value)
601 ? (long) value / 10 : 0);
602 if (font->font.average_width < 0)
603 font->font.average_width = - font->font.average_width;
604 if (font->font.average_width == 0)
605 {
606 if (pcm)
607 {
608 int width = pcm->width;
609 for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++)
610 if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL)
611 width += pcm->width;
612 font->font.average_width = width / 95;
613 }
614 else
615 font->font.average_width = xfont->max_bounds.width;
616 }
617 }
618 font->min_width = xfont->min_bounds.width;
619 if (font->min_width <= 0)
620 font->min_width = font->font.space_width;
621
622 BLOCK_INPUT;
623 /* Try to get the full name of FONT. Put it in FULL_NAME. */
624 if (XGetFontProperty (xfont, XA_FONT, &value))
625 {
626 char *full_name = NULL, *p0, *p;
627 int dashes = 0;
628
629 p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);;
630 /* Count the number of dashes in the "full name".
631 If it is too few, this isn't really the font's full name,
632 so don't use it.
633 In X11R4, the fonts did not come with their canonical names
634 stored in them. */
635 while (*p)
636 {
637 if (*p == '-')
638 dashes++;
639 p++;
640 }
641
642 if (dashes >= 13)
643 {
644 full_name = (char *) malloc (p - p0 + 1);
645 if (full_name)
646 bcopy (p0, full_name, p - p0 + 1);
647 }
648 XFree (p0);
649
650 if (full_name)
651 font->font.full_name = full_name;
652 else
653 font->font.full_name = font->font.name;
654 }
655 font->file_name = NULL;
656
657 font->font.size = xfont->max_bounds.width;
658 font->font.height = xfont->ascent + xfont->descent;
659 font->font.baseline_offset
660 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value)
661 ? (long) value : 0);
662 font->font.relative_compose
663 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value)
664 ? (long) value : 0);
665 font->font.default_ascent
666 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
667 ? (long) value : 0);
668 font->font.vertical_centering
669 = (STRINGP (Vvertical_centering_font_regexp)
670 && (fast_c_string_match_ignore_case
671 (Vvertical_centering_font_regexp, font->font.full_name) >= 0));
672
673 UNBLOCK_INPUT;
674
675 dpyinfo->n_fonts++;
676
677 /* Set global flag fonts_changed_p to non-zero if the font loaded
678 has a character with a smaller width than any other character
679 before, or if the font loaded has a smaller height than any other
680 font loaded before. If this happens, it will make a glyph matrix
681 reallocation necessary. */
682 if (dpyinfo->n_fonts == 1)
683 {
684 dpyinfo->smallest_font_height = font->font.height;
685 dpyinfo->smallest_char_width = font->min_width;
686 fonts_changed_p = 1;
687 }
688 else
689 {
690 if (dpyinfo->smallest_font_height > font->font.height)
691 dpyinfo->smallest_font_height = font->font.height, fonts_changed_p |= 1;
692 if (dpyinfo->smallest_char_width > font->min_width)
693 dpyinfo->smallest_char_width = font->min_width, fonts_changed_p |= 1;
694 }
695
696 return font;
697}
698
699static void
700xfont_close (f, font)
701 FRAME_PTR f;
702 struct font *font;
703{
704 BLOCK_INPUT;
705 XFreeFont (FRAME_X_DISPLAY (f), font->font.font);
706 UNBLOCK_INPUT;
707
708 if (font->font.name != font->font.full_name)
709 free (font->font.full_name);
710 free (font->font.name);
711 free (font);
712 FRAME_X_DISPLAY_INFO (f)->n_fonts--;
713}
714
715static int
716xfont_prepare_face (f, face)
717 FRAME_PTR f;
718 struct face *face;
719{
720 BLOCK_INPUT;
721 XSetFont (FRAME_X_DISPLAY (f), face->gc, face->font->fid);
722 UNBLOCK_INPUT;
723
724 return 0;
725}
726
727#if 0
728static void
729xfont_done_face (f, face)
730 FRAME_PTR f;
731 struct face *face;
732{
733 if (face->extra)
734 {
735 BLOCK_INPUT;
736 XFreeGC (FRAME_X_DISPLAY (f), (GC) face->extra);
737 UNBLOCK_INPUT;
738 face->extra = NULL;
739 }
740}
741#endif /* 0 */
742
743static int
744xfont_has_char (entity, c)
745 Lisp_Object entity;
746 int c;
747{
748 Lisp_Object registry = AREF (entity, FONT_REGISTRY_INDEX);
749 struct charset *repertory;
750
751 if (xfont_registry_charsets (registry, NULL, &repertory) < 0)
752 return -1;
753 if (! repertory)
754 return -1;
755 return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
756}
757
758static unsigned
759xfont_encode_char (font, c)
760 struct font *font;
761 int c;
762{
763 struct charset *charset;
764 unsigned code;
765 XChar2b char2b;
766
767 charset = CHARSET_FROM_ID (font->encoding_charset);
768 code = ENCODE_CHAR (charset, c);
769 if (code == CHARSET_INVALID_CODE (charset))
770 return 0xFFFFFFFF;
771 if (font->repertory_charet >= 0)
772 {
773 charset = CHARSET_FROM_ID (font->repertory_charet);
774 return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
775 ? code : 0xFFFFFFFF);
776 }
777 char2b.byte1 = code >> 16;
778 char2b.byte2 = code & 0xFFFF;
779 return (xfont_get_pcm (font->font.font, &char2b) ? code : 0xFFFFFFFF);
780}
781
782static int
783xfont_text_extents (font, code, nglyphs, metrics)
784 struct font *font;
785 unsigned *code;
786 int nglyphs;
787 struct font_metrics *metrics;
788{
789 int width = 0;
790 int i, x;
791
792 if (metrics)
793 bzero (metrics, sizeof (struct font_metrics));
794 for (i = 0, x = 0; i < nglyphs; i++)
795 {
796 XChar2b char2b;
797 static XCharStruct *pcm;
798
799 if (code[i] >= 0x10000)
800 continue;
801 char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
802 pcm = xfont_get_pcm (font->font.font, &char2b);
803 if (! pcm)
804 continue;
805 if (metrics->lbearing > width + pcm->lbearing)
806 metrics->lbearing = width + pcm->lbearing;
807 if (metrics->rbearing < width + pcm->rbearing)
808 metrics->rbearing = width + pcm->rbearing;
809 if (metrics->ascent < pcm->ascent)
810 metrics->ascent = pcm->ascent;
811 if (metrics->descent < pcm->descent)
812 metrics->descent = pcm->descent;
813 width += pcm->width;
814 }
815 if (metrics)
816 metrics->width = width;
817 return width;
818}
819
820static int
821xfont_draw (s, from, to, x, y, with_background)
822 struct glyph_string *s;
823 int from, to, x, y, with_background;
824{
825 XFontStruct *xfont = s->face->font;
826 int len = to - from;
827
828 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
829 {
830 char *str;
831 int i;
832 USE_SAFE_ALLOCA;
833
834 SAFE_ALLOCA (str, char *, len);
835 for (i = 0; i < len ; i++)
836 str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
837 if (with_background > 0)
838 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
839 s->gc, x, y, str, len);
840 else
841 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
842 s->gc, x, y, str, len);
843 SAFE_FREE ();
844 return s->nchars;
845 }
846
847 if (with_background > 0)
848 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
849 s->gc, x, y, s->char2b + from, len);
850 else
851 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
852 s->gc, x, y, s->char2b + from, len);
853
854 return len;
855}
856
857
858
859void
860syms_of_xfont ()
861{
862 staticpro (&x_font_charset_alist);
863 x_font_charset_alist = Qnil;
864
865 DEFSYM (Qx, "x");
866 xfont_driver.type = Qx;
867 register_font_driver (&xfont_driver, NULL);
868}
diff --git a/src/xftfont.c b/src/xftfont.c
new file mode 100644
index 00000000000..dd2b95ccd14
--- /dev/null
+++ b/src/xftfont.c
@@ -0,0 +1,552 @@
1/* xftfont.c -- XFT font driver.
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 <X11/Xlib.h>
27#include <X11/Xft/Xft.h>
28
29#include "lisp.h"
30#include "dispextern.h"
31#include "xterm.h"
32#include "frame.h"
33#include "blockinput.h"
34#include "character.h"
35#include "charset.h"
36#include "fontset.h"
37#include "font.h"
38
39/* Xft font driver. */
40
41static Lisp_Object Qxft;
42
43/* The actual structure for Xft font that can be casted to struct
44 font. */
45
46struct xftfont_info
47{
48 struct font font;
49 Display *display;
50 int screen;
51 XftFont *xftfont;
52 FT_Face ft_face;
53};
54
55/* Structure pointed by (struct face *)->extra */
56struct xftface_info
57{
58 XftColor xft_fg;
59 XftColor xft_bg;
60 XftDraw *xft_draw;
61};
62
63static void xftfont_get_colors P_ ((FRAME_PTR, struct face *, GC gc,
64 struct xftface_info *,
65 XftColor *fg, XftColor *bg));
66static Font xftfont_default_fid P_ ((FRAME_PTR));
67
68
69/* Setup colors pointed by FG and BG for GC. If XFTFACE_INFO is not
70 NULL, reuse the colors in it if possible. BG may be NULL. */
71static void
72xftfont_get_colors (f, face, gc, xftface_info, fg, bg)
73 FRAME_PTR f;
74 struct face *face;
75 GC gc;
76 struct xftface_info *xftface_info;
77 XftColor *fg, *bg;
78{
79 if (xftface_info && face->gc == gc)
80 {
81 *fg = xftface_info->xft_fg;
82 if (bg)
83 *bg = xftface_info->xft_bg;
84 }
85 else
86 {
87 XGCValues xgcv;
88 int fg_done = 0, bg_done = 0;
89
90 BLOCK_INPUT;
91 XGetGCValues (FRAME_X_DISPLAY (f), gc,
92 GCForeground | GCBackground, &xgcv);
93 if (xftface_info)
94 {
95 if (xgcv.foreground == face->foreground)
96 *fg = xftface_info->xft_fg, fg_done = 1;
97 else if (xgcv.foreground == face->background)
98 *fg = xftface_info->xft_bg, fg_done = 1;
99 if (! bg)
100 bg_done = 1;
101 else if (xgcv.background == face->background)
102 *bg = xftface_info->xft_bg, bg_done = 1;
103 else if (xgcv.background == face->foreground)
104 *bg = xftface_info->xft_fg, bg_done = 1;
105 }
106
107 if (fg_done + bg_done < 2)
108 {
109 XColor colors[2];
110
111 colors[0].pixel = fg->pixel = xgcv.foreground;
112 if (bg)
113 colors[1].pixel = bg->pixel = xgcv.background;
114 XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), colors,
115 bg ? 2 : 1);
116 fg->color.alpha = 0xFFFF;
117 fg->color.red = colors[0].red;
118 fg->color.green = colors[0].green;
119 fg->color.blue = colors[0].blue;
120 if (bg)
121 {
122 bg->color.alpha = 0xFFFF;
123 bg->color.red = colors[1].red;
124 bg->color.green = colors[1].green;
125 bg->color.blue = colors[1].blue;
126 }
127 }
128 UNBLOCK_INPUT;
129 }
130}
131
132/* Return the default Font ID on frame F. */
133
134static Font
135xftfont_default_fid (f)
136 FRAME_PTR f;
137{
138 static int fid_known;
139 static Font fid;
140
141 if (! fid_known)
142 {
143 fid = XLoadFont (FRAME_X_DISPLAY (f), "fixed");
144 if (! fid)
145 {
146 fid = XLoadFont (FRAME_X_DISPLAY (f), "*");
147 if (! fid)
148 abort ();
149 }
150 }
151 return fid;
152}
153
154
155static Lisp_Object xftfont_list P_ ((Lisp_Object, Lisp_Object));
156static struct font *xftfont_open P_ ((FRAME_PTR, Lisp_Object, int));
157static void xftfont_close P_ ((FRAME_PTR, struct font *));
158static int xftfont_prepare_face P_ ((FRAME_PTR, struct face *));
159static void xftfont_done_face P_ ((FRAME_PTR, struct face *));
160static unsigned xftfont_encode_char P_ ((struct font *, int));
161static int xftfont_text_extents P_ ((struct font *, unsigned *, int,
162 struct font_metrics *));
163static int xftfont_draw P_ ((struct glyph_string *, int, int, int, int, int));
164
165static int xftfont_anchor_point P_ ((struct font *, unsigned, int,
166 int *, int *));
167
168struct font_driver xftfont_driver;
169
170static Lisp_Object
171xftfont_list (frame, spec)
172 Lisp_Object frame;
173 Lisp_Object spec;
174{
175 Lisp_Object val = ftfont_driver.list (frame, spec);
176
177 if (! NILP (val))
178 {
179 int i;
180
181 for (i = 0; i < ASIZE (val); i++)
182 ASET (AREF (val, i), FONT_TYPE_INDEX, Qxft);
183 }
184 return val;
185}
186
187static FcChar8 ascii_printable[95];
188
189static struct font *
190xftfont_open (f, entity, pixel_size)
191 FRAME_PTR f;
192 Lisp_Object entity;
193 int pixel_size;
194{
195 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
196 Display *display = FRAME_X_DISPLAY (f);
197 Lisp_Object val;
198 FcPattern *pattern, *pat;
199 FcChar8 *file;
200 XFontStruct *xfont;
201 struct xftfont_info *xftfont_info;
202 struct font *font;
203 double size = 0;
204 XftFont *xftfont;
205 int spacing;
206
207 val = AREF (entity, FONT_EXTRA_INDEX);
208 if (XTYPE (val) != Lisp_Misc
209 || XMISCTYPE (val) != Lisp_Misc_Save_Value)
210 return NULL;
211 pattern = XSAVE_VALUE (val)->pointer;
212 if (FcPatternGetString (pattern, FC_FILE, 0, &file) != FcResultMatch)
213 return NULL;
214
215 size = XINT (AREF (entity, FONT_SIZE_INDEX));
216 if (size == 0)
217 size = pixel_size;
218 pat = FcPatternCreate ();
219 FcPatternAddString (pat, FC_FILE, file);
220 FcPatternAddDouble (pat, FC_PIXEL_SIZE, pixel_size);
221 FcPatternAddBool (pat, FC_ANTIALIAS, FcTrue);
222 xftfont = XftFontOpenPattern (display, pat);
223 /* We should not destroy PAT here because it is kept in XFTFONT and
224 destroyed automatically when XFTFONT is closed. */
225 if (! xftfont)
226 return NULL;
227
228 xftfont_info = malloc (sizeof (struct xftfont_info));
229 if (! xftfont_info)
230 {
231 XftFontClose (display, xftfont);
232 return NULL;
233 }
234 xfont = malloc (sizeof (XFontStruct));
235 if (! xftfont_info)
236 {
237 XftFontClose (display, xftfont);
238 free (xftfont_info);
239 return NULL;
240 }
241 xftfont_info->display = display;
242 xftfont_info->screen = FRAME_X_SCREEN_NUMBER (f);
243 xftfont_info->xftfont = xftfont;
244 xftfont_info->ft_face = XftLockFace (xftfont);
245
246 font = (struct font *) xftfont_info;
247 font->entity = entity;
248 font->pixel_size = size;
249 font->driver = &xftfont_driver;
250 font->font.name = font->font.full_name = NULL;
251 font->file_name = (char *) file;
252 font->font.size = xftfont->max_advance_width;
253 font->ascent = xftfont->ascent;
254 font->descent = xftfont->descent;
255 font->font.height = xftfont->ascent + xftfont->descent;
256
257 if (FcPatternGetInteger (xftfont->pattern, FC_SPACING, 0, &spacing)
258 != FcResultMatch)
259 spacing = FC_PROPORTIONAL;
260 if (spacing != FC_PROPORTIONAL)
261 font->font.average_width = font->font.space_width
262 = xftfont->max_advance_width;
263 else
264 {
265 XGlyphInfo extents;
266
267 if (! ascii_printable[0])
268 {
269 int i;
270 for (i = 0; i < 95; i++)
271 ascii_printable[i] = ' ' + i;
272 }
273 XftTextExtents8 (display, xftfont, ascii_printable, 1, &extents);
274 font->font.space_width = extents.xOff;
275 if (font->font.space_width <= 0)
276 /* dirty workaround */
277 font->font.space_width = pixel_size;
278 XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents);
279 font->font.average_width = (font->font.space_width + extents.xOff) / 95;
280 }
281
282 /* Unfortunately Xft doesn't provide a way to get minimum char
283 width. So, we use space_width instead. */
284 font->min_width = font->font.space_width;
285
286 font->font.baseline_offset = 0;
287 font->font.relative_compose = 0;
288 font->font.default_ascent = 0;
289 font->font.vertical_centering = 0;
290
291 /* Setup pseudo XFontStruct */
292 xfont->fid = xftfont_default_fid (f);
293 xfont->ascent = xftfont->ascent;
294 xfont->descent = xftfont->descent;
295 xfont->max_bounds.descent = xftfont->descent;
296 xfont->max_bounds.width = xftfont->max_advance_width;
297 xfont->min_bounds.width = font->font.space_width;
298 font->font.font = xfont;
299
300 dpyinfo->n_fonts++;
301
302 /* Set global flag fonts_changed_p to non-zero if the font loaded
303 has a character with a smaller width than any other character
304 before, or if the font loaded has a smaller height than any other
305 font loaded before. If this happens, it will make a glyph matrix
306 reallocation necessary. */
307 if (dpyinfo->n_fonts == 1)
308 {
309 dpyinfo->smallest_font_height = font->font.height;
310 dpyinfo->smallest_char_width = font->min_width;
311 fonts_changed_p = 1;
312 }
313 else
314 {
315 if (dpyinfo->smallest_font_height > font->font.height)
316 dpyinfo->smallest_font_height = font->font.height,
317 fonts_changed_p |= 1;
318 if (dpyinfo->smallest_char_width > font->min_width)
319 dpyinfo->smallest_char_width = font->min_width,
320 fonts_changed_p |= 1;
321 }
322
323 return font;
324}
325
326static void
327xftfont_close (f, font)
328 FRAME_PTR f;
329 struct font *font;
330{
331 struct xftfont_info *xftfont_info = (struct xftfont_info *) font;
332
333 XftUnlockFace (xftfont_info->xftfont);
334 XftFontClose (xftfont_info->display, xftfont_info->xftfont);
335 free (font);
336 FRAME_X_DISPLAY_INFO (f)->n_fonts--;
337}
338
339struct xftdraw_list
340{
341 XftDraw *xftdraw;
342 struct xftdraw_list *next;
343};
344
345static struct xftdraw_list *xftdraw_list;
346
347static void
348register_xftdraw (xftdraw)
349 XftDraw *xftdraw;
350{
351 struct xftdraw_list *list = malloc (sizeof (struct xftdraw_list));
352
353 list->xftdraw = xftdraw;
354 list->next = xftdraw_list;
355 xftdraw_list = list;
356}
357
358static void
359check_xftdraw (xftdraw)
360 XftDraw *xftdraw;
361{
362 struct xftdraw_list *list, *prev;
363
364 for (list = xftdraw_list, prev = NULL; list; prev = list, list = list->next)
365 {
366 if (list->xftdraw == xftdraw)
367 {
368 if (! prev)
369 {
370 list = xftdraw_list->next;
371 free (xftdraw_list);
372 xftdraw_list = list;
373 }
374 else
375 {
376 prev->next = list->next;
377 free (list);
378 list = prev;
379 }
380 return;
381 }
382 }
383 abort ();
384}
385
386static int
387xftfont_prepare_face (f, face)
388 FRAME_PTR f;
389 struct face *face;
390{
391 struct xftface_info *xftface_info = malloc (sizeof (struct xftface_info));
392
393 if (! xftface_info)
394 return -1;
395
396 BLOCK_INPUT;
397 xftface_info->xft_draw = XftDrawCreate (FRAME_X_DISPLAY (f),
398 FRAME_X_WINDOW (f),
399 FRAME_X_VISUAL (f),
400 FRAME_X_COLORMAP (f));
401 register_xftdraw (xftface_info->xft_draw);
402
403 xftfont_get_colors (f, face, face->gc, NULL,
404 &xftface_info->xft_fg, &xftface_info->xft_bg);
405 UNBLOCK_INPUT;
406
407 face->extra = xftface_info;
408 return 0;
409}
410
411static void
412xftfont_done_face (f, face)
413 FRAME_PTR f;
414 struct face *face;
415{
416 struct xftface_info *xftface_info = (struct xftface_info *) face->extra;
417
418 if (xftface_info)
419 {
420 BLOCK_INPUT;
421 check_xftdraw (xftface_info->xft_draw);
422 XftDrawDestroy (xftface_info->xft_draw);
423 UNBLOCK_INPUT;
424 free (xftface_info);
425 face->extra = NULL;
426 }
427}
428
429static unsigned
430xftfont_encode_char (font, c)
431 struct font *font;
432 int c;
433{
434 struct xftfont_info *xftfont_info = (struct xftfont_info *) font;
435 unsigned code = XftCharIndex (xftfont_info->display, xftfont_info->xftfont,
436 (FcChar32) c);
437
438 return (code ? code : 0xFFFFFFFF);
439}
440
441static int
442xftfont_text_extents (font, code, nglyphs, metrics)
443 struct font *font;
444 unsigned *code;
445 int nglyphs;
446 struct font_metrics *metrics;
447{
448 struct xftfont_info *xftfont_info = (struct xftfont_info *) font;
449 XGlyphInfo extents;
450
451 BLOCK_INPUT;
452 XftGlyphExtents (xftfont_info->display, xftfont_info->xftfont, code, nglyphs,
453 &extents);
454 UNBLOCK_INPUT;
455 if (metrics)
456 {
457 metrics->lbearing = - extents.x;
458 metrics->rbearing = - extents.x + extents.width;
459 metrics->width = extents.xOff;
460 metrics->ascent = extents.y;
461 metrics->descent = extents.y - extents.height;
462 }
463 return extents.xOff;
464}
465
466static int
467xftfont_draw (s, from, to, x, y, with_background)
468 struct glyph_string *s;
469 int from, to, x, y, with_background;
470{
471 FRAME_PTR f = s->f;
472 struct face *face = s->face;
473 struct xftfont_info *xftfont_info = (struct xftfont_info *) face->font_info;
474 struct xftface_info *xftface_info = (struct xftface_info *) face->extra;
475 FT_UInt *code;
476 XftColor fg, bg;
477 XRectangle r;
478 int len = to - from;
479 int i;
480
481 xftfont_get_colors (f, face, s->gc, xftface_info,
482 &fg, s->width ? &bg : NULL);
483 BLOCK_INPUT;
484 if (s->clip_width)
485 {
486 r.x = s->clip_x, r.width = s->clip_width;
487 r.y = s->clip_y, r.height = s->clip_height;
488 XftDrawSetClipRectangles (xftface_info->xft_draw, 0, 0, &r, 1);
489 }
490 if (with_background)
491 {
492 struct font *font = (struct font *) face->font_info;
493
494 XftDrawRect (xftface_info->xft_draw, &bg,
495 x, y - face->font->ascent, s->width, font->font.height);
496 }
497 code = alloca (sizeof (FT_UInt) * len);
498 for (i = 0; i < len; i++)
499 code[i] = ((XCHAR2B_BYTE1 (s->char2b + from + i) << 8)
500 | XCHAR2B_BYTE2 (s->char2b + from + i));
501
502 XftDrawGlyphs (xftface_info->xft_draw, &fg, xftfont_info->xftfont,
503 x, y, code, len);
504 if (s->clip_width)
505 XftDrawSetClip (xftface_info->xft_draw, NULL);
506 UNBLOCK_INPUT;
507
508 return len;
509}
510
511static int
512xftfont_anchor_point (font, code, index, x, y)
513 struct font *font;
514 unsigned code;
515 int index;
516 int *x, *y;
517{
518 struct xftfont_info *xftfont_info = (struct xftfont_info *) font;
519 FT_Face ft_face = xftfont_info->ft_face;
520
521 if (FT_Load_Glyph (ft_face, code, FT_LOAD_DEFAULT) != 0)
522 return -1;
523 if (ft_face->glyph->format != FT_GLYPH_FORMAT_OUTLINE)
524 return -1;
525 if (index >= ft_face->glyph->outline.n_points)
526 return -1;
527 *x = ft_face->glyph->outline.points[index].x;
528 *y = ft_face->glyph->outline.points[index].y;
529 return 0;
530}
531
532
533void
534syms_of_xftfont ()
535{
536 DEFSYM (Qxft, "xft");
537
538 xftfont_driver = ftfont_driver;
539 xftfont_driver.type = Qxft;
540 xftfont_driver.get_cache = xfont_driver.get_cache;
541 xftfont_driver.list = xftfont_list;
542 xftfont_driver.open = xftfont_open;
543 xftfont_driver.close = xftfont_close;
544 xftfont_driver.prepare_face = xftfont_prepare_face;
545 xftfont_driver.done_face = xftfont_done_face;
546 xftfont_driver.encode_char = xftfont_encode_char;
547 xftfont_driver.text_extents = xftfont_text_extents;
548 xftfont_driver.draw = xftfont_draw;
549 xftfont_driver.anchor_point = xftfont_anchor_point;
550
551 register_font_driver (&xftfont_driver, NULL);
552}
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-26 02:10:40 +0000