1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006 Free Software Foundation, Inc.
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2, or (at your option)
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 Boston, MA 02110-1301, USA. */
33 #include "dispextern.h"
35 #include "character.h"
36 #include "composite.h"
46 #define xassert(X) do {if (!(X)) abort ();} while (0)
48 #define xassert(X) (void) 0
51 int enable_font_backend
;
55 Lisp_Object Qopentype
;
57 /* Important character set symbols. */
58 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 /* Like CHECK_FONT_SPEC but also validate properties of the font-spec,
61 and set X to the validated result. */
63 #define CHECK_VALIDATE_FONT_SPEC(x) \
65 if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); \
66 x = font_prop_validate (x); \
69 /* Number of pt per inch (from the TeXbook). */
70 #define PT_PER_INCH 72.27
72 /* Return a pixel size (integer) corresponding to POINT size (double)
74 #define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5)
76 /* Return a point size (double) corresponding to POINT size (integer)
78 #define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH * 10 / (DPI) + 0.5)
80 /* Special string of zero length. It is used to specify a NULL name
81 in a font properties (e.g. adstyle). We don't use the symbol of
82 NULL name because it's confusing (Lisp printer prints nothing for
84 Lisp_Object null_string
;
86 /* Special vector of zero length. This is repeatedly used by (struct
87 font_driver *)->list when a specified font is not found. */
88 Lisp_Object null_vector
;
90 /* Vector of 3 elements. Each element is an alist for one of font
91 style properties (weight, slant, width). The alist contains a
92 mapping between symbolic property values (e.g. `medium' for weight)
93 and numeric property values (e.g. 100). So, it looks like this:
94 [((thin . 0) ... (heavy . 210))
95 ((ro . 0) ... (ot . 210))
96 ((ultracondensed . 50) ... (wide . 200))] */
97 static Lisp_Object font_style_table
;
99 /* Alist of font family vs the corresponding aliases.
100 Each element has this form:
101 (FAMILY ALIAS1 ALIAS2 ...) */
103 static Lisp_Object font_family_alist
;
105 /* Symbols representing keys of normal font properties. */
106 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
107 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
, QCextra
;
108 /* Symbols representing keys of font extra info. */
109 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClanguage
, QCscript
;
110 /* Symbols representing values of font spacing property. */
111 Lisp_Object Qc
, Qm
, Qp
, Qd
;
113 /* List of all font drivers. All font-backends (XXXfont.c) call
114 add_font_driver in syms_of_XXXfont to register the font-driver
116 static struct font_driver_list
*font_driver_list
;
118 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
119 static Lisp_Object prop_name_to_numeric
P_ ((enum font_property_index
,
121 static Lisp_Object prop_numeric_to_name
P_ ((enum font_property_index
, int));
122 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
123 static void build_font_family_alist
P_ ((void));
125 /* Number of registered font drivers. */
126 static int num_font_drivers
;
128 /* Return a pixel size of font-spec SPEC on frame F. */
131 font_pixel_size (f
, spec
)
135 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
138 Lisp_Object extra
, val
;
144 point_size
= XFLOAT_DATA (size
);
145 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
146 val
= assq_no_quit (extra
, QCdpi
);
149 if (INTEGERP (XCDR (val
)))
150 dpi
= XINT (XCDR (val
));
152 dpi
= XFLOAT_DATA (XCDR (val
)) + 0.5;
156 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
160 /* Return a numeric value corresponding to PROP's NAME (symbol). If
161 NAME is not registered in font_style_table, return Qnil. PROP must
162 be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
165 prop_name_to_numeric (prop
, name
)
166 enum font_property_index prop
;
169 int table_index
= prop
- FONT_WEIGHT_INDEX
;
172 val
= assq_no_quit (name
, AREF (font_style_table
, table_index
));
173 return (NILP (val
) ? Qnil
: XCDR (val
));
177 /* Return a name (symbol) corresponding to PROP's NUMERIC value. If
178 no name is registered for NUMERIC in font_style_table, return a
179 symbol of integer name (e.g. `123'). PROP must be one of
180 FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
183 prop_numeric_to_name (prop
, numeric
)
184 enum font_property_index prop
;
187 int table_index
= prop
- FONT_WEIGHT_INDEX
;
188 Lisp_Object table
= AREF (font_style_table
, table_index
);
191 while (! NILP (table
))
193 if (XINT (XCDR (XCAR (table
))) >= numeric
)
195 if (XINT (XCDR (XCAR (table
))) == numeric
)
196 return XCAR (XCAR (table
));
200 table
= XCDR (table
);
202 sprintf (buf
, "%d", numeric
);
207 /* Return a symbol whose name is STR (length LEN). If STR contains
208 uppercase letters, downcase them in advance. */
211 intern_downcase (str
, len
)
218 for (i
= 0; i
< len
; i
++)
219 if (isupper (str
[i
]))
222 return Fintern (make_unibyte_string (str
, len
), Qnil
);
225 return Fintern (null_string
, Qnil
);
226 bcopy (str
, buf
, len
);
228 if (isascii (buf
[i
]))
229 buf
[i
] = tolower (buf
[i
]);
230 return Fintern (make_unibyte_string (buf
, len
), Qnil
);
233 extern Lisp_Object Vface_alternative_font_family_alist
;
236 build_font_family_alist ()
238 Lisp_Object alist
= Vface_alternative_font_family_alist
;
240 for (; CONSP (alist
); alist
= XCDR (alist
))
242 Lisp_Object tail
, elt
;
244 for (tail
= XCAR (alist
), elt
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
245 elt
= nconc2 (elt
, Fcons (Fintern (XCAR (tail
), Qnil
), Qnil
));
246 font_family_alist
= Fcons (elt
, font_family_alist
);
251 /* Font property validater. */
253 static Lisp_Object font_prop_validate_symbol
P_ ((enum font_property_index
,
254 Lisp_Object
, Lisp_Object
));
255 static Lisp_Object font_prop_validate_style
P_ ((enum font_property_index
,
256 Lisp_Object
, Lisp_Object
));
257 static Lisp_Object font_prop_validate_non_neg
P_ ((enum font_property_index
,
258 Lisp_Object
, Lisp_Object
));
259 static Lisp_Object font_prop_validate_spacing
P_ ((enum font_property_index
,
260 Lisp_Object
, Lisp_Object
));
261 static int get_font_prop_index
P_ ((Lisp_Object
, int));
262 static Lisp_Object font_prop_validate
P_ ((Lisp_Object
));
263 static Lisp_Object font_put_extra
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
266 font_prop_validate_symbol (prop_index
, prop
, val
)
267 enum font_property_index prop_index
;
268 Lisp_Object prop
, val
;
270 if (EQ (prop
, QCotf
))
271 return (SYMBOLP (val
) ? val
: Qerror
);
273 val
= (SCHARS (val
) == 0 ? null_string
274 : intern_downcase ((char *) SDATA (val
), SBYTES (val
)));
275 else if (SYMBOLP (val
))
277 if (SCHARS (SYMBOL_NAME (val
)) == 0)
286 font_prop_validate_style (prop_index
, prop
, val
)
287 enum font_property_index prop_index
;
288 Lisp_Object prop
, val
;
290 if (! INTEGERP (val
))
293 val
= intern_downcase ((char *) SDATA (val
), SBYTES (val
));
298 val
= prop_name_to_numeric (prop_index
, val
);
307 font_prop_validate_non_neg (prop_index
, prop
, val
)
308 enum font_property_index prop_index
;
309 Lisp_Object prop
, val
;
311 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
316 font_prop_validate_spacing (prop_index
, prop
, val
)
317 enum font_property_index prop_index
;
318 Lisp_Object prop
, val
;
320 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
323 return make_number (FONT_SPACING_CHARCELL
);
325 return make_number (FONT_SPACING_MONO
);
327 return make_number (FONT_SPACING_PROPORTIONAL
);
331 /* Structure of known font property keys and validater of the
335 /* Pointer to the key symbol. */
337 /* Function to validate the value VAL, or NULL if any value is ok. */
338 Lisp_Object (*validater
) P_ ((enum font_property_index prop_index
,
339 Lisp_Object prop
, Lisp_Object val
));
340 } font_property_table
[] =
341 { { &QCtype
, font_prop_validate_symbol
},
342 { &QCfoundry
, font_prop_validate_symbol
},
343 { &QCfamily
, font_prop_validate_symbol
},
344 { &QCadstyle
, font_prop_validate_symbol
},
345 { &QCregistry
, font_prop_validate_symbol
},
346 { &QCweight
, font_prop_validate_style
},
347 { &QCslant
, font_prop_validate_style
},
348 { &QCwidth
, font_prop_validate_style
},
349 { &QCsize
, font_prop_validate_non_neg
},
350 { &QClanguage
, font_prop_validate_symbol
},
351 { &QCscript
, font_prop_validate_symbol
},
352 { &QCdpi
, font_prop_validate_non_neg
},
353 { &QCspacing
, font_prop_validate_spacing
},
354 { &QCscalable
, NULL
},
355 { &QCotf
, font_prop_validate_symbol
}
358 #define FONT_PROPERTY_TABLE_SIZE \
359 ((sizeof font_property_table) / (sizeof *font_property_table))
362 get_font_prop_index (key
, from
)
366 for (; from
< FONT_PROPERTY_TABLE_SIZE
; from
++)
367 if (EQ (key
, *font_property_table
[from
].key
))
373 font_prop_validate (spec
)
377 Lisp_Object prop
, val
, extra
;
379 for (i
= FONT_TYPE_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
381 if (! NILP (AREF (spec
, i
)))
383 prop
= *font_property_table
[i
].key
;
384 val
= (font_property_table
[i
].validater
) (i
, prop
, AREF (spec
, i
));
385 if (EQ (val
, Qerror
))
386 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
387 Fcons (prop
, AREF (spec
, i
))));
391 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
392 CONSP (extra
); extra
= XCDR (extra
))
394 Lisp_Object elt
= XCAR (extra
);
397 i
= get_font_prop_index (prop
, FONT_EXTRA_INDEX
);
399 && font_property_table
[i
].validater
)
401 val
= (font_property_table
[i
].validater
) (i
, prop
, XCDR (elt
));
402 if (EQ (val
, Qerror
))
403 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
412 font_put_extra (font
, prop
, val
)
413 Lisp_Object font
, prop
, val
;
415 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
416 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
420 extra
= Fcons (Fcons (prop
, val
), extra
);
421 ASET (font
, FONT_EXTRA_INDEX
, extra
);
429 /* Font name parser and unparser */
431 static Lisp_Object intern_font_field
P_ ((char *, int));
432 static int parse_matrix
P_ ((char *));
433 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
434 static int font_parse_name
P_ ((char *, Lisp_Object
));
436 /* An enumerator for each field of an XLFD font name. */
437 enum xlfd_field_index
456 /* An enumerator for mask bit corresponding to each XLFD field. */
459 XLFD_FOUNDRY_MASK
= 0x0001,
460 XLFD_FAMILY_MASK
= 0x0002,
461 XLFD_WEIGHT_MASK
= 0x0004,
462 XLFD_SLANT_MASK
= 0x0008,
463 XLFD_SWIDTH_MASK
= 0x0010,
464 XLFD_ADSTYLE_MASK
= 0x0020,
465 XLFD_PIXEL_MASK
= 0x0040,
466 XLFD_POINT_MASK
= 0x0080,
467 XLFD_RESX_MASK
= 0x0100,
468 XLFD_RESY_MASK
= 0x0200,
469 XLFD_SPACING_MASK
= 0x0400,
470 XLFD_AVGWIDTH_MASK
= 0x0800,
471 XLFD_REGISTRY_MASK
= 0x1000,
472 XLFD_ENCODING_MASK
= 0x2000
476 /* Return a Lispy value of a XLFD font field at STR and LEN bytes.
477 If LEN is zero, it returns `null_string'.
478 If STR is "*", it returns nil.
479 If all characters in STR are digits, it returns an integer.
480 Otherwise, it returns a symbol interned from downcased STR. */
483 intern_font_field (str
, len
)
491 if (*str
== '*' && len
== 1)
495 for (i
= 1; i
< len
; i
++)
496 if (! isdigit (str
[i
]))
499 return make_number (atoi (str
));
501 return intern_downcase (str
, len
);
504 /* Parse P pointing the pixel/point size field of the form
505 `[A B C D]' which specifies a transformation matrix:
511 by which all glyphs of the font are transformed. The spec says
512 that scalar value N for the pixel/point size is equivalent to:
513 A = N * resx/resy, B = C = 0, D = N.
515 Return the scalar value N if the form is valid. Otherwise return
526 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
529 matrix
[i
] = - strtod (p
+ 1, &end
);
531 matrix
[i
] = strtod (p
, &end
);
534 return (i
== 4 ? (int) matrix
[3] : -1);
537 /* Expand a wildcard field in FIELD (the first N fields are filled) to
538 multiple fields to fill in all 14 XLFD fields while restring a
539 field position by its contents. */
542 font_expand_wildcards (field
, n
)
543 Lisp_Object field
[XLFD_LAST_INDEX
];
547 Lisp_Object tmp
[XLFD_LAST_INDEX
];
548 /* Array of information about where this element can go. Nth
549 element is for Nth element of FIELD. */
551 /* Minimum possible field. */
553 /* Maxinum possible field. */
555 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
557 } range
[XLFD_LAST_INDEX
];
559 int range_from
, range_to
;
562 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
563 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
564 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
565 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
566 | XLFD_AVGWIDTH_MASK)
567 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
569 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
570 field. The value is shifted to left one bit by one in the
572 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
573 range_mask
= (range_mask
<< 1) | 1;
575 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
576 position-based retriction for FIELD[I]. */
577 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
578 i
++, range_from
++, range_to
++, range_mask
<<= 1)
580 Lisp_Object val
= field
[i
];
586 range
[i
].from
= range_from
;
587 range
[i
].to
= range_to
;
588 range
[i
].mask
= range_mask
;
592 /* The triplet FROM, TO, and MASK is a value-based
593 retriction for FIELD[I]. */
599 int numeric
= XINT (val
);
602 from
= to
= XLFD_ENCODING_INDEX
,
603 mask
= XLFD_ENCODING_MASK
;
604 else if (numeric
== 0)
605 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
606 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
607 else if (numeric
<= 48)
608 from
= to
= XLFD_PIXEL_INDEX
,
609 mask
= XLFD_PIXEL_MASK
;
611 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
612 mask
= XLFD_LARGENUM_MASK
;
614 else if (EQ (val
, null_string
))
615 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
616 mask
= XLFD_NULL_MASK
;
618 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
621 Lisp_Object name
= SYMBOL_NAME (val
);
623 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
624 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
625 mask
= XLFD_REGENC_MASK
;
627 from
= to
= XLFD_ENCODING_INDEX
,
628 mask
= XLFD_ENCODING_MASK
;
630 else if (range_from
<= XLFD_WEIGHT_INDEX
631 && range_to
>= XLFD_WEIGHT_INDEX
632 && !NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX
, val
)))
633 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
634 else if (range_from
<= XLFD_SLANT_INDEX
635 && range_to
>= XLFD_SLANT_INDEX
636 && !NILP (prop_name_to_numeric (FONT_SLANT_INDEX
, val
)))
637 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
638 else if (range_from
<= XLFD_SWIDTH_INDEX
639 && range_to
>= XLFD_SWIDTH_INDEX
640 && !NILP (prop_name_to_numeric (FONT_WIDTH_INDEX
, val
)))
641 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
644 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
645 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
647 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
648 mask
= XLFD_SYMBOL_MASK
;
651 /* Merge position-based and value-based restrictions. */
653 while (from
< range_from
)
654 mask
&= ~(1 << from
++);
655 while (from
< 14 && ! (mask
& (1 << from
)))
657 while (to
> range_to
)
658 mask
&= ~(1 << to
--);
659 while (to
>= 0 && ! (mask
& (1 << to
)))
663 range
[i
].from
= from
;
665 range
[i
].mask
= mask
;
667 if (from
> range_from
|| to
< range_to
)
669 /* The range is narrowed by value-based restrictions.
670 Reflect it to the other fields. */
672 /* Following fields should be after FROM. */
674 /* Preceding fields should be before TO. */
675 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
677 /* Check FROM for non-wildcard field. */
678 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
680 while (range
[j
].from
< from
)
681 range
[j
].mask
&= ~(1 << range
[j
].from
++);
682 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
684 range
[j
].from
= from
;
687 from
= range
[j
].from
;
688 if (range
[j
].to
> to
)
690 while (range
[j
].to
> to
)
691 range
[j
].mask
&= ~(1 << range
[j
].to
--);
692 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
705 /* Decide all fileds from restrictions in RANGE. */
706 for (i
= j
= 0; i
< n
; i
++)
708 if (j
< range
[i
].from
)
710 if (i
== 0 || ! NILP (tmp
[i
- 1]))
711 /* None of TMP[X] corresponds to Jth field. */
713 for (; j
< range
[i
].from
; j
++)
718 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
720 for (; j
< XLFD_LAST_INDEX
; j
++)
722 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
723 field
[XLFD_ENCODING_INDEX
]
724 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
728 /* Parse NAME (null terminated) as XLFD and store information in FONT
729 (font-spec or font-entity). Size property of FONT is set as
731 specified XLFD fields FONT property
732 --------------------- -------------
733 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
734 POINT_SIZE and RESY calculated pixel size (Lisp integer)
735 POINT_SIZE POINT_SIZE/10 (Lisp float)
737 If NAME is successfully parsed, return 0. Otherwise return -1.
739 FONT is usually a font-spec, but when this function is called from
740 X font backend driver, it is a font-entity. In that case, NAME is
741 a fully specified XLFD, and we set FONT_EXTRA_INDEX of FONT to a
742 symbol RESX-RESY-SPACING-AVGWIDTH.
746 font_parse_xlfd (name
, font
)
750 int len
= strlen (name
);
752 Lisp_Object dpi
, spacing
;
754 char *f
[XLFD_LAST_INDEX
];
759 /* Maximum XLFD name length is 255. */
761 /* Accept "*-.." as a fully specified XLFD. */
762 if (name
[0] == '*' && name
[1] == '-')
763 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
766 for (p
= name
+ i
; *p
; p
++)
767 if (*p
== '-' && i
< XLFD_LAST_INDEX
)
771 dpi
= spacing
= Qnil
;
774 if (i
== XLFD_LAST_INDEX
)
778 /* Fully specified XLFD. */
779 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
781 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
785 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
787 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
790 Lisp_Object numeric
= prop_name_to_numeric (j
, val
);
792 if (INTEGERP (numeric
))
797 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
799 ASET (font
, FONT_ADSTYLE_INDEX
, val
);
800 i
= XLFD_REGISTRY_INDEX
;
801 val
= intern_font_field (f
[i
], f
[i
+ 2] - f
[i
]);
803 ASET (font
, FONT_REGISTRY_INDEX
, val
);
805 p
= f
[XLFD_PIXEL_INDEX
];
806 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
807 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
810 i
= XLFD_PIXEL_INDEX
;
811 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
813 ASET (font
, FONT_SIZE_INDEX
, val
);
816 double point_size
= -1;
818 xassert (FONT_SPEC_P (font
));
819 p
= f
[XLFD_POINT_INDEX
];
821 point_size
= parse_matrix (p
);
822 else if (isdigit (*p
))
823 point_size
= atoi (p
), point_size
/= 10;
825 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
828 i
= XLFD_PIXEL_INDEX
;
829 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
831 ASET (font
, FONT_SIZE_INDEX
, val
);
836 /* Parse RESX, RESY, SPACING, and AVGWIDTH. */
837 if (FONT_ENTITY_P (font
))
840 ASET (font
, FONT_EXTRA_INDEX
,
841 intern_font_field (f
[i
], f
[XLFD_REGISTRY_INDEX
] - 1 - f
[i
]));
845 /* Here we just setup DPI, SPACING, and AVGWIDTH. They are set
846 in FONT_EXTRA_INDEX later. */
848 dpi
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
849 i
= XLFD_SPACING_INDEX
;
850 spacing
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
851 p
= f
[XLFD_AVGWIDTH_INDEX
];
859 int wild_card_found
= 0;
860 Lisp_Object prop
[XLFD_LAST_INDEX
];
862 for (j
= 0; j
< i
; j
++)
866 if (f
[j
][1] && f
[j
][1] != '-')
871 else if (isdigit (*f
[j
]))
873 for (p
= f
[j
] + 1; isdigit (*p
); p
++);
875 prop
[j
] = intern_downcase (f
[j
], p
- f
[j
]);
877 prop
[j
] = make_number (atoi (f
[j
]));
880 prop
[j
] = intern_font_field (f
[j
], f
[j
+ 1] - 1 - f
[j
]);
882 prop
[j
] = intern_font_field (f
[j
], f
[i
] - f
[j
]);
884 if (! wild_card_found
)
886 if (font_expand_wildcards (prop
, i
) < 0)
889 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
890 if (! NILP (prop
[i
]))
891 ASET (font
, j
, prop
[i
]);
892 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
893 if (! NILP (prop
[i
]))
894 ASET (font
, j
, prop
[i
]);
895 if (! NILP (prop
[XLFD_ADSTYLE_INDEX
]))
896 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
897 val
= prop
[XLFD_REGISTRY_INDEX
];
900 val
= prop
[XLFD_ENCODING_INDEX
];
902 val
= Fintern (concat2 (build_string ("*-"), SYMBOL_NAME (val
)),
905 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
906 val
= Fintern (concat2 (SYMBOL_NAME (val
), build_string ("-*")),
909 val
= Fintern (concat3 (SYMBOL_NAME (val
), build_string ("-"),
910 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
])),
913 ASET (font
, FONT_REGISTRY_INDEX
, val
);
915 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
916 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
917 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
919 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
921 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
924 dpi
= prop
[XLFD_RESX_INDEX
];
925 spacing
= prop
[XLFD_SPACING_INDEX
];
926 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
927 avgwidth
= XINT (prop
[XLFD_AVGWIDTH_INDEX
]);
931 font_put_extra (font
, QCdpi
, dpi
);
932 if (! NILP (spacing
))
933 font_put_extra (font
, QCspacing
, spacing
);
935 font_put_extra (font
, QCscalable
, avgwidth
== 0 ? Qt
: Qnil
);
940 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
941 length), and return the name length. If FONT_SIZE_INDEX of FONT is
942 0, use PIXEL_SIZE instead. */
945 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
951 char *f
[XLFD_REGISTRY_INDEX
+ 1];
955 xassert (FONTP (font
));
957 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
960 if (i
== FONT_ADSTYLE_INDEX
)
961 j
= XLFD_ADSTYLE_INDEX
;
962 else if (i
== FONT_REGISTRY_INDEX
)
963 j
= XLFD_REGISTRY_INDEX
;
964 val
= AREF (font
, i
);
967 if (j
== XLFD_REGISTRY_INDEX
)
968 f
[j
] = "*-*", len
+= 4;
970 f
[j
] = "*", len
+= 2;
975 val
= SYMBOL_NAME (val
);
976 if (j
== XLFD_REGISTRY_INDEX
977 && ! strchr ((char *) SDATA (val
), '-'))
979 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
980 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
982 f
[j
] = alloca (SBYTES (val
) + 3);
983 sprintf (f
[j
], "%s-*", SDATA (val
));
984 len
+= SBYTES (val
) + 3;
988 f
[j
] = alloca (SBYTES (val
) + 4);
989 sprintf (f
[j
], "%s*-*", SDATA (val
));
990 len
+= SBYTES (val
) + 4;
994 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
998 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1001 val
= AREF (font
, i
);
1003 f
[j
] = "*", len
+= 2;
1007 val
= prop_numeric_to_name (i
, XINT (val
));
1009 val
= SYMBOL_NAME (val
);
1010 xassert (STRINGP (val
));
1011 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1015 val
= AREF (font
, FONT_SIZE_INDEX
);
1016 xassert (NUMBERP (val
) || NILP (val
));
1019 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1022 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1024 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", pixel_size
) + 1;
1026 else if (FLOATP (val
))
1028 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1029 i
= XFLOAT_DATA (val
) * 10;
1030 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1033 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1035 val
= AREF (font
, FONT_EXTRA_INDEX
);
1037 if (FONT_ENTITY_P (font
)
1038 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1040 /* Setup names for RESX-RESY-SPACING-AVWIDTH. */
1041 if (SYMBOLP (val
) && ! NILP (val
))
1043 val
= SYMBOL_NAME (val
);
1044 f
[XLFD_RESX_INDEX
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1047 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 6;
1051 Lisp_Object dpi
= assq_no_quit (QCdpi
, val
);
1052 Lisp_Object spacing
= assq_no_quit (QCspacing
, val
);
1053 Lisp_Object scalable
= assq_no_quit (QCscalable
, val
);
1055 if (CONSP (dpi
) || CONSP (spacing
) || CONSP (scalable
))
1057 char *str
= alloca (24);
1060 if (CONSP (dpi
) && INTEGERP (XCDR (dpi
)))
1061 this_len
= sprintf (str
, "%d-%d",
1062 XINT (XCDR (dpi
)), XINT (XCDR (dpi
)));
1064 this_len
= sprintf (str
, "*-*");
1065 if (CONSP (spacing
) && ! NILP (XCDR (spacing
)))
1067 val
= XCDR (spacing
);
1070 if (XINT (val
) < FONT_SPACING_MONO
)
1072 else if (XINT (val
) < FONT_SPACING_CHARCELL
)
1077 xassert (SYMBOLP (val
));
1078 this_len
+= sprintf (str
+ this_len
, "-%c",
1079 SDATA (SYMBOL_NAME (val
))[0]);
1082 this_len
+= sprintf (str
+ this_len
, "-*");
1083 if (CONSP (scalable
) && ! NILP (XCDR (spacing
)))
1084 this_len
+= sprintf (str
+ this_len
, "-0");
1086 this_len
+= sprintf (str
+ this_len
, "-*");
1087 f
[XLFD_RESX_INDEX
] = str
;
1091 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 8;
1094 len
++; /* for terminating '\0'. */
1097 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1098 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1099 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1100 f
[XLFD_SWIDTH_INDEX
],
1101 f
[XLFD_ADSTYLE_INDEX
], f
[XLFD_PIXEL_INDEX
],
1102 f
[XLFD_RESX_INDEX
], f
[XLFD_REGISTRY_INDEX
]);
1105 /* Parse NAME (null terminated) as Fonconfig's name format and store
1106 information in FONT (font-spec or font-entity). If NAME is
1107 successfully parsed, return 0. Otherwise return -1. */
1110 font_parse_fcname (name
, font
)
1115 int len
= strlen (name
);
1120 /* It is assured that (name[0] && name[0] != '-'). */
1128 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1129 if (*p0
== '\\' && p0
[1])
1131 family
= intern_font_field (name
, p0
- name
);
1134 if (! isdigit (p0
[1]))
1136 point_size
= strtod (p0
+ 1, &p1
);
1137 if (*p1
&& *p1
!= ':')
1139 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1142 ASET (font
, FONT_FAMILY_INDEX
, family
);
1146 copy
= alloca (len
+ 1);
1151 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1152 extra, copy unknown ones to COPY. */
1155 Lisp_Object key
, val
;
1158 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1161 /* Must be an enumerated value. */
1162 val
= intern_font_field (p0
+ 1, p1
- p0
- 1);
1163 if (memcmp (p0
+ 1, "light", 5) == 0
1164 || memcmp (p0
+ 1, "medium", 6) == 0
1165 || memcmp (p0
+ 1, "demibold", 8) == 0
1166 || memcmp (p0
+ 1, "bold", 4) == 0
1167 || memcmp (p0
+ 1, "black", 5) == 0)
1169 ASET (font
, FONT_WEIGHT_INDEX
, val
);
1171 else if (memcmp (p0
+ 1, "roman", 5) == 0
1172 || memcmp (p0
+ 1, "italic", 6) == 0
1173 || memcmp (p0
+ 1, "oblique", 7) == 0)
1175 ASET (font
, FONT_SLANT_INDEX
, val
);
1177 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1178 || memcmp (p0
+ 1, "mono", 4) == 0
1179 || memcmp (p0
+ 1, "proportional", 12) == 0)
1181 font_put_extra (font
, QCspacing
,
1182 (p0
[1] == 'c' ? Qc
: p0
[1] == 'm' ? Qm
: Qp
));
1187 bcopy (p0
, copy
, p1
- p0
);
1193 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1194 prop
= FONT_SIZE_INDEX
;
1197 key
= intern_font_field (p0
, p1
- p0
);
1198 prop
= get_font_prop_index (key
, 0);
1201 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1202 val
= intern_font_field (p0
, p1
- p0
);
1205 if (prop
>= 0 && prop
< FONT_EXTRA_INDEX
)
1207 ASET (font
, prop
, val
);
1210 font_put_extra (font
, key
, val
);
1219 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1220 NAME (NBYTES length), and return the name length. If
1221 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1224 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1232 int dpi
, spacing
, scalable
;
1235 Lisp_Object styles
[3];
1236 char *style_names
[3] = { "weight", "slant", "width" };
1238 val
= AREF (font
, FONT_FAMILY_INDEX
);
1239 if (SYMBOLP (val
) && ! NILP (val
))
1240 len
+= SBYTES (SYMBOL_NAME (val
));
1242 val
= AREF (font
, FONT_SIZE_INDEX
);
1245 if (XINT (val
) != 0)
1246 pixel_size
= XINT (val
);
1248 len
+= 21; /* for ":pixelsize=NUM" */
1250 else if (FLOATP (val
))
1253 point_size
= (int) XFLOAT_DATA (val
);
1254 len
+= 11; /* for "-NUM" */
1257 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1258 if (SYMBOLP (val
) && ! NILP (val
))
1259 /* ":foundry=NAME" */
1260 len
+= 9 + SBYTES (SYMBOL_NAME (val
));
1262 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1264 val
= AREF (font
, i
);
1267 val
= prop_numeric_to_name (i
, XINT (val
));
1268 len
+= (strlen (style_names
[i
- FONT_WEIGHT_INDEX
])
1269 + 2 + SBYTES (SYMBOL_NAME (val
))); /* :xxx=NAME */
1271 styles
[i
- FONT_WEIGHT_INDEX
] = val
;
1274 val
= AREF (font
, FONT_EXTRA_INDEX
);
1275 if (FONT_ENTITY_P (font
)
1276 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1280 /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
1281 p
= (char *) SDATA (SYMBOL_NAME (val
));
1283 for (p
++; *p
!= '-'; p
++); /* skip RESX */
1284 for (p
++; *p
!= '-'; p
++); /* skip RESY */
1285 spacing
= (*p
== 'c' ? FONT_SPACING_CHARCELL
1286 : *p
== 'm' ? FONT_SPACING_MONO
1287 : FONT_SPACING_PROPORTIONAL
);
1288 for (p
++; *p
!= '-'; p
++); /* skip SPACING */
1289 scalable
= (atoi (p
) == 0);
1290 /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
1297 dpi
= spacing
= scalable
= -1;
1298 elt
= assq_no_quit (QCdpi
, val
);
1300 dpi
= XINT (XCDR (elt
)), len
+= 15; /* for ":dpi=NUM" */
1301 elt
= assq_no_quit (QCspacing
, val
);
1303 spacing
= XINT (XCDR (elt
)), len
+= 12; /* for ":spacing=100" */
1304 elt
= assq_no_quit (QCscalable
, val
);
1306 scalable
= ! NILP (XCDR (elt
)), len
+= 15; /* for ":scalable=False" */
1312 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1313 p
+= sprintf(p
, "%s",
1314 SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1318 p
+= sprintf (p
, "%d", point_size
);
1320 p
+= sprintf (p
, "-%d", point_size
);
1322 else if (pixel_size
> 0)
1323 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1324 if (SYMBOLP (AREF (font
, FONT_FOUNDRY_INDEX
))
1325 && ! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1326 p
+= sprintf (p
, ":foundry=%s",
1327 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1328 for (i
= 0; i
< 3; i
++)
1329 if (SYMBOLP (styles
[i
]) && ! NILP (styles
[i
]))
1330 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1331 SDATA (SYMBOL_NAME (styles
[i
])));
1333 p
+= sprintf (p
, ":dpi=%d", dpi
);
1335 p
+= sprintf (p
, ":spacing=%d", spacing
);
1337 p
+= sprintf (p
, ":scalable=True");
1338 else if (scalable
== 0)
1339 p
+= sprintf (p
, ":scalable=False");
1343 /* Parse NAME (null terminated) and store information in FONT
1344 (font-spec or font-entity). If NAME is successfully parsed, return
1345 0. Otherwise return -1.
1347 If NAME is XLFD and FONT is a font-entity, store
1348 RESX-RESY-SPACING-AVWIDTH information as a symbol in
1349 FONT_EXTRA_INDEX. */
1352 font_parse_name (name
, font
)
1356 if (name
[0] == '-' || index (name
, '*'))
1357 return font_parse_xlfd (name
, font
);
1358 return font_parse_fcname (name
, font
);
1362 font_merge_old_spec (name
, family
, registry
, spec
)
1363 Lisp_Object name
, family
, registry
, spec
;
1367 if (font_parse_xlfd ((char *) SDATA (name
), spec
) < 0)
1369 Lisp_Object extra
= Fcons (Fcons (QCname
, name
), Qnil
);
1371 ASET (spec
, FONT_EXTRA_INDEX
, extra
);
1376 if (! NILP (family
))
1381 xassert (STRINGP (family
));
1382 len
= SBYTES (family
);
1383 p0
= (char *) SDATA (family
);
1384 p1
= index (p0
, '-');
1387 if ((*p0
!= '*' || p1
- p0
> 1)
1388 && NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
1389 ASET (spec
, FONT_FOUNDRY_INDEX
,
1390 intern_downcase (p0
, p1
- p0
));
1391 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1392 ASET (spec
, FONT_FAMILY_INDEX
,
1393 intern_downcase (p1
+ 1, len
- (p1
+ 1 - p0
)));
1395 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1396 ASET (spec
, FONT_FAMILY_INDEX
, intern_downcase (p0
, len
));
1398 if (! NILP (registry
)
1399 && NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
1400 ASET (spec
, FONT_REGISTRY_INDEX
,
1401 intern_downcase ((char *) SDATA (registry
), SBYTES (registry
)));
1406 font_lispy_object (font
)
1409 Lisp_Object objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
1411 for (; ! NILP (objlist
); objlist
= XCDR (objlist
))
1413 struct Lisp_Save_Value
*p
= XSAVE_VALUE (XCAR (objlist
));
1415 if (font
== (struct font
*) p
->pointer
)
1418 xassert (! NILP (objlist
));
1419 return XCAR (objlist
);
1422 #define LGSTRING_HEADER_SIZE 6
1423 #define LGSTRING_GLYPH_SIZE 8
1426 check_gstring (gstring
)
1427 Lisp_Object gstring
;
1432 CHECK_VECTOR (gstring
);
1433 val
= AREF (gstring
, 0);
1435 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1437 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1438 if (! NILP (LGSTRING_LBEARING (gstring
)))
1439 CHECK_NUMBER (LGSTRING_LBEARING (gstring
));
1440 if (! NILP (LGSTRING_RBEARING (gstring
)))
1441 CHECK_NUMBER (LGSTRING_RBEARING (gstring
));
1442 if (! NILP (LGSTRING_WIDTH (gstring
)))
1443 CHECK_NATNUM (LGSTRING_WIDTH (gstring
));
1444 if (! NILP (LGSTRING_ASCENT (gstring
)))
1445 CHECK_NUMBER (LGSTRING_ASCENT (gstring
));
1446 if (! NILP (LGSTRING_DESCENT (gstring
)))
1447 CHECK_NUMBER (LGSTRING_DESCENT(gstring
));
1449 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1451 val
= LGSTRING_GLYPH (gstring
, i
);
1453 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1455 if (NILP (LGLYPH_CHAR (val
)))
1457 CHECK_NATNUM (LGLYPH_FROM (val
));
1458 CHECK_NATNUM (LGLYPH_TO (val
));
1459 CHECK_CHARACTER (LGLYPH_CHAR (val
));
1460 if (! NILP (LGLYPH_CODE (val
)))
1461 CHECK_NATNUM (LGLYPH_CODE (val
));
1462 if (! NILP (LGLYPH_WIDTH (val
)))
1463 CHECK_NATNUM (LGLYPH_WIDTH (val
));
1464 if (! NILP (LGLYPH_ADJUSTMENT (val
)))
1466 val
= LGLYPH_ADJUSTMENT (val
);
1468 if (ASIZE (val
) < 3)
1470 for (j
= 0; j
< 3; j
++)
1471 CHECK_NUMBER (AREF (val
, j
));
1476 error ("Invalid glyph-string format");
1490 struct otf_list
*next
;
1493 static struct otf_list
*otf_list
;
1496 otf_tag_symbol (tag
)
1501 OTF_tag_name (tag
, name
);
1502 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1506 otf_open (entity
, file
)
1510 struct otf_list
*list
= otf_list
;
1512 while (list
&& ! EQ (list
->entity
, entity
))
1516 list
= malloc (sizeof (struct otf_list
));
1517 list
->entity
= entity
;
1518 list
->otf
= file
? OTF_open (file
) : NULL
;
1519 list
->next
= otf_list
;
1526 /* Return a list describing which scripts/languages FONT supports by
1527 which GSUB/GPOS features of OpenType tables. See the comment of
1528 (sturct font_driver).otf_capability. */
1531 font_otf_capability (font
)
1535 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1538 otf
= otf_open (font
->entity
, font
->file_name
);
1541 for (i
= 0; i
< 2; i
++)
1543 OTF_GSUB_GPOS
*gsub_gpos
;
1544 Lisp_Object script_list
= Qnil
;
1547 if (OTF_get_features (otf
, i
== 0) < 0)
1549 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1550 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1552 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1553 Lisp_Object langsys_list
= Qnil
;
1554 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1557 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1559 OTF_LangSys
*langsys
;
1560 Lisp_Object feature_list
= Qnil
;
1561 Lisp_Object langsys_tag
;
1564 if (k
== script
->LangSysCount
)
1566 langsys
= &script
->DefaultLangSys
;
1571 langsys
= script
->LangSys
+ k
;
1573 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1575 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1577 OTF_Feature
*feature
1578 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1579 Lisp_Object feature_tag
1580 = otf_tag_symbol (feature
->FeatureTag
);
1582 feature_list
= Fcons (feature_tag
, feature_list
);
1584 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1587 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1592 XSETCAR (capability
, script_list
);
1594 XSETCDR (capability
, script_list
);
1601 parse_gsub_gpos_spec (spec
, script
, langsys
, features
, nbytes
)
1603 char **script
, **langsys
, *features
;
1613 *script
= (char *) SDATA (SYMBOL_NAME (val
));
1618 *langsys
= NILP (val
) ? NULL
: (char *) SDATA (SYMBOL_NAME (val
));
1621 p
= features
, pend
= p
+ nbytes
- 1;
1623 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1633 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1640 else if (! asterisk
)
1642 val
= SYMBOL_NAME (val
);
1643 if (p
+ SBYTES (val
) >= pend
)
1645 p
+= sprintf (p
, "%s", SDATA (val
));
1649 val
= SYMBOL_NAME (val
);
1650 if (p
+ 1 + SBYTES (val
)>= pend
)
1652 p
+= sprintf (p
, "~%s", SDATA (val
));
1656 error ("OTF spec too long");
1659 #define DEVICE_DELTA(table, size) \
1660 (((size) >= (table).StartSize && (size) <= (table).EndSize) \
1661 ? (table).DeltaValue[(size) - (table).StartSize] \
1665 adjust_anchor (struct font
*font
, OTF_Anchor
*anchor
,
1666 unsigned code
, int size
, int *x
, int *y
)
1668 if (anchor
->AnchorFormat
== 2)
1672 if (font
->driver
->anchor_point (font
, code
, anchor
->f
.f1
.AnchorPoint
,
1676 else if (anchor
->AnchorFormat
== 3)
1678 if (anchor
->f
.f2
.XDeviceTable
.offset
)
1679 *x
+= DEVICE_DELTA (anchor
->f
.f2
.XDeviceTable
, size
);
1680 if (anchor
->f
.f2
.YDeviceTable
.offset
)
1681 *y
+= DEVICE_DELTA (anchor
->f
.f2
.YDeviceTable
, size
);
1685 #define REPLACEMENT_CHARACTER 0xFFFD
1687 /* Drive FONT's OTF GSUB features according to GSUB_SPEC. See the
1688 comment of (sturct font_driver).otf_gsub. */
1691 font_otf_gsub (font
, gsub_spec
, gstring_in
, from
, to
, gstring_out
, idx
,
1694 Lisp_Object gsub_spec
;
1695 Lisp_Object gstring_in
;
1697 Lisp_Object gstring_out
;
1698 int idx
, alternate_subst
;
1703 OTF_GlyphString otf_gstring
;
1705 char *script
, *langsys
, features
[256];
1708 parse_gsub_gpos_spec (gsub_spec
, &script
, &langsys
, features
, 256);
1710 otf
= otf_open (font
->entity
, font
->file_name
);
1713 if (OTF_get_table (otf
, "head") < 0)
1715 if (OTF_get_table (otf
, "cmap") < 0)
1717 if (OTF_check_table (otf
, "GSUB") < 0)
1720 otf_gstring
.size
= otf_gstring
.used
= len
;
1721 otf_gstring
.glyphs
= (OTF_Glyph
*) malloc (sizeof (OTF_Glyph
) * len
);
1722 memset (otf_gstring
.glyphs
, 0, sizeof (OTF_Glyph
) * len
);
1723 for (i
= 0, need_cmap
= 0; i
< len
; i
++)
1725 Lisp_Object g
= LGSTRING_GLYPH (gstring_in
, from
+ i
);
1727 otf_gstring
.glyphs
[i
].c
= XINT (LGLYPH_CHAR (g
));
1728 if (otf_gstring
.glyphs
[i
].c
== REPLACEMENT_CHARACTER
)
1729 otf_gstring
.glyphs
[i
].c
= 0;
1730 if (NILP (LGLYPH_CODE (g
)))
1732 otf_gstring
.glyphs
[i
].glyph_id
= 0;
1736 otf_gstring
.glyphs
[i
].glyph_id
= XINT (LGLYPH_CODE (g
));
1740 OTF_drive_cmap (otf
, &otf_gstring
);
1741 OTF_drive_gdef (otf
, &otf_gstring
);
1742 if ((alternate_subst
1743 ? OTF_drive_gsub_alternate (otf
, &otf_gstring
, script
, langsys
, features
)
1744 : OTF_drive_gsub (otf
, &otf_gstring
, script
, langsys
, features
)) < 0)
1746 free (otf_gstring
.glyphs
);
1749 if (ASIZE (gstring_out
) < idx
+ otf_gstring
.used
)
1751 free (otf_gstring
.glyphs
);
1755 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
;)
1757 int i0
= g
->f
.index
.from
, i1
= g
->f
.index
.to
;
1758 Lisp_Object glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1759 Lisp_Object min_idx
= AREF (glyph
, 0);
1760 Lisp_Object max_idx
= AREF (glyph
, 1);
1764 int min_idx_i
= XINT (min_idx
), max_idx_i
= XINT (max_idx
);
1766 for (i0
++; i0
<= i1
; i0
++)
1768 glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1769 if (min_idx_i
> XINT (AREF (glyph
, 0)))
1770 min_idx_i
= XINT (AREF (glyph
, 0));
1771 if (max_idx_i
< XINT (AREF (glyph
, 1)))
1772 max_idx_i
= XINT (AREF (glyph
, 1));
1774 min_idx
= make_number (min_idx_i
);
1775 max_idx
= make_number (max_idx_i
);
1776 i0
= g
->f
.index
.from
;
1778 for (; i
< otf_gstring
.used
&& g
->f
.index
.from
== i0
; i
++, g
++)
1780 glyph
= LGSTRING_GLYPH (gstring_out
, idx
+ i
);
1781 ASET (glyph
, 0, min_idx
);
1782 ASET (glyph
, 1, max_idx
);
1784 LGLYPH_SET_CHAR (glyph
, make_number (g
->c
));
1786 LGLYPH_SET_CHAR (glyph
, make_number (REPLACEMENT_CHARACTER
));
1787 LGLYPH_SET_CODE (glyph
, make_number (g
->glyph_id
));
1791 free (otf_gstring
.glyphs
);
1795 /* Drive FONT's OTF GPOS features according to GPOS_SPEC. See the
1796 comment of (sturct font_driver).otf_gpos. */
1799 font_otf_gpos (font
, gpos_spec
, gstring
, from
, to
)
1801 Lisp_Object gpos_spec
;
1802 Lisp_Object gstring
;
1808 OTF_GlyphString otf_gstring
;
1810 char *script
, *langsys
, features
[256];
1814 Lisp_Object base
, mark
;
1816 parse_gsub_gpos_spec (gpos_spec
, &script
, &langsys
, features
, 256);
1818 otf
= otf_open (font
->entity
, font
->file_name
);
1821 if (OTF_get_table (otf
, "head") < 0)
1823 if (OTF_get_table (otf
, "cmap") < 0)
1825 if (OTF_check_table (otf
, "GPOS") < 0)
1828 otf_gstring
.size
= otf_gstring
.used
= len
;
1829 otf_gstring
.glyphs
= (OTF_Glyph
*) malloc (sizeof (OTF_Glyph
) * len
);
1830 memset (otf_gstring
.glyphs
, 0, sizeof (OTF_Glyph
) * len
);
1831 for (i
= 0, need_cmap
= 0; i
< len
; i
++)
1833 glyph
= LGSTRING_GLYPH (gstring
, from
+ i
);
1834 otf_gstring
.glyphs
[i
].c
= XINT (LGLYPH_CHAR (glyph
));
1835 if (otf_gstring
.glyphs
[i
].c
== REPLACEMENT_CHARACTER
)
1836 otf_gstring
.glyphs
[i
].c
= 0;
1837 if (NILP (LGLYPH_CODE (glyph
)))
1839 otf_gstring
.glyphs
[i
].glyph_id
= 0;
1843 otf_gstring
.glyphs
[i
].glyph_id
= XINT (LGLYPH_CODE (glyph
));
1846 OTF_drive_cmap (otf
, &otf_gstring
);
1847 OTF_drive_gdef (otf
, &otf_gstring
);
1849 if (OTF_drive_gpos (otf
, &otf_gstring
, script
, langsys
, features
) < 0)
1851 free (otf_gstring
.glyphs
);
1855 u
= otf
->head
->unitsPerEm
;
1856 size
= font
->pixel_size
;
1858 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
; i
++, g
++)
1861 int xoff
= 0, yoff
= 0, width_adjust
= 0;
1866 glyph
= LGSTRING_GLYPH (gstring
, from
+ i
);
1867 switch (g
->positioning_type
)
1873 int format
= g
->f
.f1
.format
;
1875 if (format
& OTF_XPlacement
)
1876 xoff
= g
->f
.f1
.value
->XPlacement
* size
/ u
;
1877 if (format
& OTF_XPlaDevice
)
1878 xoff
+= DEVICE_DELTA (g
->f
.f1
.value
->XPlaDevice
, size
);
1879 if (format
& OTF_YPlacement
)
1880 yoff
= - (g
->f
.f1
.value
->YPlacement
* size
/ u
);
1881 if (format
& OTF_YPlaDevice
)
1882 yoff
-= DEVICE_DELTA (g
->f
.f1
.value
->YPlaDevice
, size
);
1883 if (format
& OTF_XAdvance
)
1884 width_adjust
+= g
->f
.f1
.value
->XAdvance
* size
/ u
;
1885 if (format
& OTF_XAdvDevice
)
1886 width_adjust
+= DEVICE_DELTA (g
->f
.f1
.value
->XAdvDevice
, size
);
1890 /* Not yet supported. */
1896 goto label_adjust_anchor
;
1897 default: /* i.e. case 6 */
1902 label_adjust_anchor
:
1904 int base_x
, base_y
, mark_x
, mark_y
, width
;
1907 base_x
= g
->f
.f4
.base_anchor
->XCoordinate
* size
/ u
;
1908 base_y
= g
->f
.f4
.base_anchor
->YCoordinate
* size
/ u
;
1909 mark_x
= g
->f
.f4
.mark_anchor
->XCoordinate
* size
/ u
;
1910 mark_y
= g
->f
.f4
.mark_anchor
->YCoordinate
* size
/ u
;
1912 code
= XINT (LGLYPH_CODE (prev
));
1913 if (g
->f
.f4
.base_anchor
->AnchorFormat
!= 1)
1914 adjust_anchor (font
, g
->f
.f4
.base_anchor
,
1915 code
, size
, &base_x
, &base_y
);
1916 if (g
->f
.f4
.mark_anchor
->AnchorFormat
!= 1)
1917 adjust_anchor (font
, g
->f
.f4
.mark_anchor
,
1918 code
, size
, &mark_x
, &mark_y
);
1920 if (NILP (LGLYPH_WIDTH (prev
)))
1922 width
= font
->driver
->text_extents (font
, &code
, 1, NULL
);
1923 LGLYPH_SET_WIDTH (prev
, make_number (width
));
1926 width
= XINT (LGLYPH_WIDTH (prev
));
1927 xoff
= XINT (LGLYPH_XOFF (prev
)) + (base_x
- width
) - mark_x
;
1928 yoff
= XINT (LGLYPH_YOFF (prev
)) + mark_y
- base_y
;
1932 if (xoff
|| yoff
|| width_adjust
)
1934 Lisp_Object adjustment
= Fmake_vector (make_number (3), Qnil
);
1936 ASET (adjustment
, 0, make_number (xoff
));
1937 ASET (adjustment
, 1, make_number (yoff
));
1938 ASET (adjustment
, 2, make_number (width_adjust
));
1939 LGLYPH_SET_ADJUSTMENT (glyph
, adjustment
);
1942 if (g
->GlyphClass
== OTF_GlyphClass0
)
1943 base
= mark
= glyph
;
1944 else if (g
->GlyphClass
== OTF_GlyphClassMark
)
1950 free (otf_gstring
.glyphs
);
1954 #endif /* HAVE_LIBOTF */
1957 /* G-string (glyph string) handler */
1959 /* G-string is a vector of the form [HEADER GLYPH ...].
1960 See the docstring of `font-make-gstring' for more detail. */
1963 font_prepare_composition (cmp
)
1964 struct composition
*cmp
;
1967 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1968 cmp
->hash_index
* 2);
1969 struct font
*font
= XSAVE_VALUE (LGSTRING_FONT (gstring
))->pointer
;
1970 int len
= LGSTRING_LENGTH (gstring
);
1974 cmp
->lbearing
= cmp
->rbearing
= cmp
->pixel_width
= 0;
1975 cmp
->ascent
= font
->ascent
;
1976 cmp
->descent
= font
->descent
;
1978 for (i
= 0; i
< len
; i
++)
1980 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
1982 struct font_metrics metrics
;
1984 if (NILP (LGLYPH_FROM (g
)))
1986 code
= XINT (LGLYPH_CODE (g
));
1987 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
1988 LGLYPH_SET_WIDTH (g
, make_number (metrics
.width
));
1989 metrics
.lbearing
+= LGLYPH_XOFF (g
);
1990 metrics
.rbearing
+= LGLYPH_XOFF (g
);
1991 metrics
.ascent
+= LGLYPH_YOFF (g
);
1992 metrics
.descent
+= LGLYPH_YOFF (g
);
1994 if (cmp
->lbearing
> cmp
->pixel_width
+ metrics
.lbearing
)
1995 cmp
->lbearing
= cmp
->pixel_width
+ metrics
.lbearing
;
1996 if (cmp
->rbearing
< cmp
->pixel_width
+ metrics
.rbearing
)
1997 cmp
->rbearing
= cmp
->pixel_width
+ metrics
.rbearing
;
1998 if (cmp
->ascent
< metrics
.ascent
)
1999 cmp
->ascent
= metrics
.ascent
;
2000 if (cmp
->descent
< metrics
.descent
)
2001 cmp
->descent
= metrics
.descent
;
2002 cmp
->pixel_width
+= metrics
.width
+ LGLYPH_WADJUST (g
);
2005 LGSTRING_SET_LBEARING (gstring
, make_number (cmp
->lbearing
));
2006 LGSTRING_SET_RBEARING (gstring
, make_number (cmp
->rbearing
));
2007 LGSTRING_SET_WIDTH (gstring
, make_number (cmp
->pixel_width
));
2008 LGSTRING_SET_ASCENT (gstring
, make_number (cmp
->ascent
));
2009 LGSTRING_SET_DESCENT (gstring
, make_number (cmp
->descent
));
2015 font_gstring_produce (old
, from
, to
, new, idx
, code
, n
)
2023 Lisp_Object min_idx
, max_idx
;
2026 if (idx
+ n
> ASIZE (new))
2032 min_idx
= make_number (0);
2033 max_idx
= make_number (1);
2037 min_idx
= AREF (AREF (old
, from
- 1), 0);
2038 max_idx
= AREF (AREF (old
, from
- 1), 1);
2041 else if (from
+ 1 == to
)
2043 min_idx
= AREF (AREF (old
, from
), 0);
2044 max_idx
= AREF (AREF (old
, from
), 1);
2048 int min_idx_i
= XINT (AREF (AREF (old
, from
), 0));
2049 int max_idx_i
= XINT (AREF (AREF (old
, from
), 1));
2051 for (i
= from
+ 1; i
< to
; i
++)
2053 if (min_idx_i
> XINT (AREF (AREF (old
, i
), 0)))
2054 min_idx_i
= XINT (AREF (AREF (old
, i
), 0));
2055 if (max_idx_i
< XINT (AREF (AREF (old
, i
), 1)))
2056 max_idx_i
= XINT (AREF (AREF (old
, i
), 1));
2058 min_idx
= make_number (min_idx_i
);
2059 max_idx
= make_number (max_idx_i
);
2062 for (i
= 0; i
< n
; i
++)
2064 ASET (AREF (new, idx
+ i
), 0, min_idx
);
2065 ASET (AREF (new, idx
+ i
), 1, max_idx
);
2066 ASET (AREF (new, idx
+ i
), 2, make_number (code
[i
]));
2074 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2075 static int font_compare
P_ ((const void *, const void *));
2076 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2077 Lisp_Object
, Lisp_Object
));
2079 /* We sort fonts by scoring each of them against a specified
2080 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2081 the value is, the closer the font is to the font-spec.
2083 Each 1-bit in the highest 4 bits of the score is used for atomic
2084 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
2086 Each 7-bit in the lowest 28 bits are used for numeric properties
2087 WEIGHT, SLANT, WIDTH, and SIZE. */
2089 /* How many bits to shift to store the difference value of each font
2090 property in a score. */
2091 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2093 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2094 The return value indicates how different ENTITY is compared with
2098 font_score (entity
, spec_prop
)
2099 Lisp_Object entity
, *spec_prop
;
2103 /* Score four atomic fields. Maximum difference is 1. */
2104 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2105 if (! NILP (spec_prop
[i
])
2106 && ! EQ (spec_prop
[i
], AREF (entity
, i
)))
2107 score
|= 1 << sort_shift_bits
[i
];
2109 /* Score four numeric fields. Maximum difference is 127. */
2110 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2112 Lisp_Object entity_val
= AREF (entity
, i
);
2114 if (! NILP (spec_prop
[i
]) && ! EQ (spec_prop
[i
], entity_val
))
2116 if (! INTEGERP (entity_val
))
2117 score
|= 127 << sort_shift_bits
[i
];
2120 int diff
= XINT (entity_val
) - XINT (spec_prop
[i
]);
2124 if (i
== FONT_SIZE_INDEX
)
2126 if (XINT (entity_val
) > 0
2127 && diff
> FONT_PIXEL_SIZE_QUANTUM
)
2128 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2131 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2140 /* The comparison function for qsort. */
2143 font_compare (d1
, d2
)
2144 const void *d1
, *d2
;
2146 return (*(unsigned *) d1
< *(unsigned *) d2
2147 ? -1 : *(unsigned *) d1
> *(unsigned *) d2
);
2151 /* The structure for elements being sorted by qsort. */
2152 struct font_sort_data
2159 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2160 If PREFER specifies a point-size, calculate the corresponding
2161 pixel-size from QCdpi property of PREFER or from the Y-resolution
2162 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2163 get the font-entities in VEC. */
2166 font_sort_entites (vec
, prefer
, frame
, spec
)
2167 Lisp_Object vec
, prefer
, frame
, spec
;
2169 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2171 struct font_sort_data
*data
;
2178 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2179 prefer_prop
[i
] = AREF (prefer
, i
);
2183 /* As it is assured that all fonts in VEC match with SPEC, we
2184 should ignore properties specified in SPEC. So, set the
2185 corresponding properties in PREFER_PROP to nil. */
2186 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2187 if (! NILP (AREF (spec
, i
)))
2188 prefer_prop
[i
++] = Qnil
;
2191 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2192 prefer_prop
[FONT_SIZE_INDEX
]
2193 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2195 /* Scoring and sorting. */
2196 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2197 for (i
= 0; i
< len
; i
++)
2199 data
[i
].entity
= AREF (vec
, i
);
2200 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
);
2202 qsort (data
, len
, sizeof *data
, font_compare
);
2203 for (i
= 0; i
< len
; i
++)
2204 ASET (vec
, i
, data
[i
].entity
);
2211 /* API of Font Service Layer. */
2214 font_update_sort_order (order
)
2217 int i
, shift_bits
= 21;
2219 for (i
= 0; i
< 4; i
++, shift_bits
-= 7)
2221 int xlfd_idx
= order
[i
];
2223 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2224 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2225 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2226 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2227 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2228 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2230 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2235 font_symbolic_weight (font
)
2238 Lisp_Object weight
= AREF (font
, FONT_WEIGHT_INDEX
);
2240 if (INTEGERP (weight
))
2241 weight
= prop_numeric_to_name (FONT_WEIGHT_INDEX
, XINT (weight
));
2246 font_symbolic_slant (font
)
2249 Lisp_Object slant
= AREF (font
, FONT_SLANT_INDEX
);
2251 if (INTEGERP (slant
))
2252 slant
= prop_numeric_to_name (FONT_SLANT_INDEX
, XINT (slant
));
2257 font_symbolic_width (font
)
2260 Lisp_Object width
= AREF (font
, FONT_WIDTH_INDEX
);
2262 if (INTEGERP (width
))
2263 width
= prop_numeric_to_name (FONT_WIDTH_INDEX
, XINT (width
));
2268 font_match_p (spec
, entity
)
2269 Lisp_Object spec
, entity
;
2273 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2274 if (! NILP (AREF (spec
, i
))
2275 && ! EQ (AREF (spec
, i
), AREF (entity
, i
)))
2277 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
))
2278 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0
2279 && (XINT (AREF (spec
, FONT_SIZE_INDEX
))
2280 != XINT (AREF (entity
, FONT_SIZE_INDEX
))))
2286 font_find_object (font
)
2289 Lisp_Object tail
, elt
;
2291 for (tail
= AREF (font
->entity
, FONT_OBJLIST_INDEX
); CONSP (tail
);
2295 if (font
== XSAVE_VALUE (elt
)->pointer
2296 && XSAVE_VALUE (elt
)->integer
> 0)
2303 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2305 /* Return a vector of font-entities matching with SPEC on frame F. */
2308 font_list_entities (frame
, spec
)
2309 Lisp_Object frame
, spec
;
2311 FRAME_PTR f
= XFRAME (frame
);
2312 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2313 Lisp_Object ftype
, family
, size
, alternate_familes
;
2314 Lisp_Object
*vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2320 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2322 alternate_familes
= Qnil
;
2325 if (NILP (font_family_alist
)
2326 && !NILP (Vface_alternative_font_family_alist
))
2327 build_font_family_alist ();
2328 alternate_familes
= assq_no_quit (family
, font_family_alist
);
2329 if (! NILP (alternate_familes
))
2330 alternate_familes
= XCDR (alternate_familes
);
2332 size
= AREF (spec
, FONT_SIZE_INDEX
);
2334 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2336 xassert (ASIZE (spec
) == FONT_SPEC_MAX
);
2337 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2339 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2341 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2343 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2344 Lisp_Object tail
= alternate_familes
;
2347 xassert (CONSP (cache
));
2348 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2349 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2353 val
= assoc_no_quit (spec
, XCDR (cache
));
2358 val
= driver_list
->driver
->list (frame
, spec
);
2360 XSETCDR (cache
, Fcons (Fcons (Fcopy_sequence (spec
), val
),
2363 if (VECTORP (val
) && ASIZE (val
) > 0)
2370 ASET (spec
, FONT_FAMILY_INDEX
, XCAR (tail
));
2374 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2375 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2376 ASET (spec
, FONT_SIZE_INDEX
, size
);
2377 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2381 font_matching_entity (frame
, spec
)
2382 Lisp_Object frame
, spec
;
2384 FRAME_PTR f
= XFRAME (frame
);
2385 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2386 Lisp_Object ftype
, size
, entity
;
2388 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2389 size
= AREF (spec
, FONT_SIZE_INDEX
);
2391 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2393 for (; driver_list
; driver_list
= driver_list
->next
)
2395 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2397 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2400 xassert (CONSP (cache
));
2401 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2402 key
= Fcons (spec
, Qnil
);
2403 entity
= assoc_no_quit (key
, XCDR (cache
));
2405 entity
= XCDR (entity
);
2408 entity
= driver_list
->driver
->match (frame
, spec
);
2409 if (! NILP (entity
))
2411 XSETCAR (key
, Fcopy_sequence (spec
));
2412 XSETCDR (cache
, Fcons (Fcons (key
, entity
), XCDR (cache
)));
2415 if (! NILP (entity
))
2418 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2419 ASET (spec
, FONT_SIZE_INDEX
, size
);
2423 static int num_fonts
;
2426 font_open_entity (f
, entity
, pixel_size
)
2431 struct font_driver_list
*driver_list
;
2432 Lisp_Object objlist
, size
, val
;
2435 size
= AREF (entity
, FONT_SIZE_INDEX
);
2436 xassert (NATNUMP (size
));
2437 if (XINT (size
) != 0)
2438 pixel_size
= XINT (size
);
2440 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2441 objlist
= XCDR (objlist
))
2443 font
= XSAVE_VALUE (XCAR (objlist
))->pointer
;
2444 if (font
->pixel_size
== pixel_size
)
2446 XSAVE_VALUE (XCAR (objlist
))->integer
++;
2447 return XCAR (objlist
);
2451 xassert (FONT_ENTITY_P (entity
));
2452 val
= AREF (entity
, FONT_TYPE_INDEX
);
2453 for (driver_list
= f
->font_driver_list
;
2454 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2455 driver_list
= driver_list
->next
);
2459 font
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2462 font
->scalable
= XINT (size
) == 0;
2464 val
= make_save_value (font
, 1);
2465 ASET (entity
, FONT_OBJLIST_INDEX
,
2466 Fcons (val
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2472 font_close_object (f
, font_object
)
2474 Lisp_Object font_object
;
2476 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2477 Lisp_Object objlist
;
2478 Lisp_Object tail
, prev
= Qnil
;
2480 XSAVE_VALUE (font_object
)->integer
--;
2481 xassert (XSAVE_VALUE (font_object
)->integer
>= 0);
2482 if (XSAVE_VALUE (font_object
)->integer
> 0)
2485 objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
2486 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2487 prev
= tail
, tail
= XCDR (tail
))
2488 if (EQ (font_object
, XCAR (tail
)))
2490 if (font
->driver
->close
)
2491 font
->driver
->close (f
, font
);
2492 XSAVE_VALUE (font_object
)->pointer
= NULL
;
2494 ASET (font
->entity
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2496 XSETCDR (prev
, XCDR (objlist
));
2503 font_has_char (f
, font
, c
)
2510 if (FONT_ENTITY_P (font
))
2512 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2513 struct font_driver_list
*driver_list
;
2515 for (driver_list
= f
->font_driver_list
;
2516 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2517 driver_list
= driver_list
->next
);
2520 if (! driver_list
->driver
->has_char
)
2522 return driver_list
->driver
->has_char (font
, c
);
2525 xassert (FONT_OBJECT_P (font
));
2526 fontp
= XSAVE_VALUE (font
)->pointer
;
2528 if (fontp
->driver
->has_char
)
2530 int result
= fontp
->driver
->has_char (fontp
->entity
, c
);
2535 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2539 font_encode_char (font_object
, c
)
2540 Lisp_Object font_object
;
2543 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2545 return font
->driver
->encode_char (font
, c
);
2549 font_get_name (font_object
)
2550 Lisp_Object font_object
;
2552 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2553 char *name
= (font
->font
.full_name
? font
->font
.full_name
2554 : font
->font
.name
? font
->font
.name
2557 return (name
? make_unibyte_string (name
, strlen (name
)) : null_string
);
2561 font_get_spec (font_object
)
2562 Lisp_Object font_object
;
2564 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2565 Lisp_Object spec
= Ffont_spec (0, NULL
);
2568 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2569 ASET (spec
, i
, AREF (font
->entity
, i
));
2570 ASET (spec
, FONT_SIZE_INDEX
, make_number (font
->pixel_size
));
2575 font_get_frame (font
)
2578 if (FONT_OBJECT_P (font
))
2579 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
2580 xassert (FONT_ENTITY_P (font
));
2581 return AREF (font
, FONT_FRAME_INDEX
);
2584 /* Find a font entity best matching with LFACE. If SPEC is non-nil,
2585 the font must exactly match with it. */
2588 font_find_for_lface (f
, lface
, spec
)
2593 Lisp_Object frame
, entities
;
2596 XSETFRAME (frame
, f
);
2600 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2601 ASET (scratch_font_spec
, i
, Qnil
);
2602 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2604 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2605 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
,
2607 entities
= font_list_entities (frame
, scratch_font_spec
);
2608 while (ASIZE (entities
) == 0)
2610 /* Try without FOUNDRY or FAMILY. */
2611 if (! NILP (AREF (scratch_font_spec
, FONT_FOUNDRY_INDEX
)))
2613 ASET (scratch_font_spec
, FONT_FOUNDRY_INDEX
, Qnil
);
2614 entities
= font_list_entities (frame
, scratch_font_spec
);
2616 else if (! NILP (AREF (scratch_font_spec
, FONT_FAMILY_INDEX
)))
2618 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, Qnil
);
2619 entities
= font_list_entities (frame
, scratch_font_spec
);
2627 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2628 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2629 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2630 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2631 entities
= font_list_entities (frame
, scratch_font_spec
);
2634 if (ASIZE (entities
) == 0)
2636 if (ASIZE (entities
) > 1)
2638 /* Sort fonts by properties specified in LFACE. */
2639 Lisp_Object prefer
= scratch_font_prefer
;
2642 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2643 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2644 ASET (prefer
, FONT_WEIGHT_INDEX
,
2645 font_prop_validate_style (FONT_WEIGHT_INDEX
, QCweight
,
2646 lface
[LFACE_WEIGHT_INDEX
]));
2647 ASET (prefer
, FONT_SLANT_INDEX
,
2648 font_prop_validate_style (FONT_SLANT_INDEX
, QCslant
,
2649 lface
[LFACE_SLANT_INDEX
]));
2650 ASET (prefer
, FONT_WIDTH_INDEX
,
2651 font_prop_validate_style (FONT_WIDTH_INDEX
, QCwidth
,
2652 lface
[LFACE_SWIDTH_INDEX
]));
2653 pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2654 ASET (prefer
, FONT_SIZE_INDEX
, make_float (pt
/ 10));
2656 font_sort_entites (entities
, prefer
, frame
, spec
);
2659 return AREF (entities
, 0);
2663 font_open_for_lface (f
, lface
, entity
)
2668 double pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2672 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2673 return font_open_entity (f
, entity
, size
);
2677 font_load_for_face (f
, face
)
2681 Lisp_Object font_object
= face
->lface
[LFACE_FONT_INDEX
];
2683 if (NILP (font_object
))
2685 Lisp_Object entity
= font_find_for_lface (f
, face
->lface
, Qnil
);
2687 if (! NILP (entity
))
2688 font_object
= font_open_for_lface (f
, face
->lface
, entity
);
2691 if (! NILP (font_object
))
2693 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2695 face
->font
= font
->font
.font
;
2696 face
->font_info
= (struct font_info
*) font
;
2697 face
->font_info_id
= 0;
2698 face
->font_name
= font
->font
.full_name
;
2703 face
->font_info
= NULL
;
2704 face
->font_info_id
= -1;
2705 face
->font_name
= NULL
;
2706 add_to_log ("Unable to load font for a face%s", null_string
, Qnil
);
2711 font_prepare_for_face (f
, face
)
2715 struct font
*font
= (struct font
*) face
->font_info
;
2717 if (font
->driver
->prepare_face
)
2718 font
->driver
->prepare_face (f
, face
);
2722 font_done_for_face (f
, face
)
2726 struct font
*font
= (struct font
*) face
->font_info
;
2728 if (font
->driver
->done_face
)
2729 font
->driver
->done_face (f
, face
);
2734 font_open_by_name (f
, name
)
2738 Lisp_Object args
[2];
2739 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2744 XSETFRAME (frame
, f
);
2747 args
[1] = make_unibyte_string (name
, strlen (name
));
2748 spec
= Ffont_spec (2, args
);
2749 prefer
= scratch_font_prefer
;
2750 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2751 if (NILP (AREF (spec
, i
)))
2752 ASET (prefer
, i
, make_number (100));
2753 size
= AREF (spec
, FONT_SIZE_INDEX
);
2756 else if (INTEGERP (size
))
2757 pixel_size
= XINT (size
);
2758 else /* FLOATP (size) */
2760 double pt
= XFLOAT_DATA (size
);
2762 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2763 size
= make_number (pixel_size
);
2764 ASET (spec
, FONT_SIZE_INDEX
, size
);
2766 if (pixel_size
== 0)
2768 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2769 size
= make_number (pixel_size
);
2771 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2772 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2773 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2775 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2776 if (NILP (entity_list
))
2777 entity
= font_matching_entity (frame
, spec
);
2779 entity
= XCAR (entity_list
);
2780 return (NILP (entity
)
2782 : font_open_entity (f
, entity
, pixel_size
));
2786 /* Register font-driver DRIVER. This function is used in two ways.
2788 The first is with frame F non-NULL. In this case, make DRIVER
2789 available (but not yet activated) on F. All frame creaters
2790 (e.g. Fx_create_frame) must call this function at least once with
2791 an available font-driver.
2793 The second is with frame F NULL. In this case, DRIVER is globally
2794 registered in the variable `font_driver_list'. All font-driver
2795 implementations must call this function in its syms_of_XXXX
2796 (e.g. syms_of_xfont). */
2799 register_font_driver (driver
, f
)
2800 struct font_driver
*driver
;
2803 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
2804 struct font_driver_list
*prev
, *list
;
2806 if (f
&& ! driver
->draw
)
2807 error ("Unsable font driver for a frame: %s",
2808 SDATA (SYMBOL_NAME (driver
->type
)));
2810 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
2811 if (list
->driver
->type
== driver
->type
)
2812 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
2814 list
= malloc (sizeof (struct font_driver_list
));
2816 list
->driver
= driver
;
2821 f
->font_driver_list
= list
;
2823 font_driver_list
= list
;
2827 /* Free font-driver list on frame F. It doesn't free font-drivers
2831 free_font_driver_list (f
)
2834 while (f
->font_driver_list
)
2836 struct font_driver_list
*next
= f
->font_driver_list
->next
;
2838 free (f
->font_driver_list
);
2839 f
->font_driver_list
= next
;
2843 /* Make the frame F use font backends listed in NEW_BACKENDS (list of
2844 symbols). If NEW_BACKENDS is nil, make F use all available font
2845 drivers. If no backend is available, dont't alter
2846 f->font_driver_list.
2848 A caller must free all realized faces and clear all font caches if
2849 any in advance. The return value is a list of font backends
2850 actually made used for on F. */
2853 font_update_drivers (f
, new_drivers
)
2855 Lisp_Object new_drivers
;
2857 Lisp_Object active_drivers
= Qnil
;
2858 struct font_driver_list
*list
;
2860 /* At first check which font backends are available. */
2861 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2862 if (NILP (new_drivers
)
2863 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
2866 active_drivers
= nconc2 (active_drivers
,
2867 Fcons (list
->driver
->type
, Qnil
));
2869 /* If at least one backend is available, update all list->on. */
2870 if (! NILP (active_drivers
))
2871 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2872 list
->on
= (list
->on
== 2);
2874 return active_drivers
;
2879 font_at (c
, pos
, face
, w
, object
)
2890 f
= XFRAME (w
->frame
);
2893 if (STRINGP (object
))
2894 face_id
= face_at_string_position (w
, object
, pos
, 0, -1, -1, &dummy
,
2895 DEFAULT_FACE_ID
, 0);
2897 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
,
2899 face
= FACE_FROM_ID (f
, face_id
);
2901 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, object
);
2902 face
= FACE_FROM_ID (f
, face_id
);
2903 if (! face
->font_info
)
2905 return font_lispy_object ((struct font
*) face
->font_info
);
2911 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 1, 0,
2912 doc
: /* Return t if object is a font-spec or font-entity. */)
2916 return (FONTP (object
) ? Qt
: Qnil
);
2919 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
2920 doc
: /* Return a newly created font-spec with specified arguments as properties.
2921 usage: (font-spec &rest properties) */)
2926 Lisp_Object spec
= Fmake_vector (make_number (FONT_SPEC_MAX
), Qnil
);
2929 for (i
= 0; i
< nargs
; i
+= 2)
2931 enum font_property_index prop
;
2932 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
2934 prop
= get_font_prop_index (key
, 0);
2935 if (prop
< FONT_EXTRA_INDEX
)
2936 ASET (spec
, prop
, val
);
2939 if (EQ (key
, QCname
))
2942 font_parse_name ((char *) SDATA (val
), spec
);
2944 font_put_extra (spec
, key
, val
);
2947 CHECK_VALIDATE_FONT_SPEC (spec
);
2952 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
2953 doc
: /* Return the value of FONT's PROP property.
2954 FONT is a font-spec, a font-entity, or a font-object. */)
2956 Lisp_Object font
, prop
;
2958 enum font_property_index idx
;
2960 if (FONT_OBJECT_P (font
))
2962 struct font
*fontp
= XSAVE_VALUE (font
)->pointer
;
2964 if (EQ (prop
, QCotf
))
2967 return font_otf_capability (fontp
);
2968 #else /* not HAVE_LIBOTF */
2970 #endif /* not HAVE_LIBOTF */
2972 font
= fontp
->entity
;
2976 idx
= get_font_prop_index (prop
, 0);
2977 if (idx
< FONT_EXTRA_INDEX
)
2978 return AREF (font
, idx
);
2979 if (FONT_ENTITY_P (font
))
2981 return Fcdr (Fassoc (AREF (font
, FONT_EXTRA_INDEX
), prop
));
2985 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
2986 doc
: /* Set one property of FONT-SPEC: give property PROP value VALUE. */)
2987 (font_spec
, prop
, val
)
2988 Lisp_Object font_spec
, prop
, val
;
2990 enum font_property_index idx
;
2991 Lisp_Object extra
, slot
;
2993 CHECK_FONT_SPEC (font_spec
);
2994 idx
= get_font_prop_index (prop
, 0);
2995 if (idx
< FONT_EXTRA_INDEX
)
2996 return ASET (font_spec
, idx
, val
);
2997 extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
2998 slot
= Fassoc (extra
, prop
);
3000 extra
= Fcons (Fcons (prop
, val
), extra
);
3002 Fsetcdr (slot
, val
);
3006 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3007 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3008 Optional 2nd argument FRAME specifies the target frame.
3009 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3010 Optional 4th argument PREFER, if non-nil, is a font-spec
3011 to which closeness fonts are sorted. */)
3012 (font_spec
, frame
, num
, prefer
)
3013 Lisp_Object font_spec
, frame
, num
, prefer
;
3015 Lisp_Object vec
, list
, tail
;
3019 frame
= selected_frame
;
3020 CHECK_LIVE_FRAME (frame
);
3021 CHECK_VALIDATE_FONT_SPEC (font_spec
);
3029 if (! NILP (prefer
))
3030 CHECK_FONT (prefer
);
3032 vec
= font_list_entities (frame
, font_spec
);
3037 return Fcons (AREF (vec
, 0), Qnil
);
3039 if (! NILP (prefer
))
3040 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
);
3042 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3043 if (n
== 0 || n
> len
)
3045 for (i
= 1; i
< n
; i
++)
3047 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3049 XSETCDR (tail
, val
);
3055 DEFUN ("list-families", Flist_families
, Slist_families
, 0, 1, 0,
3056 doc
: /* List available font families on the current frame.
3057 Optional 2nd argument FRAME specifies the target frame. */)
3062 struct font_driver_list
*driver_list
;
3066 frame
= selected_frame
;
3067 CHECK_LIVE_FRAME (frame
);
3070 for (driver_list
= f
->font_driver_list
; driver_list
;
3071 driver_list
= driver_list
->next
)
3072 if (driver_list
->driver
->list_family
)
3074 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3080 Lisp_Object tail
= list
;
3082 for (; CONSP (val
); val
= XCDR (val
))
3083 if (NILP (Fmemq (XCAR (val
), tail
)))
3084 list
= Fcons (XCAR (val
), list
);
3090 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3091 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3092 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3094 Lisp_Object font_spec
, frame
;
3096 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3103 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3104 doc
: /* Return XLFD name of FONT.
3105 FONT is a font-spec, font-entity, or font-object.
3106 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3113 if (FONT_SPEC_P (font
))
3114 CHECK_VALIDATE_FONT_SPEC (font
);
3115 else if (FONT_ENTITY_P (font
))
3121 CHECK_FONT_GET_OBJECT (font
, fontp
);
3122 font
= fontp
->entity
;
3123 pixel_size
= fontp
->pixel_size
;
3126 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3128 return build_string (name
);
3131 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3132 doc
: /* Clear font cache. */)
3135 Lisp_Object list
, frame
;
3137 FOR_EACH_FRAME (list
, frame
)
3139 FRAME_PTR f
= XFRAME (frame
);
3140 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3142 for (; driver_list
; driver_list
= driver_list
->next
)
3143 if (driver_list
->on
)
3145 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
3146 Lisp_Object tail
, elt
;
3148 for (tail
= XCDR (cache
); CONSP (tail
); tail
= XCDR (tail
))
3151 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
3153 Lisp_Object vec
= XCDR (elt
);
3156 for (i
= 0; i
< ASIZE (vec
); i
++)
3158 Lisp_Object entity
= AREF (vec
, i
);
3160 if (EQ (driver_list
->driver
->type
,
3161 AREF (entity
, FONT_TYPE_INDEX
)))
3164 = AREF (entity
, FONT_OBJLIST_INDEX
);
3166 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
3168 Lisp_Object val
= XCAR (objlist
);
3169 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
3170 struct font
*font
= p
->pointer
;
3172 xassert (font
&& (driver_list
->driver
3174 driver_list
->driver
->close (f
, font
);
3178 if (driver_list
->driver
->free_entity
)
3179 driver_list
->driver
->free_entity (entity
);
3184 XSETCDR (cache
, Qnil
);
3191 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3192 Sinternal_set_font_style_table
, 2, 2, 0,
3193 doc
: /* Set font style table for PROP to TABLE.
3194 PROP must be `:weight', `:slant', or `:width'.
3195 TABLE must be an alist of symbols vs the corresponding numeric values
3196 sorted by numeric values. */)
3198 Lisp_Object prop
, table
;
3202 Lisp_Object tail
, val
;
3204 CHECK_SYMBOL (prop
);
3205 table_index
= (EQ (prop
, QCweight
) ? 0
3206 : EQ (prop
, QCslant
) ? 1
3207 : EQ (prop
, QCwidth
) ? 2
3209 if (table_index
>= ASIZE (font_style_table
))
3210 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop
)));
3211 table
= Fcopy_sequence (table
);
3213 for (tail
= table
; ! NILP (tail
); tail
= Fcdr (tail
))
3215 prop
= Fcar (Fcar (tail
));
3216 val
= Fcdr (Fcar (tail
));
3217 CHECK_SYMBOL (prop
);
3219 if (numeric
> XINT (val
))
3220 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop
)));
3221 numeric
= XINT (val
);
3222 XSETCAR (tail
, Fcons (prop
, val
));
3224 ASET (font_style_table
, table_index
, table
);
3228 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3229 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3230 FONT-OBJECT may be nil if it is not yet known.
3232 G-string is sequence of glyphs of a specific font,
3233 and is a vector of this form:
3234 [ HEADER GLYPH ... ]
3235 HEADER is a vector of this form:
3236 [FONT-OBJECT LBEARING RBEARING WIDTH ASCENT DESCENT]
3238 FONT-OBJECT is a font-object for all glyphs in the G-string,
3239 LBEARING thry DESCENT is the metrics (in pixels) of the whole G-string.
3240 GLYPH is a vector of this form:
3241 [ FROM-IDX TO-IDX C CODE WIDTH [ [X-OFF Y-OFF WADJUST] | nil] ]
3243 FROM-IDX and TO-IDX are used internally and should not be touched.
3244 C is the character of the glyph.
3245 CODE is the glyph-code of C in FONT-OBJECT.
3246 X-OFF and Y-OFF are offests to the base position for the glyph.
3247 WIDTH is the normal width of the glyph.
3248 WADJUST is the adjustment to the normal width of the glyph. */)
3250 Lisp_Object font_object
, num
;
3252 Lisp_Object gstring
, g
;
3256 if (! NILP (font_object
))
3257 CHECK_FONT_OBJECT (font_object
);
3260 len
= XINT (num
) + 1;
3261 gstring
= Fmake_vector (make_number (len
), Qnil
);
3262 g
= Fmake_vector (make_number (6), Qnil
);
3263 ASET (g
, 0, font_object
);
3264 ASET (gstring
, 0, g
);
3265 for (i
= 1; i
< len
; i
++)
3266 ASET (gstring
, i
, Fmake_vector (make_number (8), Qnil
));
3270 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3271 doc
: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3272 START and END specifies the region to extract characters.
3273 If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3274 where to extract characters.
3275 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3276 (gstring
, font_object
, start
, end
, object
)
3277 Lisp_Object gstring
, font_object
, start
, end
, object
;
3283 CHECK_VECTOR (gstring
);
3284 if (NILP (font_object
))
3285 font_object
= LGSTRING_FONT (gstring
);
3286 CHECK_FONT_GET_OBJECT (font_object
, font
);
3288 if (STRINGP (object
))
3290 const unsigned char *p
;
3292 CHECK_NATNUM (start
);
3294 if (XINT (start
) > XINT (end
)
3295 || XINT (end
) > ASIZE (object
)
3296 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3297 args_out_of_range (start
, end
);
3299 len
= XINT (end
) - XINT (start
);
3300 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3301 for (i
= 0; i
< len
; i
++)
3303 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3305 c
= STRING_CHAR_ADVANCE (p
);
3306 code
= font
->driver
->encode_char (font
, c
);
3307 if (code
> MOST_POSITIVE_FIXNUM
)
3308 error ("Glyph code 0x%X is too large", code
);
3309 LGLYPH_SET_FROM (g
, make_number (i
));
3310 LGLYPH_SET_TO (g
, make_number (i
+ 1));
3311 LGLYPH_SET_CHAR (g
, make_number (c
));
3312 LGLYPH_SET_CODE (g
, make_number (code
));
3319 if (! NILP (object
))
3320 Fset_buffer (object
);
3321 validate_region (&start
, &end
);
3322 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3323 args_out_of_range (start
, end
);
3324 len
= XINT (end
) - XINT (start
);
3326 pos_byte
= CHAR_TO_BYTE (pos
);
3327 for (i
= 0; i
< len
; i
++)
3329 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3331 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3332 code
= font
->driver
->encode_char (font
, c
);
3333 if (code
> MOST_POSITIVE_FIXNUM
)
3334 error ("Glyph code 0x%X is too large", code
);
3335 LGLYPH_SET_FROM (g
, make_number (i
));
3336 LGLYPH_SET_TO (g
, make_number (i
+ 1));
3337 LGLYPH_SET_CHAR (g
, make_number (c
));
3338 LGLYPH_SET_CODE (g
, make_number (code
));
3341 for (i
= LGSTRING_LENGTH (gstring
) - 1; i
>= len
; i
--)
3343 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3345 LGLYPH_SET_FROM (g
, Qnil
);
3350 DEFUN ("font-otf-gsub", Ffont_otf_gsub
, Sfont_otf_gsub
, 6, 6, 0,
3351 doc
: /* Apply OpenType "GSUB" features on glyph-string GSTRING-IN.
3352 FEATURE-SPEC specifies which featuress to apply in this format:
3353 (SCRIPT LANGSYS FEATURE ...)
3355 SCRIPT is a symbol specifying a script tag of OpenType,
3356 LANGSYS is a symbol specifying a langsys tag of OpenType,
3357 FEATURE is a symbol specifying a feature tag of Opentype.
3359 If LANGYS is nil, the default langsys is selected.
3361 The features are applied in the order appeared in the list. FEATURE
3362 may be a symbol `*', in which case all available features not appeared
3363 in this list are applied, and the remaining FEATUREs are not ignored.
3364 For instance, (mlym nil vatu pstf * haln) means to apply vatu and pstf
3365 in this order, then to apply all available features other than vatu,
3368 The features are applied to the glyphs in the range FROM and TO of
3371 If some of a feature is actually applicable, the resulting glyphs are
3372 produced in the glyph-string GSTRING-OUT from the index INDEX. In
3373 this case, the value is the number of produced glyphs.
3375 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3378 If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
3379 produced in GSTRING-OUT, and the value is nil.
3381 See the documentation of `font-make-gstring' for the format of
3383 (feature_spec
, gstring_in
, from
, to
, gstring_out
, index
)
3384 Lisp_Object feature_spec
, gstring_in
, from
, to
, gstring_out
, index
;
3386 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
3387 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
3390 CHECK_FONT_GET_OBJECT (font_object
, font
);
3391 if (! font
->driver
->otf_gsub
)
3392 error ("Font backend %s can't drive OpenType GSUB table",
3393 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3394 CHECK_CONS (feature_spec
);
3395 len
= check_gstring (gstring_in
);
3396 CHECK_VECTOR (gstring_out
);
3397 CHECK_NATNUM (from
);
3399 CHECK_NATNUM (index
);
3401 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3402 args_out_of_range_3 (from
, to
, make_number (len
));
3403 if (XINT (index
) >= ASIZE (gstring_out
))
3404 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
3405 num
= font
->driver
->otf_gsub (font
, feature_spec
,
3406 gstring_in
, XINT (from
), XINT (to
),
3407 gstring_out
, XINT (index
), 0);
3410 return make_number (num
);
3414 DEFUN ("font-otf-gpos", Ffont_otf_gpos
, Sfont_otf_gpos
, 4, 4, 0,
3415 doc
: /* Apply OpenType "GPOS" features on glyph-string GSTRING.
3416 FEATURE-SPEC specifies which features to apply in this format:
3417 (SCRIPT LANGSYS FEATURE ...)
3418 See the documentation of `font-otf-gsub' for more detail.
3420 The features are applied to the glyphs in the range FROM and TO of
3422 (gpos_spec
, gstring
, from
, to
)
3423 Lisp_Object gpos_spec
, gstring
, from
, to
;
3425 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
3429 CHECK_FONT_GET_OBJECT (font_object
, font
);
3430 if (! font
->driver
->otf_gpos
)
3431 error ("Font backend %s can't drive OpenType GPOS table",
3432 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3433 CHECK_CONS (gpos_spec
);
3434 len
= check_gstring (gstring
);
3435 CHECK_NATNUM (from
);
3438 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3439 args_out_of_range_3 (from
, to
, make_number (len
));
3440 num
= font
->driver
->otf_gpos (font
, gpos_spec
,
3441 gstring
, XINT (from
), XINT (to
));
3442 return (num
<= 0 ? Qnil
: Qt
);
3446 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
3448 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
3449 FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
3451 (SCRIPT LANGSYS FEATURE ...)
3452 See the documentation of `font-otf-gsub' for more detail.
3454 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
3455 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
3456 character code corresponding to the glyph or nil if there's no
3457 corresponding character. */)
3458 (font_object
, character
, feature_spec
)
3459 Lisp_Object font_object
, character
, feature_spec
;
3462 Lisp_Object gstring_in
, gstring_out
, g
;
3463 Lisp_Object alternates
;
3466 CHECK_FONT_GET_OBJECT (font_object
, font
);
3467 if (! font
->driver
->otf_gsub
)
3468 error ("Font backend %s can't drive OpenType GSUB table",
3469 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3470 CHECK_CHARACTER (character
);
3471 CHECK_CONS (feature_spec
);
3473 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
3474 g
= LGSTRING_GLYPH (gstring_in
, 0);
3475 LGLYPH_SET_CHAR (g
, character
);
3476 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
3477 while ((num
= font
->driver
->otf_gsub (font
, feature_spec
, gstring_in
, 0, 1,
3478 gstring_out
, 0, 1)) < 0)
3479 gstring_out
= Ffont_make_gstring (font_object
,
3480 make_number (ASIZE (gstring_out
) * 2));
3482 for (i
= 0; i
< num
; i
++)
3484 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
3485 int c
= XINT (LGLYPH_CHAR (g
));
3486 unsigned code
= XUINT (LGLYPH_CODE (g
));
3488 alternates
= Fcons (Fcons (make_number (code
),
3489 c
> 0 ? make_number (c
) : Qnil
),
3492 return Fnreverse (alternates
);
3498 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
3499 doc
: /* Open FONT-ENTITY. */)
3500 (font_entity
, size
, frame
)
3501 Lisp_Object font_entity
;
3507 CHECK_FONT_ENTITY (font_entity
);
3509 size
= AREF (font_entity
, FONT_SIZE_INDEX
);
3510 CHECK_NUMBER (size
);
3512 frame
= selected_frame
;
3513 CHECK_LIVE_FRAME (frame
);
3515 isize
= XINT (size
);
3517 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
3519 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
3522 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
3523 doc
: /* Close FONT-OBJECT. */)
3524 (font_object
, frame
)
3525 Lisp_Object font_object
, frame
;
3527 CHECK_FONT_OBJECT (font_object
);
3529 frame
= selected_frame
;
3530 CHECK_LIVE_FRAME (frame
);
3531 font_close_object (XFRAME (frame
), font_object
);
3535 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
3536 doc
: /* Return information about FONT-OBJECT.
3537 The value is a vector:
3538 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
3541 NAME is a string of the font name (or nil if the font backend doesn't
3544 FILENAME is a string of the font file (or nil if the font backend
3545 doesn't provide a file name).
3547 PIXEL-SIZE is a pixel size by which the font is opened.
3549 SIZE is a maximum advance width of the font in pixel.
3551 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
3554 CAPABILITY is a list whose first element is a symbol representing the
3555 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
3556 remaining elements describes a detail of the font capability.
3558 If the font is OpenType font, the form of the list is
3559 \(opentype GSUB GPOS)
3560 where GSUB shows which "GSUB" features the font supports, and GPOS
3561 shows which "GPOS" features the font supports. Both GSUB and GPOS are
3562 lists of the format:
3563 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3565 If the font is not OpenType font, currently the length of the form is
3568 SCRIPT is a symbol representing OpenType script tag.
3570 LANGSYS is a symbol representing OpenType langsys tag, or nil
3571 representing the default langsys.
3573 FEATURE is a symbol representing OpenType feature tag.
3575 If the font is not OpenType font, OTF-CAPABILITY is nil. */)
3577 Lisp_Object font_object
;
3582 CHECK_FONT_GET_OBJECT (font_object
, font
);
3584 val
= Fmake_vector (make_number (9), Qnil
);
3585 if (font
->font
.full_name
)
3586 ASET (val
, 0, make_unibyte_string (font
->font
.full_name
,
3587 strlen (font
->font
.full_name
)));
3588 if (font
->file_name
)
3589 ASET (val
, 1, make_unibyte_string (font
->file_name
,
3590 strlen (font
->file_name
)));
3591 ASET (val
, 2, make_number (font
->pixel_size
));
3592 ASET (val
, 3, make_number (font
->font
.size
));
3593 ASET (val
, 4, make_number (font
->ascent
));
3594 ASET (val
, 5, make_number (font
->descent
));
3595 ASET (val
, 6, make_number (font
->font
.space_width
));
3596 ASET (val
, 7, make_number (font
->font
.average_width
));
3597 if (font
->driver
->otf_capability
)
3598 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
3600 ASET (val
, 8, Fcons (font
->format
, Qnil
));
3604 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
3605 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3606 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3607 (font_object
, string
)
3608 Lisp_Object font_object
, string
;
3614 CHECK_FONT_GET_OBJECT (font_object
, font
);
3615 CHECK_STRING (string
);
3616 len
= SCHARS (string
);
3617 vec
= Fmake_vector (make_number (len
), Qnil
);
3618 for (i
= 0; i
< len
; i
++)
3620 Lisp_Object ch
= Faref (string
, make_number (i
));
3624 struct font_metrics metrics
;
3626 code
= font
->driver
->encode_char (font
, c
);
3627 if (code
== FONT_INVALID_CODE
)
3629 val
= Fmake_vector (make_number (6), Qnil
);
3630 if (code
<= MOST_POSITIVE_FIXNUM
)
3631 ASET (val
, 0, make_number (code
));
3633 ASET (val
, 0, Fcons (make_number (code
>> 16),
3634 make_number (code
& 0xFFFF)));
3635 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
3636 ASET (val
, 1, make_number (metrics
.lbearing
));
3637 ASET (val
, 2, make_number (metrics
.rbearing
));
3638 ASET (val
, 3, make_number (metrics
.width
));
3639 ASET (val
, 4, make_number (metrics
.ascent
));
3640 ASET (val
, 5, make_number (metrics
.descent
));
3646 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
3647 doc
: /* Return t iff font-spec SPEC matches with FONT.
3648 FONT is a font-spec, font-entity, or font-object. */)
3650 Lisp_Object spec
, font
;
3652 CHECK_FONT_SPEC (spec
);
3653 if (FONT_OBJECT_P (font
))
3654 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
3655 else if (! FONT_ENTITY_P (font
))
3656 CHECK_FONT_SPEC (font
);
3658 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
3661 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 2, 0,
3662 doc
: /* Return a font-object for displaying a character at POSISTION.
3663 Optional second arg WINDOW, if non-nil, is a window displaying
3664 the current buffer. It defaults to the currently selected window. */)
3666 Lisp_Object position
, window
;
3669 EMACS_INT pos
, pos_byte
;
3672 CHECK_NUMBER_COERCE_MARKER (position
);
3673 pos
= XINT (position
);
3674 if (pos
< BEGV
|| pos
>= ZV
)
3675 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
3676 pos_byte
= CHAR_TO_BYTE (pos
);
3677 c
= FETCH_CHAR (pos_byte
);
3679 window
= selected_window
;
3680 CHECK_LIVE_WINDOW (window
);
3681 w
= XWINDOW (selected_window
);
3683 return font_at (c
, pos
, NULL
, w
, Qnil
);
3687 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
3688 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
3689 The value is a number of glyphs drawn.
3690 Type C-l to recover what previously shown. */)
3691 (font_object
, string
)
3692 Lisp_Object font_object
, string
;
3694 Lisp_Object frame
= selected_frame
;
3695 FRAME_PTR f
= XFRAME (frame
);
3701 CHECK_FONT_GET_OBJECT (font_object
, font
);
3702 CHECK_STRING (string
);
3703 len
= SCHARS (string
);
3704 code
= alloca (sizeof (unsigned) * len
);
3705 for (i
= 0; i
< len
; i
++)
3707 Lisp_Object ch
= Faref (string
, make_number (i
));
3711 code
[i
] = font
->driver
->encode_char (font
, c
);
3712 if (code
[i
] == FONT_INVALID_CODE
)
3715 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3717 if (font
->driver
->prepare_face
)
3718 font
->driver
->prepare_face (f
, face
);
3719 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
3720 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
3721 if (font
->driver
->done_face
)
3722 font
->driver
->done_face (f
, face
);
3724 return make_number (len
);
3728 #endif /* FONT_DEBUG */
3731 extern void syms_of_ftfont
P_ (());
3732 extern void syms_of_xfont
P_ (());
3733 extern void syms_of_xftfont
P_ (());
3734 extern void syms_of_ftxfont
P_ (());
3735 extern void syms_of_bdffont
P_ (());
3736 extern void syms_of_w32font
P_ (());
3737 extern void syms_of_atmfont
P_ (());
3742 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
3743 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
3744 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
3745 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
3746 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
3747 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
3748 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
3749 sort_shift_bits
[FONT_REGISTRY_INDEX
] = 31;
3750 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
3752 staticpro (&font_style_table
);
3753 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3755 staticpro (&font_family_alist
);
3756 font_family_alist
= Qnil
;
3758 DEFSYM (Qfontp
, "fontp");
3759 DEFSYM (Qopentype
, "opentype");
3761 DEFSYM (Qiso8859_1
, "iso8859-1");
3762 DEFSYM (Qiso10646_1
, "iso10646-1");
3763 DEFSYM (Qunicode_bmp
, "unicode-bmp");
3764 DEFSYM (Qunicode_sip
, "unicode-sip");
3766 DEFSYM (QCotf
, ":otf");
3767 DEFSYM (QClanguage
, ":language");
3768 DEFSYM (QCscript
, ":script");
3770 DEFSYM (QCfoundry
, ":foundry");
3771 DEFSYM (QCadstyle
, ":adstyle");
3772 DEFSYM (QCregistry
, ":registry");
3773 DEFSYM (QCspacing
, ":spacing");
3774 DEFSYM (QCdpi
, ":dpi");
3775 DEFSYM (QCscalable
, ":scalable");
3776 DEFSYM (QCextra
, ":extra");
3783 staticpro (&null_string
);
3784 null_string
= build_string ("");
3785 staticpro (&null_vector
);
3786 null_vector
= Fmake_vector (make_number (0), Qnil
);
3788 staticpro (&scratch_font_spec
);
3789 scratch_font_spec
= Ffont_spec (0, NULL
);
3790 staticpro (&scratch_font_prefer
);
3791 scratch_font_prefer
= Ffont_spec (0, NULL
);
3794 defsubr (&Sfont_spec
);
3795 defsubr (&Sfont_get
);
3796 defsubr (&Sfont_put
);
3797 defsubr (&Slist_fonts
);
3798 defsubr (&Slist_families
);
3799 defsubr (&Sfind_font
);
3800 defsubr (&Sfont_xlfd_name
);
3801 defsubr (&Sclear_font_cache
);
3802 defsubr (&Sinternal_set_font_style_table
);
3803 defsubr (&Sfont_make_gstring
);
3804 defsubr (&Sfont_fill_gstring
);
3805 defsubr (&Sfont_otf_gsub
);
3806 defsubr (&Sfont_otf_gpos
);
3807 defsubr (&Sfont_otf_alternates
);
3810 defsubr (&Sopen_font
);
3811 defsubr (&Sclose_font
);
3812 defsubr (&Squery_font
);
3813 defsubr (&Sget_font_glyphs
);
3814 defsubr (&Sfont_match_p
);
3815 defsubr (&Sfont_at
);
3817 defsubr (&Sdraw_string
);
3819 #endif /* FONT_DEBUG */
3821 #ifdef HAVE_FREETYPE
3823 #ifdef HAVE_X_WINDOWS
3828 #endif /* HAVE_XFT */
3829 #endif /* HAVE_X_WINDOWS */
3830 #else /* not HAVE_FREETYPE */
3831 #ifdef HAVE_X_WINDOWS
3833 #endif /* HAVE_X_WINDOWS */
3834 #endif /* not HAVE_FREETYPE */
3837 #endif /* HAVE_BDFFONT */
3840 #endif /* WINDOWSNT */
3846 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
3847 (do not change this comment) */