1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2011 Free Software Foundation, Inc.
4 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
51 Lisp_Object Qopentype
;
53 /* Important character set strings. */
54 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
56 #define DEFAULT_ENCODING Qiso8859_1
58 /* Unicode category `Cf'. */
59 static Lisp_Object QCf
;
61 /* Special vector of zero length. This is repeatedly used by (struct
62 font_driver *)->list when a specified font is not found. */
63 static Lisp_Object null_vector
;
65 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
66 static Lisp_Object font_style_table
;
68 /* Structure used for tables mapping weight, slant, and width numeric
69 values and their names. */
74 /* The first one is a valid name as a face attribute.
75 The second one (if any) is a typical name in XLFD field. */
79 /* Table of weight numeric values and their names. This table must be
80 sorted by numeric values in ascending order. */
82 static const struct table_entry weight_table
[] =
85 { 20, { "ultra-light", "ultralight" }},
86 { 40, { "extra-light", "extralight" }},
88 { 75, { "semi-light", "semilight", "demilight", "book" }},
89 { 100, { "normal", "medium", "regular", "unspecified" }},
90 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
92 { 205, { "extra-bold", "extrabold" }},
93 { 210, { "ultra-bold", "ultrabold", "black" }}
96 /* Table of slant numeric values and their names. This table must be
97 sorted by numeric values in ascending order. */
99 static const struct table_entry slant_table
[] =
101 { 0, { "reverse-oblique", "ro" }},
102 { 10, { "reverse-italic", "ri" }},
103 { 100, { "normal", "r", "unspecified" }},
104 { 200, { "italic" ,"i", "ot" }},
105 { 210, { "oblique", "o" }}
108 /* Table of width numeric values and their names. This table must be
109 sorted by numeric values in ascending order. */
111 static const struct table_entry width_table
[] =
113 { 50, { "ultra-condensed", "ultracondensed" }},
114 { 63, { "extra-condensed", "extracondensed" }},
115 { 75, { "condensed", "compressed", "narrow" }},
116 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
117 { 100, { "normal", "medium", "regular", "unspecified" }},
118 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
119 { 125, { "expanded" }},
120 { 150, { "extra-expanded", "extraexpanded" }},
121 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
124 Lisp_Object QCfoundry
;
125 static Lisp_Object QCadstyle
, QCregistry
;
126 /* Symbols representing keys of font extra info. */
127 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
128 Lisp_Object QCantialias
, QCfont_entity
;
129 static Lisp_Object QCfc_unknown_spec
;
130 /* Symbols representing values of font spacing property. */
131 static Lisp_Object Qc
, Qm
, Qd
;
133 /* Special ADSTYLE properties to avoid fonts used for Latin
134 characters; used in xfont.c and ftfont.c. */
135 Lisp_Object Qja
, Qko
;
137 static Lisp_Object QCuser_spec
;
139 /* Alist of font registry symbols and the corresponding charset
140 information. The information is retrieved from
141 Vfont_encoding_alist on demand.
143 Eash element has the form:
144 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
148 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
149 encodes a character code to a glyph code of a font, and
150 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
151 character is supported by a font.
153 The latter form means that the information for REGISTRY couldn't be
155 static Lisp_Object font_charset_alist
;
157 /* List of all font drivers. Each font-backend (XXXfont.c) calls
158 register_font_driver in syms_of_XXXfont to register its font-driver
160 static struct font_driver_list
*font_driver_list
;
164 /* Creaters of font-related Lisp object. */
167 font_make_spec (void)
169 Lisp_Object font_spec
;
170 struct font_spec
*spec
171 = ((struct font_spec
*)
172 allocate_pseudovector (VECSIZE (struct font_spec
),
173 FONT_SPEC_MAX
, PVEC_FONT
));
174 XSETFONT (font_spec
, spec
);
179 font_make_entity (void)
181 Lisp_Object font_entity
;
182 struct font_entity
*entity
183 = ((struct font_entity
*)
184 allocate_pseudovector (VECSIZE (struct font_entity
),
185 FONT_ENTITY_MAX
, PVEC_FONT
));
186 XSETFONT (font_entity
, entity
);
190 /* Create a font-object whose structure size is SIZE. If ENTITY is
191 not nil, copy properties from ENTITY to the font-object. If
192 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
194 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
196 Lisp_Object font_object
;
198 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
201 XSETFONT (font_object
, font
);
205 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
206 font
->props
[i
] = AREF (entity
, i
);
207 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
208 font
->props
[FONT_EXTRA_INDEX
]
209 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
212 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
218 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
219 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
220 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
222 static unsigned font_encode_char (Lisp_Object
, int);
224 /* Number of registered font drivers. */
225 static int num_font_drivers
;
228 /* Return a Lispy value of a font property value at STR and LEN bytes.
229 If STR is "*", return nil.
230 If FORCE_SYMBOL is zero and all characters in STR are digits,
231 return an integer. Otherwise, return a symbol interned from
235 font_intern_prop (const char *str
, ptrdiff_t len
, int force_symbol
)
240 EMACS_INT nbytes
, nchars
;
242 if (len
== 1 && *str
== '*')
244 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
246 for (i
= 1; i
< len
; i
++)
247 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
254 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
257 return make_number (n
);
258 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
262 xsignal1 (Qoverflow_error
, make_string (str
, len
));
266 /* The following code is copied from the function intern (in
267 lread.c), and modified to suit our purpose. */
269 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
270 obarray
= check_obarray (obarray
);
271 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
272 if (len
== nchars
|| len
!= nbytes
)
273 /* CONTENTS contains no multibyte sequences or contains an invalid
274 multibyte sequence. We'll make a unibyte string. */
275 tem
= oblookup (obarray
, str
, len
, len
);
277 tem
= oblookup (obarray
, str
, nchars
, len
);
280 if (len
== nchars
|| len
!= nbytes
)
281 tem
= make_unibyte_string (str
, len
);
283 tem
= make_multibyte_string (str
, nchars
, len
);
284 return Fintern (tem
, obarray
);
287 /* Return a pixel size of font-spec SPEC on frame F. */
290 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
292 #ifdef HAVE_WINDOW_SYSTEM
293 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
302 font_assert (FLOATP (size
));
303 point_size
= XFLOAT_DATA (size
);
304 val
= AREF (spec
, FONT_DPI_INDEX
);
309 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
317 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
318 font vector. If VAL is not valid (i.e. not registered in
319 font_style_table), return -1 if NOERROR is zero, and return a
320 proper index if NOERROR is nonzero. In that case, register VAL in
321 font_style_table if VAL is a symbol, and return the closest index if
322 VAL is an integer. */
325 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
327 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
328 int len
= ASIZE (table
);
334 Lisp_Object args
[2], elt
;
336 /* At first try exact match. */
337 for (i
= 0; i
< len
; i
++)
338 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
339 if (EQ (val
, AREF (AREF (table
, i
), j
)))
340 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
341 | (i
<< 4) | (j
- 1));
342 /* Try also with case-folding match. */
343 s
= SSDATA (SYMBOL_NAME (val
));
344 for (i
= 0; i
< len
; i
++)
345 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
347 elt
= AREF (AREF (table
, i
), j
);
348 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
349 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
350 | (i
<< 4) | (j
- 1));
356 elt
= Fmake_vector (make_number (2), make_number (100));
359 args
[1] = Fmake_vector (make_number (1), elt
);
360 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
361 return (100 << 8) | (i
<< 4);
366 int numeric
= XINT (val
);
368 for (i
= 0, last_n
= -1; i
< len
; i
++)
370 int n
= XINT (AREF (AREF (table
, i
), 0));
373 return (n
<< 8) | (i
<< 4);
378 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
379 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
385 return ((last_n
<< 8) | ((i
- 1) << 4));
390 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
392 Lisp_Object val
= AREF (font
, prop
);
393 Lisp_Object table
, elt
;
398 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
399 i
= XINT (val
) & 0xFF;
400 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
401 elt
= AREF (table
, ((i
>> 4) & 0xF));
402 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
403 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
406 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
407 FONTNAME. ENCODING is a charset symbol that specifies the encoding
408 of the font. REPERTORY is a charset symbol or nil. */
411 find_font_encoding (Lisp_Object fontname
)
413 Lisp_Object tail
, elt
;
415 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
419 && STRINGP (XCAR (elt
))
420 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
421 && (SYMBOLP (XCDR (elt
))
422 ? CHARSETP (XCDR (elt
))
423 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
429 /* Return encoding charset and repertory charset for REGISTRY in
430 ENCODING and REPERTORY correspondingly. If correct information for
431 REGISTRY is available, return 0. Otherwise return -1. */
434 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
437 int encoding_id
, repertory_id
;
439 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
445 encoding_id
= XINT (XCAR (val
));
446 repertory_id
= XINT (XCDR (val
));
450 val
= find_font_encoding (SYMBOL_NAME (registry
));
451 if (SYMBOLP (val
) && CHARSETP (val
))
453 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
455 else if (CONSP (val
))
457 if (! CHARSETP (XCAR (val
)))
459 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
460 if (NILP (XCDR (val
)))
464 if (! CHARSETP (XCDR (val
)))
466 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
471 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
473 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
477 *encoding
= CHARSET_FROM_ID (encoding_id
);
479 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
484 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
489 /* Font property value validators. See the comment of
490 font_property_table for the meaning of the arguments. */
492 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
493 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
494 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
495 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
496 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
497 static int get_font_prop_index (Lisp_Object
);
500 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
503 val
= Fintern (val
, Qnil
);
506 else if (EQ (prop
, QCregistry
))
507 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
513 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
515 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
516 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
522 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
526 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
528 if ((n
& 0xF) + 1 >= ASIZE (elt
))
530 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
534 else if (SYMBOLP (val
))
536 int n
= font_style_to_value (prop
, val
, 0);
538 val
= n
>= 0 ? make_number (n
) : Qerror
;
546 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
548 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
553 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
555 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
557 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
559 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
561 if (spacing
== 'c' || spacing
== 'C')
562 return make_number (FONT_SPACING_CHARCELL
);
563 if (spacing
== 'm' || spacing
== 'M')
564 return make_number (FONT_SPACING_MONO
);
565 if (spacing
== 'p' || spacing
== 'P')
566 return make_number (FONT_SPACING_PROPORTIONAL
);
567 if (spacing
== 'd' || spacing
== 'D')
568 return make_number (FONT_SPACING_DUAL
);
574 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
576 Lisp_Object tail
, tmp
;
579 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
580 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
581 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
584 if (! SYMBOLP (XCAR (val
)))
589 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
591 for (i
= 0; i
< 2; i
++)
598 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
599 if (! SYMBOLP (XCAR (tmp
)))
607 /* Structure of known font property keys and validator of the
611 /* Pointer to the key symbol. */
613 /* Function to validate PROP's value VAL, or NULL if any value is
614 ok. The value is VAL or its regularized value if VAL is valid,
615 and Qerror if not. */
616 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
617 } font_property_table
[] =
618 { { &QCtype
, font_prop_validate_symbol
},
619 { &QCfoundry
, font_prop_validate_symbol
},
620 { &QCfamily
, font_prop_validate_symbol
},
621 { &QCadstyle
, font_prop_validate_symbol
},
622 { &QCregistry
, font_prop_validate_symbol
},
623 { &QCweight
, font_prop_validate_style
},
624 { &QCslant
, font_prop_validate_style
},
625 { &QCwidth
, font_prop_validate_style
},
626 { &QCsize
, font_prop_validate_non_neg
},
627 { &QCdpi
, font_prop_validate_non_neg
},
628 { &QCspacing
, font_prop_validate_spacing
},
629 { &QCavgwidth
, font_prop_validate_non_neg
},
630 /* The order of the above entries must match with enum
631 font_property_index. */
632 { &QClang
, font_prop_validate_symbol
},
633 { &QCscript
, font_prop_validate_symbol
},
634 { &QCotf
, font_prop_validate_otf
}
637 /* Size (number of elements) of the above table. */
638 #define FONT_PROPERTY_TABLE_SIZE \
639 ((sizeof font_property_table) / (sizeof *font_property_table))
641 /* Return an index number of font property KEY or -1 if KEY is not an
642 already known property. */
645 get_font_prop_index (Lisp_Object key
)
649 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
650 if (EQ (key
, *font_property_table
[i
].key
))
655 /* Validate the font property. The property key is specified by the
656 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
657 signal an error. The value is VAL or the regularized one. */
660 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
662 Lisp_Object validated
;
667 prop
= *font_property_table
[idx
].key
;
670 idx
= get_font_prop_index (prop
);
674 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
675 if (EQ (validated
, Qerror
))
676 signal_error ("invalid font property", Fcons (prop
, val
));
681 /* Store VAL as a value of extra font property PROP in FONT while
682 keeping the sorting order. Don't check the validity of VAL. */
685 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
687 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
688 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
692 Lisp_Object prev
= Qnil
;
695 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
696 prev
= extra
, extra
= XCDR (extra
);
699 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
701 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
707 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
712 /* Font name parser and unparser */
714 static int parse_matrix (const char *);
715 static int font_expand_wildcards (Lisp_Object
*, int);
716 static int font_parse_name (char *, Lisp_Object
);
718 /* An enumerator for each field of an XLFD font name. */
719 enum xlfd_field_index
738 /* An enumerator for mask bit corresponding to each XLFD field. */
741 XLFD_FOUNDRY_MASK
= 0x0001,
742 XLFD_FAMILY_MASK
= 0x0002,
743 XLFD_WEIGHT_MASK
= 0x0004,
744 XLFD_SLANT_MASK
= 0x0008,
745 XLFD_SWIDTH_MASK
= 0x0010,
746 XLFD_ADSTYLE_MASK
= 0x0020,
747 XLFD_PIXEL_MASK
= 0x0040,
748 XLFD_POINT_MASK
= 0x0080,
749 XLFD_RESX_MASK
= 0x0100,
750 XLFD_RESY_MASK
= 0x0200,
751 XLFD_SPACING_MASK
= 0x0400,
752 XLFD_AVGWIDTH_MASK
= 0x0800,
753 XLFD_REGISTRY_MASK
= 0x1000,
754 XLFD_ENCODING_MASK
= 0x2000
758 /* Parse P pointing to the pixel/point size field of the form
759 `[A B C D]' which specifies a transformation matrix:
765 by which all glyphs of the font are transformed. The spec says
766 that scalar value N for the pixel/point size is equivalent to:
767 A = N * resx/resy, B = C = 0, D = N.
769 Return the scalar value N if the form is valid. Otherwise return
773 parse_matrix (const char *p
)
779 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
782 matrix
[i
] = - strtod (p
+ 1, &end
);
784 matrix
[i
] = strtod (p
, &end
);
787 return (i
== 4 ? (int) matrix
[3] : -1);
790 /* Expand a wildcard field in FIELD (the first N fields are filled) to
791 multiple fields to fill in all 14 XLFD fields while restricting a
792 field position by its contents. */
795 font_expand_wildcards (Lisp_Object
*field
, int n
)
798 Lisp_Object tmp
[XLFD_LAST_INDEX
];
799 /* Array of information about where this element can go. Nth
800 element is for Nth element of FIELD. */
802 /* Minimum possible field. */
804 /* Maxinum possible field. */
806 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
808 } range
[XLFD_LAST_INDEX
];
810 int range_from
, range_to
;
813 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
814 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
815 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
816 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
817 | XLFD_AVGWIDTH_MASK)
818 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
820 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
821 field. The value is shifted to left one bit by one in the
823 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
824 range_mask
= (range_mask
<< 1) | 1;
826 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
827 position-based retriction for FIELD[I]. */
828 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
829 i
++, range_from
++, range_to
++, range_mask
<<= 1)
831 Lisp_Object val
= field
[i
];
837 range
[i
].from
= range_from
;
838 range
[i
].to
= range_to
;
839 range
[i
].mask
= range_mask
;
843 /* The triplet FROM, TO, and MASK is a value-based
844 retriction for FIELD[I]. */
850 int numeric
= XINT (val
);
853 from
= to
= XLFD_ENCODING_INDEX
,
854 mask
= XLFD_ENCODING_MASK
;
855 else if (numeric
== 0)
856 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
857 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
858 else if (numeric
<= 48)
859 from
= to
= XLFD_PIXEL_INDEX
,
860 mask
= XLFD_PIXEL_MASK
;
862 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
863 mask
= XLFD_LARGENUM_MASK
;
865 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
866 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
867 mask
= XLFD_NULL_MASK
;
869 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
872 Lisp_Object name
= SYMBOL_NAME (val
);
874 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
875 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
876 mask
= XLFD_REGENC_MASK
;
878 from
= to
= XLFD_ENCODING_INDEX
,
879 mask
= XLFD_ENCODING_MASK
;
881 else if (range_from
<= XLFD_WEIGHT_INDEX
882 && range_to
>= XLFD_WEIGHT_INDEX
883 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
884 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
885 else if (range_from
<= XLFD_SLANT_INDEX
886 && range_to
>= XLFD_SLANT_INDEX
887 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
888 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
889 else if (range_from
<= XLFD_SWIDTH_INDEX
890 && range_to
>= XLFD_SWIDTH_INDEX
891 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
892 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
895 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
896 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
898 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
899 mask
= XLFD_SYMBOL_MASK
;
902 /* Merge position-based and value-based restrictions. */
904 while (from
< range_from
)
905 mask
&= ~(1 << from
++);
906 while (from
< 14 && ! (mask
& (1 << from
)))
908 while (to
> range_to
)
909 mask
&= ~(1 << to
--);
910 while (to
>= 0 && ! (mask
& (1 << to
)))
914 range
[i
].from
= from
;
916 range
[i
].mask
= mask
;
918 if (from
> range_from
|| to
< range_to
)
920 /* The range is narrowed by value-based restrictions.
921 Reflect it to the other fields. */
923 /* Following fields should be after FROM. */
925 /* Preceding fields should be before TO. */
926 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
928 /* Check FROM for non-wildcard field. */
929 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
931 while (range
[j
].from
< from
)
932 range
[j
].mask
&= ~(1 << range
[j
].from
++);
933 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
935 range
[j
].from
= from
;
938 from
= range
[j
].from
;
939 if (range
[j
].to
> to
)
941 while (range
[j
].to
> to
)
942 range
[j
].mask
&= ~(1 << range
[j
].to
--);
943 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
956 /* Decide all fileds from restrictions in RANGE. */
957 for (i
= j
= 0; i
< n
; i
++)
959 if (j
< range
[i
].from
)
961 if (i
== 0 || ! NILP (tmp
[i
- 1]))
962 /* None of TMP[X] corresponds to Jth field. */
964 for (; j
< range
[i
].from
; j
++)
969 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
971 for (; j
< XLFD_LAST_INDEX
; j
++)
973 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
974 field
[XLFD_ENCODING_INDEX
]
975 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
980 /* Parse NAME (null terminated) as XLFD and store information in FONT
981 (font-spec or font-entity). Size property of FONT is set as
983 specified XLFD fields FONT property
984 --------------------- -------------
985 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
986 POINT_SIZE and RESY calculated pixel size (Lisp integer)
987 POINT_SIZE POINT_SIZE/10 (Lisp float)
989 If NAME is successfully parsed, return 0. Otherwise return -1.
991 FONT is usually a font-spec, but when this function is called from
992 X font backend driver, it is a font-entity. In that case, NAME is
993 a fully specified XLFD. */
996 font_parse_xlfd (char *name
, Lisp_Object font
)
998 ptrdiff_t len
= strlen (name
);
1000 char *f
[XLFD_LAST_INDEX
+ 1];
1004 if (len
> 255 || !len
)
1005 /* Maximum XLFD name length is 255. */
1007 /* Accept "*-.." as a fully specified XLFD. */
1008 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1009 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1012 for (p
= name
+ i
; *p
; p
++)
1016 if (i
== XLFD_LAST_INDEX
)
1021 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1022 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1024 if (i
== XLFD_LAST_INDEX
)
1026 /* Fully specified XLFD. */
1029 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1030 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1031 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1032 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1034 val
= INTERN_FIELD_SYM (i
);
1037 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1039 ASET (font
, j
, make_number (n
));
1042 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1043 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1044 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1046 ASET (font
, FONT_REGISTRY_INDEX
,
1047 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1048 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1050 p
= f
[XLFD_PIXEL_INDEX
];
1051 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1052 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1055 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1057 ASET (font
, FONT_SIZE_INDEX
, val
);
1058 else if (FONT_ENTITY_P (font
))
1062 double point_size
= -1;
1064 font_assert (FONT_SPEC_P (font
));
1065 p
= f
[XLFD_POINT_INDEX
];
1067 point_size
= parse_matrix (p
);
1068 else if (isdigit (*p
))
1069 point_size
= atoi (p
), point_size
/= 10;
1070 if (point_size
>= 0)
1071 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1075 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1076 if (! NILP (val
) && ! INTEGERP (val
))
1078 ASET (font
, FONT_DPI_INDEX
, val
);
1079 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1082 val
= font_prop_validate_spacing (QCspacing
, val
);
1083 if (! INTEGERP (val
))
1085 ASET (font
, FONT_SPACING_INDEX
, val
);
1087 p
= f
[XLFD_AVGWIDTH_INDEX
];
1090 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1091 if (! NILP (val
) && ! INTEGERP (val
))
1093 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1097 int wild_card_found
= 0;
1098 Lisp_Object prop
[XLFD_LAST_INDEX
];
1100 if (FONT_ENTITY_P (font
))
1102 for (j
= 0; j
< i
; j
++)
1106 if (f
[j
][1] && f
[j
][1] != '-')
1109 wild_card_found
= 1;
1112 prop
[j
] = INTERN_FIELD (j
);
1114 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1116 if (! wild_card_found
)
1118 if (font_expand_wildcards (prop
, i
) < 0)
1121 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1122 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1123 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1124 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1125 if (! NILP (prop
[i
]))
1127 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1129 ASET (font
, j
, make_number (n
));
1131 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1132 val
= prop
[XLFD_REGISTRY_INDEX
];
1135 val
= prop
[XLFD_ENCODING_INDEX
];
1137 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1139 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1140 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1142 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1143 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1145 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1147 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1148 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1149 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1151 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1153 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1156 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1157 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1158 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1160 val
= font_prop_validate_spacing (QCspacing
,
1161 prop
[XLFD_SPACING_INDEX
]);
1162 if (! INTEGERP (val
))
1164 ASET (font
, FONT_SPACING_INDEX
, val
);
1166 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1167 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1173 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1174 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1175 0, use PIXEL_SIZE instead. */
1178 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1181 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1185 font_assert (FONTP (font
));
1187 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1190 if (i
== FONT_ADSTYLE_INDEX
)
1191 j
= XLFD_ADSTYLE_INDEX
;
1192 else if (i
== FONT_REGISTRY_INDEX
)
1193 j
= XLFD_REGISTRY_INDEX
;
1194 val
= AREF (font
, i
);
1197 if (j
== XLFD_REGISTRY_INDEX
)
1198 f
[j
] = "*-*", len
+= 4;
1200 f
[j
] = "*", len
+= 2;
1205 val
= SYMBOL_NAME (val
);
1206 if (j
== XLFD_REGISTRY_INDEX
1207 && ! strchr (SSDATA (val
), '-'))
1209 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1210 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1212 f
[j
] = p
= alloca (SBYTES (val
) + 3);
1213 sprintf (p
, "%s-*", SDATA (val
));
1214 len
+= SBYTES (val
) + 3;
1218 f
[j
] = p
= alloca (SBYTES (val
) + 4);
1219 sprintf (p
, "%s*-*", SDATA (val
));
1220 len
+= SBYTES (val
) + 4;
1224 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1228 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1231 val
= font_style_symbolic (font
, i
, 0);
1233 f
[j
] = "*", len
+= 2;
1236 val
= SYMBOL_NAME (val
);
1237 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1241 val
= AREF (font
, FONT_SIZE_INDEX
);
1242 font_assert (NUMBERP (val
) || NILP (val
));
1250 f
[XLFD_PIXEL_INDEX
] = p
= alloca (22);
1251 len
+= sprintf (p
, "%d-*", i
) + 1;
1254 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1256 else if (FLOATP (val
))
1258 i
= XFLOAT_DATA (val
) * 10;
1259 f
[XLFD_PIXEL_INDEX
] = p
= alloca (12);
1260 len
+= sprintf (p
, "*-%d", i
) + 1;
1263 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1265 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1267 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1268 f
[XLFD_RESX_INDEX
] = p
= alloca (22);
1269 len
+= sprintf (p
, "%d-%d", i
, i
) + 1;
1272 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1273 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1275 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1277 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1278 : spacing
<= FONT_SPACING_DUAL
? "d"
1279 : spacing
<= FONT_SPACING_MONO
? "m"
1284 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1285 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1287 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (22);
1288 len
+= sprintf (p
, "%"pI
"d",
1289 XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1292 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1293 len
++; /* for terminating '\0'. */
1296 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1297 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1298 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1299 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1300 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1301 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1302 f
[XLFD_REGISTRY_INDEX
]);
1305 /* Parse NAME (null terminated) and store information in FONT
1306 (font-spec or font-entity). NAME is supplied in either the
1307 Fontconfig or GTK font name format. If NAME is successfully
1308 parsed, return 0. Otherwise return -1.
1310 The fontconfig format is
1312 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1316 FAMILY [PROPS...] [SIZE]
1318 This function tries to guess which format it is. */
1321 font_parse_fcname (char *name
, Lisp_Object font
)
1324 char *size_beg
= NULL
, *size_end
= NULL
;
1325 char *props_beg
= NULL
, *family_end
= NULL
;
1326 ptrdiff_t len
= strlen (name
);
1331 for (p
= name
; *p
; p
++)
1333 if (*p
== '\\' && p
[1])
1337 props_beg
= family_end
= p
;
1342 int decimal
= 0, size_found
= 1;
1343 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1346 if (*q
!= '.' || decimal
)
1365 Lisp_Object extra_props
= Qnil
;
1367 /* A fontconfig name with size and/or property data. */
1368 if (family_end
> name
)
1371 family
= font_intern_prop (name
, family_end
- name
, 1);
1372 ASET (font
, FONT_FAMILY_INDEX
, family
);
1376 double point_size
= strtod (size_beg
, &size_end
);
1377 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1378 if (*size_end
== ':' && size_end
[1])
1379 props_beg
= size_end
;
1383 /* Now parse ":KEY=VAL" patterns. */
1386 for (p
= props_beg
; *p
; p
= q
)
1388 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1391 /* Must be an enumerated value. */
1395 val
= font_intern_prop (p
, q
- p
, 1);
1397 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1398 && memcmp (p, STR, strlen (STR)) == 0)
1400 if (PROP_MATCH ("light")
1401 || PROP_MATCH ("medium")
1402 || PROP_MATCH ("demibold")
1403 || PROP_MATCH ("bold")
1404 || PROP_MATCH ("black"))
1405 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1406 else if (PROP_MATCH ("roman")
1407 || PROP_MATCH ("italic")
1408 || PROP_MATCH ("oblique"))
1409 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1410 else if (PROP_MATCH ("charcell"))
1411 ASET (font
, FONT_SPACING_INDEX
,
1412 make_number (FONT_SPACING_CHARCELL
));
1413 else if (PROP_MATCH ("mono"))
1414 ASET (font
, FONT_SPACING_INDEX
,
1415 make_number (FONT_SPACING_MONO
));
1416 else if (PROP_MATCH ("proportional"))
1417 ASET (font
, FONT_SPACING_INDEX
,
1418 make_number (FONT_SPACING_PROPORTIONAL
));
1427 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1428 prop
= FONT_SIZE_INDEX
;
1431 key
= font_intern_prop (p
, q
- p
, 1);
1432 prop
= get_font_prop_index (key
);
1436 for (q
= p
; *q
&& *q
!= ':'; q
++);
1437 val
= font_intern_prop (p
, q
- p
, 0);
1439 if (prop
>= FONT_FOUNDRY_INDEX
1440 && prop
< FONT_EXTRA_INDEX
)
1441 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1444 extra_props
= nconc2 (extra_props
,
1445 Fcons (Fcons (key
, val
), Qnil
));
1452 if (! NILP (extra_props
))
1454 struct font_driver_list
*driver_list
= font_driver_list
;
1455 for ( ; driver_list
; driver_list
= driver_list
->next
)
1456 if (driver_list
->driver
->filter_properties
)
1457 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1463 /* Either a fontconfig-style name with no size and property
1464 data, or a GTK-style name. */
1465 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1466 Lisp_Object width
= Qnil
, size
= Qnil
;
1470 /* Scan backwards from the end, looking for a size. */
1471 for (p
= name
+ len
- 1; p
>= name
; p
--)
1475 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1476 /* Found a font size. */
1477 size
= make_float (strtod (p
+ 1, NULL
));
1481 /* Now P points to the termination of the string, sans size.
1482 Scan backwards, looking for font properties. */
1483 for (; p
> name
; p
= q
)
1485 for (q
= p
- 1; q
>= name
; q
--)
1487 if (q
> name
&& *(q
-1) == '\\')
1488 --q
; /* Skip quoting backslashes. */
1494 word_len
= p
- word_start
;
1496 #define PROP_MATCH(STR) \
1497 (word_len == strlen (STR) \
1498 && memcmp (word_start, STR, strlen (STR)) == 0)
1499 #define PROP_SAVE(VAR, STR) \
1500 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1502 if (PROP_MATCH ("Ultra-Light"))
1503 PROP_SAVE (weight
, "ultra-light");
1504 else if (PROP_MATCH ("Light"))
1505 PROP_SAVE (weight
, "light");
1506 else if (PROP_MATCH ("Book"))
1507 PROP_SAVE (weight
, "book");
1508 else if (PROP_MATCH ("Medium"))
1509 PROP_SAVE (weight
, "medium");
1510 else if (PROP_MATCH ("Semi-Bold"))
1511 PROP_SAVE (weight
, "semi-bold");
1512 else if (PROP_MATCH ("Bold"))
1513 PROP_SAVE (weight
, "bold");
1514 else if (PROP_MATCH ("Italic"))
1515 PROP_SAVE (slant
, "italic");
1516 else if (PROP_MATCH ("Oblique"))
1517 PROP_SAVE (slant
, "oblique");
1518 else if (PROP_MATCH ("Semi-Condensed"))
1519 PROP_SAVE (width
, "semi-condensed");
1520 else if (PROP_MATCH ("Condensed"))
1521 PROP_SAVE (width
, "condensed");
1522 /* An unknown word must be part of the font name. */
1533 ASET (font
, FONT_FAMILY_INDEX
,
1534 font_intern_prop (name
, family_end
- name
, 1));
1536 ASET (font
, FONT_SIZE_INDEX
, size
);
1538 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1540 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1542 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1548 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1549 NAME (NBYTES length), and return the name length. If
1550 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1553 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1555 Lisp_Object family
, foundry
;
1556 Lisp_Object tail
, val
;
1561 Lisp_Object styles
[3];
1562 const char *style_names
[3] = { "weight", "slant", "width" };
1565 family
= AREF (font
, FONT_FAMILY_INDEX
);
1566 if (! NILP (family
))
1568 if (SYMBOLP (family
))
1570 family
= SYMBOL_NAME (family
);
1571 len
+= SBYTES (family
);
1577 val
= AREF (font
, FONT_SIZE_INDEX
);
1580 if (XINT (val
) != 0)
1581 pixel_size
= XINT (val
);
1583 len
+= 21; /* for ":pixelsize=NUM" */
1590 point_size
= (int) XFLOAT_DATA (val
);
1591 len
+= 11; /* for "-NUM" */
1594 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1595 if (! NILP (foundry
))
1597 if (SYMBOLP (foundry
))
1599 foundry
= SYMBOL_NAME (foundry
);
1600 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1606 for (i
= 0; i
< 3; i
++)
1608 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1609 if (! NILP (styles
[i
]))
1610 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1611 SDATA (SYMBOL_NAME (styles
[i
])));
1614 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1615 len
+= sprintf (work
, ":dpi=%"pI
"d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1616 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1617 len
+= strlen (":spacing=100");
1618 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1619 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1620 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1622 Lisp_Object key
= XCAR (XCAR (tail
)), value
= XCDR (XCAR (tail
));
1624 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1625 if (STRINGP (value
))
1626 len
+= SBYTES (value
);
1627 else if (INTEGERP (value
))
1628 len
+= sprintf (work
, "%"pI
"d", XINT (value
));
1629 else if (SYMBOLP (value
))
1630 len
+= (NILP (value
) ? 5 : 4); /* for "false" or "true" */
1636 if (! NILP (family
))
1637 p
+= sprintf (p
, "%s", SDATA (family
));
1641 p
+= sprintf (p
, "%d", point_size
);
1643 p
+= sprintf (p
, "-%d", point_size
);
1645 else if (pixel_size
> 0)
1646 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1647 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1648 p
+= sprintf (p
, ":foundry=%s",
1649 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1650 for (i
= 0; i
< 3; i
++)
1651 if (! NILP (styles
[i
]))
1652 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1653 SDATA (SYMBOL_NAME (styles
[i
])));
1654 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1655 p
+= sprintf (p
, ":dpi=%"pI
"d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1656 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1657 p
+= sprintf (p
, ":spacing=%"pI
"d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1658 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1660 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1661 p
+= sprintf (p
, ":scalable=true");
1663 p
+= sprintf (p
, ":scalable=false");
1668 /* Parse NAME (null terminated) and store information in FONT
1669 (font-spec or font-entity). If NAME is successfully parsed, return
1670 0. Otherwise return -1. */
1673 font_parse_name (char *name
, Lisp_Object font
)
1675 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1676 return font_parse_xlfd (name
, font
);
1677 return font_parse_fcname (name
, font
);
1681 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1682 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1686 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1692 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1694 CHECK_STRING (family
);
1695 len
= SBYTES (family
);
1696 p0
= SSDATA (family
);
1697 p1
= strchr (p0
, '-');
1700 if ((*p0
!= '*' && p1
- p0
> 0)
1701 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1702 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1705 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1708 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1710 if (! NILP (registry
))
1712 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1713 CHECK_STRING (registry
);
1714 len
= SBYTES (registry
);
1715 p0
= SSDATA (registry
);
1716 p1
= strchr (p0
, '-');
1719 if (SDATA (registry
)[len
- 1] == '*')
1720 registry
= concat2 (registry
, build_string ("-*"));
1722 registry
= concat2 (registry
, build_string ("*-*"));
1724 registry
= Fdowncase (registry
);
1725 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1730 /* This part (through the next ^L) is still experimental and not
1731 tested much. We may drastically change codes. */
1737 #define LGSTRING_HEADER_SIZE 6
1738 #define LGSTRING_GLYPH_SIZE 8
1741 check_gstring (gstring
)
1742 Lisp_Object gstring
;
1747 CHECK_VECTOR (gstring
);
1748 val
= AREF (gstring
, 0);
1750 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1752 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1753 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1754 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1755 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1756 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1757 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1758 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1759 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1760 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1761 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1762 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1764 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1766 val
= LGSTRING_GLYPH (gstring
, i
);
1768 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1770 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1772 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1773 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1774 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1775 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1776 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1777 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1778 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1779 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1781 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1783 if (ASIZE (val
) < 3)
1785 for (j
= 0; j
< 3; j
++)
1786 CHECK_NUMBER (AREF (val
, j
));
1791 error ("Invalid glyph-string format");
1796 check_otf_features (otf_features
)
1797 Lisp_Object otf_features
;
1801 CHECK_CONS (otf_features
);
1802 CHECK_SYMBOL (XCAR (otf_features
));
1803 otf_features
= XCDR (otf_features
);
1804 CHECK_CONS (otf_features
);
1805 CHECK_SYMBOL (XCAR (otf_features
));
1806 otf_features
= XCDR (otf_features
);
1807 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1809 CHECK_SYMBOL (Fcar (val
));
1810 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1811 error ("Invalid OTF GSUB feature: %s",
1812 SDATA (SYMBOL_NAME (XCAR (val
))));
1814 otf_features
= XCDR (otf_features
);
1815 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1817 CHECK_SYMBOL (Fcar (val
));
1818 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1819 error ("Invalid OTF GPOS feature: %s",
1820 SDATA (SYMBOL_NAME (XCAR (val
))));
1827 Lisp_Object otf_list
;
1830 otf_tag_symbol (tag
)
1835 OTF_tag_name (tag
, name
);
1836 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1843 Lisp_Object val
= Fassoc (file
, otf_list
);
1847 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1850 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1851 val
= make_save_value (otf
, 0);
1852 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1858 /* Return a list describing which scripts/languages FONT supports by
1859 which GSUB/GPOS features of OpenType tables. See the comment of
1860 (struct font_driver).otf_capability. */
1863 font_otf_capability (font
)
1867 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1870 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1873 for (i
= 0; i
< 2; i
++)
1875 OTF_GSUB_GPOS
*gsub_gpos
;
1876 Lisp_Object script_list
= Qnil
;
1879 if (OTF_get_features (otf
, i
== 0) < 0)
1881 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1882 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1884 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1885 Lisp_Object langsys_list
= Qnil
;
1886 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1889 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1891 OTF_LangSys
*langsys
;
1892 Lisp_Object feature_list
= Qnil
;
1893 Lisp_Object langsys_tag
;
1896 if (k
== script
->LangSysCount
)
1898 langsys
= &script
->DefaultLangSys
;
1903 langsys
= script
->LangSys
+ k
;
1905 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1907 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1909 OTF_Feature
*feature
1910 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1911 Lisp_Object feature_tag
1912 = otf_tag_symbol (feature
->FeatureTag
);
1914 feature_list
= Fcons (feature_tag
, feature_list
);
1916 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1919 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1924 XSETCAR (capability
, script_list
);
1926 XSETCDR (capability
, script_list
);
1932 /* Parse OTF features in SPEC and write a proper features spec string
1933 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1934 assured that the sufficient memory has already allocated for
1938 generate_otf_features (spec
, features
)
1948 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1954 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1959 else if (! asterisk
)
1961 val
= SYMBOL_NAME (val
);
1962 p
+= sprintf (p
, "%s", SDATA (val
));
1966 val
= SYMBOL_NAME (val
);
1967 p
+= sprintf (p
, "~%s", SDATA (val
));
1971 error ("OTF spec too long");
1975 font_otf_DeviceTable (device_table
)
1976 OTF_DeviceTable
*device_table
;
1978 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1980 return Fcons (make_number (len
),
1981 make_unibyte_string (device_table
->DeltaValue
, len
));
1985 font_otf_ValueRecord (value_format
, value_record
)
1987 OTF_ValueRecord
*value_record
;
1989 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1991 if (value_format
& OTF_XPlacement
)
1992 ASET (val
, 0, make_number (value_record
->XPlacement
));
1993 if (value_format
& OTF_YPlacement
)
1994 ASET (val
, 1, make_number (value_record
->YPlacement
));
1995 if (value_format
& OTF_XAdvance
)
1996 ASET (val
, 2, make_number (value_record
->XAdvance
));
1997 if (value_format
& OTF_YAdvance
)
1998 ASET (val
, 3, make_number (value_record
->YAdvance
));
1999 if (value_format
& OTF_XPlaDevice
)
2000 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2001 if (value_format
& OTF_YPlaDevice
)
2002 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2003 if (value_format
& OTF_XAdvDevice
)
2004 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2005 if (value_format
& OTF_YAdvDevice
)
2006 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2011 font_otf_Anchor (anchor
)
2016 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2017 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2018 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2019 if (anchor
->AnchorFormat
== 2)
2020 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2023 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2024 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2028 #endif /* HAVE_LIBOTF */
2034 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2035 static int font_compare (const void *, const void *);
2036 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2040 font_rescale_ratio (Lisp_Object font_entity
)
2042 Lisp_Object tail
, elt
;
2043 Lisp_Object name
= Qnil
;
2045 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2048 if (FLOATP (XCDR (elt
)))
2050 if (STRINGP (XCAR (elt
)))
2053 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2054 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2055 return XFLOAT_DATA (XCDR (elt
));
2057 else if (FONT_SPEC_P (XCAR (elt
)))
2059 if (font_match_p (XCAR (elt
), font_entity
))
2060 return XFLOAT_DATA (XCDR (elt
));
2067 /* We sort fonts by scoring each of them against a specified
2068 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2069 the value is, the closer the font is to the font-spec.
2071 The lowest 2 bits of the score are used for driver type. The font
2072 available by the most preferred font driver is 0.
2074 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2075 WEIGHT, SLANT, WIDTH, and SIZE. */
2077 /* How many bits to shift to store the difference value of each font
2078 property in a score. Note that floats for FONT_TYPE_INDEX and
2079 FONT_REGISTRY_INDEX are not used. */
2080 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2082 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2083 The return value indicates how different ENTITY is compared with
2087 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2092 /* Score three style numeric fields. Maximum difference is 127. */
2093 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2094 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2096 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2097 - (XINT (spec_prop
[i
]) >> 8));
2100 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2103 /* Score the size. Maximum difference is 127. */
2104 i
= FONT_SIZE_INDEX
;
2105 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2106 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2108 /* We use the higher 6-bit for the actual size difference. The
2109 lowest bit is set if the DPI is different. */
2111 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2113 if (CONSP (Vface_font_rescale_alist
))
2114 pixel_size
*= font_rescale_ratio (entity
);
2115 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2119 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2120 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2122 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2123 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2125 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2132 /* Concatenate all elements of LIST into one vector. LIST is a list
2133 of font-entity vectors. */
2136 font_vconcat_entity_vectors (Lisp_Object list
)
2138 int nargs
= XINT (Flength (list
));
2139 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2142 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2143 args
[i
] = XCAR (list
);
2144 return Fvconcat (nargs
, args
);
2148 /* The structure for elements being sorted by qsort. */
2149 struct font_sort_data
2152 int font_driver_preference
;
2157 /* The comparison function for qsort. */
2160 font_compare (const void *d1
, const void *d2
)
2162 const struct font_sort_data
*data1
= d1
;
2163 const struct font_sort_data
*data2
= d2
;
2165 if (data1
->score
< data2
->score
)
2167 else if (data1
->score
> data2
->score
)
2169 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2173 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2174 If PREFER specifies a point-size, calculate the corresponding
2175 pixel-size from QCdpi property of PREFER or from the Y-resolution
2176 of FRAME before sorting.
2178 If BEST-ONLY is nonzero, return the best matching entity (that
2179 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2180 if BEST-ONLY is negative). Otherwise, return the sorted result as
2181 a single vector of font-entities.
2183 This function does no optimization for the case that the total
2184 number of elements is 1. The caller should avoid calling this in
2188 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2190 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2192 struct font_sort_data
*data
;
2193 unsigned best_score
;
2194 Lisp_Object best_entity
;
2195 struct frame
*f
= XFRAME (frame
);
2196 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2199 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2200 prefer_prop
[i
] = AREF (prefer
, i
);
2201 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2202 prefer_prop
[FONT_SIZE_INDEX
]
2203 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2205 if (NILP (XCDR (list
)))
2207 /* What we have to take care of is this single vector. */
2209 maxlen
= ASIZE (vec
);
2213 /* We don't have to perform sort, so there's no need of creating
2214 a single vector. But, we must find the length of the longest
2217 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2218 if (maxlen
< ASIZE (XCAR (tail
)))
2219 maxlen
= ASIZE (XCAR (tail
));
2223 /* We have to create a single vector to sort it. */
2224 vec
= font_vconcat_entity_vectors (list
);
2225 maxlen
= ASIZE (vec
);
2228 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2229 best_score
= 0xFFFFFFFF;
2232 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2234 int font_driver_preference
= 0;
2235 Lisp_Object current_font_driver
;
2241 /* We are sure that the length of VEC > 0. */
2242 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2243 /* Score the elements. */
2244 for (i
= 0; i
< len
; i
++)
2246 data
[i
].entity
= AREF (vec
, i
);
2248 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2250 ? font_score (data
[i
].entity
, prefer_prop
)
2252 if (best_only
&& best_score
> data
[i
].score
)
2254 best_score
= data
[i
].score
;
2255 best_entity
= data
[i
].entity
;
2256 if (best_score
== 0)
2259 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2261 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2262 font_driver_preference
++;
2264 data
[i
].font_driver_preference
= font_driver_preference
;
2267 /* Sort if necessary. */
2270 qsort (data
, len
, sizeof *data
, font_compare
);
2271 for (i
= 0; i
< len
; i
++)
2272 ASET (vec
, i
, data
[i
].entity
);
2281 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2286 /* API of Font Service Layer. */
2288 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2289 sort_shift_bits. Finternal_set_font_selection_order calls this
2290 function with font_sort_order after setting up it. */
2293 font_update_sort_order (int *order
)
2297 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2299 int xlfd_idx
= order
[i
];
2301 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2302 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2303 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2304 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2305 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2306 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2308 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2313 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2318 table
= assq_no_quit (script
, table
);
2321 table
= XCDR (table
);
2322 if (! NILP (langsys
))
2324 table
= assq_no_quit (langsys
, table
);
2330 val
= assq_no_quit (Qnil
, table
);
2332 table
= XCAR (table
);
2336 table
= XCDR (table
);
2337 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2339 if (NILP (XCAR (features
)))
2344 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2350 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2353 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2355 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2357 script
= XCAR (spec
);
2361 langsys
= XCAR (spec
);
2372 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2373 XCAR (otf_capability
)))
2375 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2376 XCDR (otf_capability
)))
2383 /* Check if FONT (font-entity or font-object) matches with the font
2384 specification SPEC. */
2387 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2389 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2390 Lisp_Object extra
, font_extra
;
2393 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2394 if (! NILP (AREF (spec
, i
))
2395 && ! NILP (AREF (font
, i
))
2396 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2398 props
= XFONT_SPEC (spec
)->props
;
2399 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2401 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2402 prop
[i
] = AREF (spec
, i
);
2403 prop
[FONT_SIZE_INDEX
]
2404 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2408 if (font_score (font
, props
) > 0)
2410 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2411 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2412 for (; CONSP (extra
); extra
= XCDR (extra
))
2414 Lisp_Object key
= XCAR (XCAR (extra
));
2415 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2417 if (EQ (key
, QClang
))
2419 val2
= assq_no_quit (key
, font_extra
);
2428 if (NILP (Fmemq (val
, val2
)))
2433 ? NILP (Fmemq (val
, XCDR (val2
)))
2437 else if (EQ (key
, QCscript
))
2439 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2445 /* All characters in the list must be supported. */
2446 for (; CONSP (val2
); val2
= XCDR (val2
))
2448 if (! NATNUMP (XCAR (val2
)))
2450 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2451 == FONT_INVALID_CODE
)
2455 else if (VECTORP (val2
))
2457 /* At most one character in the vector must be supported. */
2458 for (i
= 0; i
< ASIZE (val2
); i
++)
2460 if (! NATNUMP (AREF (val2
, i
)))
2462 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2463 != FONT_INVALID_CODE
)
2466 if (i
== ASIZE (val2
))
2471 else if (EQ (key
, QCotf
))
2475 if (! FONT_OBJECT_P (font
))
2477 fontp
= XFONT_OBJECT (font
);
2478 if (! fontp
->driver
->otf_capability
)
2480 val2
= fontp
->driver
->otf_capability (fontp
);
2481 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2492 Each font backend has the callback function get_cache, and it
2493 returns a cons cell of which cdr part can be freely used for
2494 caching fonts. The cons cell may be shared by multiple frames
2495 and/or multiple font drivers. So, we arrange the cdr part as this:
2497 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2499 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2500 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2501 cons (FONT-SPEC FONT-ENTITY ...). */
2503 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2504 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2505 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2506 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2507 struct font_driver
*);
2510 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2512 Lisp_Object cache
, val
;
2514 cache
= driver
->get_cache (f
);
2516 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2520 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2521 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2525 val
= XCDR (XCAR (val
));
2526 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2532 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2534 Lisp_Object cache
, val
, tmp
;
2537 cache
= driver
->get_cache (f
);
2539 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2540 cache
= val
, val
= XCDR (val
);
2541 font_assert (! NILP (val
));
2542 tmp
= XCDR (XCAR (val
));
2543 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2544 if (XINT (XCAR (tmp
)) == 0)
2546 font_clear_cache (f
, XCAR (val
), driver
);
2547 XSETCDR (cache
, XCDR (val
));
2553 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2555 Lisp_Object val
= driver
->get_cache (f
);
2556 Lisp_Object type
= driver
->type
;
2558 font_assert (CONSP (val
));
2559 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2560 font_assert (CONSP (val
));
2561 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2562 val
= XCDR (XCAR (val
));
2566 static int num_fonts
;
2569 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2571 Lisp_Object tail
, elt
;
2572 Lisp_Object tail2
, entity
;
2574 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2575 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2578 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2579 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2581 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2583 entity
= XCAR (tail2
);
2585 if (FONT_ENTITY_P (entity
)
2586 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2588 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2590 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2592 Lisp_Object val
= XCAR (objlist
);
2593 struct font
*font
= XFONT_OBJECT (val
);
2595 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2597 font_assert (font
&& driver
== font
->driver
);
2598 driver
->close (f
, font
);
2602 if (driver
->free_entity
)
2603 driver
->free_entity (entity
);
2608 XSETCDR (cache
, Qnil
);
2612 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2614 /* Check each font-entity in VEC, and return a list of font-entities
2615 that satisfy these conditions:
2616 (1) matches with SPEC and SIZE if SPEC is not nil, and
2617 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2621 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2623 Lisp_Object entity
, val
;
2624 enum font_property_index prop
;
2627 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2629 entity
= AREF (vec
, i
);
2630 if (! NILP (Vface_ignored_fonts
))
2633 Lisp_Object tail
, regexp
;
2635 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2637 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2639 regexp
= XCAR (tail
);
2640 if (STRINGP (regexp
)
2641 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2650 val
= Fcons (entity
, val
);
2653 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2654 if (INTEGERP (AREF (spec
, prop
))
2655 && ((XINT (AREF (spec
, prop
)) >> 8)
2656 != (XINT (AREF (entity
, prop
)) >> 8)))
2657 prop
= FONT_SPEC_MAX
;
2658 if (prop
< FONT_SPEC_MAX
2660 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2662 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2665 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2666 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2667 prop
= FONT_SPEC_MAX
;
2669 if (prop
< FONT_SPEC_MAX
2670 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2671 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2672 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2673 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2674 prop
= FONT_SPEC_MAX
;
2675 if (prop
< FONT_SPEC_MAX
2676 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2677 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2678 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2679 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2680 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2681 prop
= FONT_SPEC_MAX
;
2682 if (prop
< FONT_SPEC_MAX
)
2683 val
= Fcons (entity
, val
);
2685 return (Fvconcat (1, &val
));
2689 /* Return a list of vectors of font-entities matching with SPEC on
2690 FRAME. Each elements in the list is a vector of entities from the
2691 same font-driver. */
2694 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2696 FRAME_PTR f
= XFRAME (frame
);
2697 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2698 Lisp_Object ftype
, val
;
2699 Lisp_Object list
= Qnil
;
2701 int need_filtering
= 0;
2704 font_assert (FONT_SPEC_P (spec
));
2706 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2707 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2708 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2709 size
= font_pixel_size (f
, spec
);
2713 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2714 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2715 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2716 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2717 if (i
!= FONT_SPACING_INDEX
)
2719 ASET (scratch_font_spec
, i
, Qnil
);
2720 if (! NILP (AREF (spec
, i
)))
2723 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2724 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2726 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2728 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2730 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2732 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2733 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2740 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2744 val
= Fvconcat (1, &val
);
2745 copy
= copy_font_spec (scratch_font_spec
);
2746 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2747 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2751 || ! NILP (Vface_ignored_fonts
)))
2752 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2753 if (ASIZE (val
) > 0)
2754 list
= Fcons (val
, list
);
2757 list
= Fnreverse (list
);
2758 FONT_ADD_LOG ("list", spec
, list
);
2763 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2764 nil, is an array of face's attributes, which specifies preferred
2765 font-related attributes. */
2768 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2770 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2771 Lisp_Object ftype
, size
, entity
;
2773 Lisp_Object work
= copy_font_spec (spec
);
2775 XSETFRAME (frame
, f
);
2776 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2777 size
= AREF (spec
, FONT_SIZE_INDEX
);
2780 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2781 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2782 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2783 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2786 for (; driver_list
; driver_list
= driver_list
->next
)
2788 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2790 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2793 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2794 entity
= assoc_no_quit (work
, XCDR (cache
));
2796 entity
= XCDR (entity
);
2799 entity
= driver_list
->driver
->match (frame
, work
);
2800 copy
= copy_font_spec (work
);
2801 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2802 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2804 if (! NILP (entity
))
2807 FONT_ADD_LOG ("match", work
, entity
);
2812 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2813 opened font object. */
2816 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2818 struct font_driver_list
*driver_list
;
2819 Lisp_Object objlist
, size
, val
, font_object
;
2821 int min_width
, height
;
2822 int scaled_pixel_size
= pixel_size
;
2824 font_assert (FONT_ENTITY_P (entity
));
2825 size
= AREF (entity
, FONT_SIZE_INDEX
);
2826 if (XINT (size
) != 0)
2827 scaled_pixel_size
= pixel_size
= XINT (size
);
2828 else if (CONSP (Vface_font_rescale_alist
))
2829 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2831 val
= AREF (entity
, FONT_TYPE_INDEX
);
2832 for (driver_list
= f
->font_driver_list
;
2833 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2834 driver_list
= driver_list
->next
);
2838 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2839 objlist
= XCDR (objlist
))
2841 Lisp_Object fn
= XCAR (objlist
);
2842 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2843 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2845 if (driver_list
->driver
->cached_font_ok
== NULL
2846 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2851 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2852 if (!NILP (font_object
))
2853 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2854 FONT_ADD_LOG ("open", entity
, font_object
);
2855 if (NILP (font_object
))
2857 ASET (entity
, FONT_OBJLIST_INDEX
,
2858 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2861 font
= XFONT_OBJECT (font_object
);
2862 min_width
= (font
->min_width
? font
->min_width
2863 : font
->average_width
? font
->average_width
2864 : font
->space_width
? font
->space_width
2866 height
= (font
->height
? font
->height
: 1);
2867 #ifdef HAVE_WINDOW_SYSTEM
2868 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2869 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2871 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2872 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2873 fonts_changed_p
= 1;
2877 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2878 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2879 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2880 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2888 /* Close FONT_OBJECT that is opened on frame F. */
2891 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2893 struct font
*font
= XFONT_OBJECT (font_object
);
2895 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2896 /* Already closed. */
2898 FONT_ADD_LOG ("close", font_object
, Qnil
);
2899 font
->driver
->close (f
, font
);
2900 #ifdef HAVE_WINDOW_SYSTEM
2901 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2902 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2908 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2909 FONT is a font-entity and it must be opened to check. */
2912 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2916 if (FONT_ENTITY_P (font
))
2918 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2919 struct font_driver_list
*driver_list
;
2921 for (driver_list
= f
->font_driver_list
;
2922 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2923 driver_list
= driver_list
->next
);
2926 if (! driver_list
->driver
->has_char
)
2928 return driver_list
->driver
->has_char (font
, c
);
2931 font_assert (FONT_OBJECT_P (font
));
2932 fontp
= XFONT_OBJECT (font
);
2933 if (fontp
->driver
->has_char
)
2935 int result
= fontp
->driver
->has_char (font
, c
);
2940 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2944 /* Return the glyph ID of FONT_OBJECT for character C. */
2947 font_encode_char (Lisp_Object font_object
, int c
)
2951 font_assert (FONT_OBJECT_P (font_object
));
2952 font
= XFONT_OBJECT (font_object
);
2953 return font
->driver
->encode_char (font
, c
);
2957 /* Return the name of FONT_OBJECT. */
2960 font_get_name (Lisp_Object font_object
)
2962 font_assert (FONT_OBJECT_P (font_object
));
2963 return AREF (font_object
, FONT_NAME_INDEX
);
2967 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2968 could not be parsed by font_parse_name, return Qnil. */
2971 font_spec_from_name (Lisp_Object font_name
)
2973 Lisp_Object spec
= Ffont_spec (0, NULL
);
2975 CHECK_STRING (font_name
);
2976 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2978 font_put_extra (spec
, QCname
, font_name
);
2979 font_put_extra (spec
, QCuser_spec
, font_name
);
2985 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2987 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2992 if (! NILP (Ffont_get (font
, QCname
)))
2994 font
= copy_font_spec (font
);
2995 font_put_extra (font
, QCname
, Qnil
);
2998 if (NILP (AREF (font
, prop
))
2999 && prop
!= FONT_FAMILY_INDEX
3000 && prop
!= FONT_FOUNDRY_INDEX
3001 && prop
!= FONT_WIDTH_INDEX
3002 && prop
!= FONT_SIZE_INDEX
)
3004 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3005 font
= copy_font_spec (font
);
3006 ASET (font
, prop
, Qnil
);
3007 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3009 if (prop
== FONT_FAMILY_INDEX
)
3011 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3012 /* If we are setting the font family, we must also clear
3013 FONT_WIDTH_INDEX to avoid rejecting families that lack
3014 support for some widths. */
3015 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3017 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3018 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3019 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3020 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3021 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3022 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3024 else if (prop
== FONT_SIZE_INDEX
)
3026 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3027 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3028 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3030 else if (prop
== FONT_WIDTH_INDEX
)
3031 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3032 attrs
[LFACE_FONT_INDEX
] = font
;
3035 /* Select a font from ENTITIES (list of font-entity vectors) that
3036 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3039 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3041 Lisp_Object font_entity
;
3044 FRAME_PTR f
= XFRAME (frame
);
3046 if (NILP (XCDR (entities
))
3047 && ASIZE (XCAR (entities
)) == 1)
3049 font_entity
= AREF (XCAR (entities
), 0);
3051 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3056 /* Sort fonts by properties specified in ATTRS. */
3057 prefer
= scratch_font_prefer
;
3059 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3060 ASET (prefer
, i
, Qnil
);
3061 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3063 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3065 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3066 ASET (prefer
, i
, AREF (face_font
, i
));
3068 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3069 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3070 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3071 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3072 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3073 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3074 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3076 return font_sort_entities (entities
, prefer
, frame
, c
);
3079 /* Return a font-entity that satisfies SPEC and is the best match for
3080 face's font related attributes in ATTRS. C, if not negative, is a
3081 character that the entity must support. */
3084 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3087 Lisp_Object frame
, entities
, val
;
3088 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3092 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3093 if (NILP (registry
[0]))
3095 registry
[0] = DEFAULT_ENCODING
;
3096 registry
[1] = Qascii_0
;
3097 registry
[2] = null_vector
;
3100 registry
[1] = null_vector
;
3102 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3104 struct charset
*encoding
, *repertory
;
3106 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3107 &encoding
, &repertory
) < 0)
3110 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3112 else if (c
> encoding
->max_char
)
3116 work
= copy_font_spec (spec
);
3117 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3118 XSETFRAME (frame
, f
);
3119 pixel_size
= font_pixel_size (f
, spec
);
3120 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3122 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3124 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3126 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3127 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3128 if (! NILP (foundry
[0]))
3129 foundry
[1] = null_vector
;
3130 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3132 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3133 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3135 foundry
[2] = null_vector
;
3138 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3140 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3141 if (! NILP (adstyle
[0]))
3142 adstyle
[1] = null_vector
;
3143 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3145 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3147 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3149 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3151 adstyle
[2] = null_vector
;
3154 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3157 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3160 val
= AREF (work
, FONT_FAMILY_INDEX
);
3161 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3163 val
= attrs
[LFACE_FAMILY_INDEX
];
3164 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3168 family
= alloca ((sizeof family
[0]) * 2);
3170 family
[1] = null_vector
; /* terminator. */
3175 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3176 /* Font family names are case-sensitive under NS. */
3184 if (! NILP (alters
))
3186 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3187 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3188 family
[i
] = XCAR (alters
);
3189 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3191 family
[i
] = null_vector
;
3195 family
= alloca ((sizeof family
[0]) * 3);
3198 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3200 family
[i
] = null_vector
;
3204 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3206 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3207 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3209 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3210 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3212 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3213 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3215 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3216 entities
= font_list_entities (frame
, work
);
3217 if (! NILP (entities
))
3219 val
= font_select_entity (frame
, entities
,
3220 attrs
, pixel_size
, c
);
3233 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3237 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3238 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3239 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3240 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3241 size
= font_pixel_size (f
, spec
);
3245 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3246 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3249 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3250 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3251 if (INTEGERP (height
))
3254 abort(); /* We should never end up here. */
3258 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3262 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3263 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3267 return font_open_entity (f
, entity
, size
);
3271 /* Find a font that satisfies SPEC and is the best match for
3272 face's attributes in ATTRS on FRAME, and return the opened
3276 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3278 Lisp_Object entity
, name
;
3280 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3283 /* No font is listed for SPEC, but each font-backend may have
3284 different criteria about "font matching". So, try it. */
3285 entity
= font_matching_entity (f
, attrs
, spec
);
3289 /* Don't lose the original name that was put in initially. We need
3290 it to re-apply the font when font parameters (like hinting or dpi) have
3292 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3295 name
= Ffont_get (spec
, QCuser_spec
);
3296 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3302 /* Make FACE on frame F ready to use the font opened for FACE. */
3305 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3307 if (face
->font
->driver
->prepare_face
)
3308 face
->font
->driver
->prepare_face (f
, face
);
3312 /* Make FACE on frame F stop using the font opened for FACE. */
3315 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3317 if (face
->font
->driver
->done_face
)
3318 face
->font
->driver
->done_face (f
, face
);
3323 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3324 font is found, return Qnil. */
3327 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3329 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3331 /* We set up the default font-related attributes of a face to prefer
3333 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3334 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3335 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3337 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3339 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3341 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3343 return font_load_for_lface (f
, attrs
, spec
);
3347 /* Open a font that matches NAME on frame F. If no proper font is
3348 found, return Qnil. */
3351 font_open_by_name (FRAME_PTR f
, const char *name
)
3353 Lisp_Object args
[2];
3354 Lisp_Object spec
, ret
;
3357 args
[1] = make_unibyte_string (name
, strlen (name
));
3358 spec
= Ffont_spec (2, args
);
3359 ret
= font_open_by_spec (f
, spec
);
3360 /* Do not lose name originally put in. */
3362 font_put_extra (ret
, QCuser_spec
, args
[1]);
3368 /* Register font-driver DRIVER. This function is used in two ways.
3370 The first is with frame F non-NULL. In this case, make DRIVER
3371 available (but not yet activated) on F. All frame creators
3372 (e.g. Fx_create_frame) must call this function at least once with
3373 an available font-driver.
3375 The second is with frame F NULL. In this case, DRIVER is globally
3376 registered in the variable `font_driver_list'. All font-driver
3377 implementations must call this function in its syms_of_XXXX
3378 (e.g. syms_of_xfont). */
3381 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3383 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3384 struct font_driver_list
*prev
, *list
;
3386 if (f
&& ! driver
->draw
)
3387 error ("Unusable font driver for a frame: %s",
3388 SDATA (SYMBOL_NAME (driver
->type
)));
3390 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3391 if (EQ (list
->driver
->type
, driver
->type
))
3392 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3394 list
= xmalloc (sizeof (struct font_driver_list
));
3396 list
->driver
= driver
;
3401 f
->font_driver_list
= list
;
3403 font_driver_list
= list
;
3409 free_font_driver_list (FRAME_PTR f
)
3411 struct font_driver_list
*list
, *next
;
3413 for (list
= f
->font_driver_list
; list
; list
= next
)
3418 f
->font_driver_list
= NULL
;
3422 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3423 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3424 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3426 A caller must free all realized faces if any in advance. The
3427 return value is a list of font backends actually made used on
3431 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3433 Lisp_Object active_drivers
= Qnil
;
3434 struct font_driver_list
*list
;
3436 /* At first, turn off non-requested drivers, and turn on requested
3438 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3440 struct font_driver
*driver
= list
->driver
;
3441 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3446 if (driver
->end_for_frame
)
3447 driver
->end_for_frame (f
);
3448 font_finish_cache (f
, driver
);
3453 if (! driver
->start_for_frame
3454 || driver
->start_for_frame (f
) == 0)
3456 font_prepare_cache (f
, driver
);
3463 if (NILP (new_drivers
))
3466 if (! EQ (new_drivers
, Qt
))
3468 /* Re-order the driver list according to new_drivers. */
3469 struct font_driver_list
**list_table
, **next
;
3473 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3474 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3476 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3477 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3480 list_table
[i
++] = list
;
3482 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3484 list_table
[i
++] = list
;
3485 list_table
[i
] = NULL
;
3487 next
= &f
->font_driver_list
;
3488 for (i
= 0; list_table
[i
]; i
++)
3490 *next
= list_table
[i
];
3491 next
= &(*next
)->next
;
3495 if (! f
->font_driver_list
->on
)
3496 { /* None of the drivers is enabled: enable them all.
3497 Happens if you set the list of drivers to (xft x) in your .emacs
3498 and then use it under w32 or ns. */
3499 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3501 struct font_driver
*driver
= list
->driver
;
3502 eassert (! list
->on
);
3503 if (! driver
->start_for_frame
3504 || driver
->start_for_frame (f
) == 0)
3506 font_prepare_cache (f
, driver
);
3513 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3515 active_drivers
= nconc2 (active_drivers
,
3516 Fcons (list
->driver
->type
, Qnil
));
3517 return active_drivers
;
3521 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3523 struct font_data_list
*list
, *prev
;
3525 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3526 prev
= list
, list
= list
->next
)
3527 if (list
->driver
== driver
)
3534 prev
->next
= list
->next
;
3536 f
->font_data_list
= list
->next
;
3544 list
= xmalloc (sizeof (struct font_data_list
));
3545 list
->driver
= driver
;
3546 list
->next
= f
->font_data_list
;
3547 f
->font_data_list
= list
;
3555 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3557 struct font_data_list
*list
;
3559 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3560 if (list
->driver
== driver
)
3568 /* Sets attributes on a font. Any properties that appear in ALIST and
3569 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3570 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3571 arrays of strings. This function is intended for use by the font
3572 drivers to implement their specific font_filter_properties. */
3574 font_filter_properties (Lisp_Object font
,
3576 const char *const boolean_properties
[],
3577 const char *const non_boolean_properties
[])
3582 /* Set boolean values to Qt or Qnil */
3583 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3584 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3586 Lisp_Object key
= XCAR (XCAR (it
));
3587 Lisp_Object val
= XCDR (XCAR (it
));
3588 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3590 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3592 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3593 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3596 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3597 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3598 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3599 || strcmp ("Off", str
) == 0)
3604 Ffont_put (font
, key
, val
);
3608 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3609 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3611 Lisp_Object key
= XCAR (XCAR (it
));
3612 Lisp_Object val
= XCDR (XCAR (it
));
3613 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3614 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3615 Ffont_put (font
, key
, val
);
3620 /* Return the font used to draw character C by FACE at buffer position
3621 POS in window W. If STRING is non-nil, it is a string containing C
3622 at index POS. If C is negative, get C from the current buffer or
3626 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3631 Lisp_Object font_object
;
3633 multibyte
= (NILP (string
)
3634 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3635 : STRING_MULTIBYTE (string
));
3642 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3644 c
= FETCH_CHAR (pos_byte
);
3647 c
= FETCH_BYTE (pos
);
3653 multibyte
= STRING_MULTIBYTE (string
);
3656 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3658 str
= SDATA (string
) + pos_byte
;
3659 c
= STRING_CHAR (str
);
3662 c
= SDATA (string
)[pos
];
3666 f
= XFRAME (w
->frame
);
3667 if (! FRAME_WINDOW_P (f
))
3674 if (STRINGP (string
))
3675 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3676 DEFAULT_FACE_ID
, 0);
3678 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3680 face
= FACE_FROM_ID (f
, face_id
);
3684 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3685 face
= FACE_FROM_ID (f
, face_id
);
3690 XSETFONT (font_object
, face
->font
);
3695 #ifdef HAVE_WINDOW_SYSTEM
3697 /* Check how many characters after POS (at most to *LIMIT) can be
3698 displayed by the same font in the window W. FACE, if non-NULL, is
3699 the face selected for the character at POS. If STRING is not nil,
3700 it is the string to check instead of the current buffer. In that
3701 case, FACE must be not NULL.
3703 The return value is the font-object for the character at POS.
3704 *LIMIT is set to the position where that font can't be used.
3706 It is assured that the current buffer (or STRING) is multibyte. */
3709 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3711 EMACS_INT pos_byte
, ignore
;
3713 Lisp_Object font_object
= Qnil
;
3717 pos_byte
= CHAR_TO_BYTE (pos
);
3722 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3724 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3730 pos_byte
= string_char_to_byte (string
, pos
);
3733 while (pos
< *limit
)
3735 Lisp_Object category
;
3738 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3740 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3741 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3742 if (INTEGERP (category
)
3743 && (XINT (category
) == UNICODE_CATEGORY_Cf
3744 || CHAR_VARIATION_SELECTOR_P (c
)))
3746 if (NILP (font_object
))
3748 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3749 if (NILP (font_object
))
3753 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3763 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3764 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3765 Return nil otherwise.
3766 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3767 which kind of font it is. It must be one of `font-spec', `font-entity',
3769 (Lisp_Object object
, Lisp_Object extra_type
)
3771 if (NILP (extra_type
))
3772 return (FONTP (object
) ? Qt
: Qnil
);
3773 if (EQ (extra_type
, Qfont_spec
))
3774 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3775 if (EQ (extra_type
, Qfont_entity
))
3776 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3777 if (EQ (extra_type
, Qfont_object
))
3778 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3779 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3782 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3783 doc
: /* Return a newly created font-spec with arguments as properties.
3785 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3786 valid font property name listed below:
3788 `:family', `:weight', `:slant', `:width'
3790 They are the same as face attributes of the same name. See
3791 `set-face-attribute'.
3795 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3799 VALUE must be a string or a symbol specifying the additional
3800 typographic style information of a font, e.g. ``sans''.
3804 VALUE must be a string or a symbol specifying the charset registry and
3805 encoding of a font, e.g. ``iso8859-1''.
3809 VALUE must be a non-negative integer or a floating point number
3810 specifying the font size. It specifies the font size in pixels (if
3811 VALUE is an integer), or in points (if VALUE is a float).
3815 VALUE must be a string of XLFD-style or fontconfig-style font name.
3819 VALUE must be a symbol representing a script that the font must
3820 support. It may be a symbol representing a subgroup of a script
3821 listed in the variable `script-representative-chars'.
3825 VALUE must be a symbol of two-letter ISO-639 language names,
3830 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3831 required OpenType features.
3833 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3834 LANGSYS-TAG: OpenType language system tag symbol,
3835 or nil for the default language system.
3836 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3837 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3839 GSUB and GPOS may contain `nil' element. In such a case, the font
3840 must not have any of the remaining elements.
3842 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3843 be an OpenType font whose GPOS table of `thai' script's default
3844 language system must contain `mark' feature.
3846 usage: (font-spec ARGS...) */)
3847 (ptrdiff_t nargs
, Lisp_Object
*args
)
3849 Lisp_Object spec
= font_make_spec ();
3852 for (i
= 0; i
< nargs
; i
+= 2)
3854 Lisp_Object key
= args
[i
], val
;
3858 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3861 if (EQ (key
, QCname
))
3864 font_parse_name (SSDATA (val
), spec
);
3865 font_put_extra (spec
, key
, val
);
3869 int idx
= get_font_prop_index (key
);
3873 val
= font_prop_validate (idx
, Qnil
, val
);
3874 if (idx
< FONT_EXTRA_INDEX
)
3875 ASET (spec
, idx
, val
);
3877 font_put_extra (spec
, key
, val
);
3880 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3886 /* Return a copy of FONT as a font-spec. */
3888 copy_font_spec (Lisp_Object font
)
3890 Lisp_Object new_spec
, tail
, prev
, extra
;
3894 new_spec
= font_make_spec ();
3895 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3896 ASET (new_spec
, i
, AREF (font
, i
));
3897 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3898 /* We must remove :font-entity property. */
3899 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3900 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3903 extra
= XCDR (extra
);
3905 XSETCDR (prev
, XCDR (tail
));
3908 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3912 /* Merge font-specs FROM and TO, and return a new font-spec.
3913 Every specified property in FROM overrides the corresponding
3916 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3918 Lisp_Object extra
, tail
;
3923 to
= copy_font_spec (to
);
3924 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3925 ASET (to
, i
, AREF (from
, i
));
3926 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3927 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3928 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3930 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3933 XSETCDR (slot
, XCDR (XCAR (tail
)));
3935 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3937 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3941 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3942 doc
: /* Return the value of FONT's property KEY.
3943 FONT is a font-spec, a font-entity, or a font-object.
3944 KEY is any symbol, but these are reserved for specific meanings:
3945 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3946 :size, :name, :script, :otf
3947 See the documentation of `font-spec' for their meanings.
3948 In addition, if FONT is a font-entity or a font-object, values of
3949 :script and :otf are different from those of a font-spec as below:
3951 The value of :script may be a list of scripts that are supported by the font.
3953 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3954 representing the OpenType features supported by the font by this form:
3955 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3956 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3958 (Lisp_Object font
, Lisp_Object key
)
3966 idx
= get_font_prop_index (key
);
3967 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3968 return font_style_symbolic (font
, idx
, 0);
3969 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3970 return AREF (font
, idx
);
3971 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3972 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3974 struct font
*fontp
= XFONT_OBJECT (font
);
3976 if (fontp
->driver
->otf_capability
)
3977 val
= fontp
->driver
->otf_capability (fontp
);
3979 val
= Fcons (Qnil
, Qnil
);
3986 #ifdef HAVE_WINDOW_SYSTEM
3988 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3989 doc
: /* Return a plist of face attributes generated by FONT.
3990 FONT is a font name, a font-spec, a font-entity, or a font-object.
3991 The return value is a list of the form
3993 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3995 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3996 compatible with `set-face-attribute'. Some of these key-attribute pairs
3997 may be omitted from the list if they are not specified by FONT.
3999 The optional argument FRAME specifies the frame that the face attributes
4000 are to be displayed on. If omitted, the selected frame is used. */)
4001 (Lisp_Object font
, Lisp_Object frame
)
4004 Lisp_Object plist
[10];
4009 frame
= selected_frame
;
4010 CHECK_LIVE_FRAME (frame
);
4015 int fontset
= fs_query_fontset (font
, 0);
4016 Lisp_Object name
= font
;
4018 font
= fontset_ascii (fontset
);
4019 font
= font_spec_from_name (name
);
4021 signal_error ("Invalid font name", name
);
4023 else if (! FONTP (font
))
4024 signal_error ("Invalid font object", font
);
4026 val
= AREF (font
, FONT_FAMILY_INDEX
);
4029 plist
[n
++] = QCfamily
;
4030 plist
[n
++] = SYMBOL_NAME (val
);
4033 val
= AREF (font
, FONT_SIZE_INDEX
);
4036 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4037 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4038 plist
[n
++] = QCheight
;
4039 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4041 else if (FLOATP (val
))
4043 plist
[n
++] = QCheight
;
4044 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4047 val
= FONT_WEIGHT_FOR_FACE (font
);
4050 plist
[n
++] = QCweight
;
4054 val
= FONT_SLANT_FOR_FACE (font
);
4057 plist
[n
++] = QCslant
;
4061 val
= FONT_WIDTH_FOR_FACE (font
);
4064 plist
[n
++] = QCwidth
;
4068 return Flist (n
, plist
);
4073 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4074 doc
: /* Set one property of FONT: give property KEY value VAL.
4075 FONT is a font-spec, a font-entity, or a font-object.
4077 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4078 accepted by the function `font-spec' (which see), VAL must be what
4079 allowed in `font-spec'.
4081 If FONT is a font-entity or a font-object, KEY must not be the one
4082 accepted by `font-spec'. */)
4083 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4087 idx
= get_font_prop_index (prop
);
4088 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4090 CHECK_FONT_SPEC (font
);
4091 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4095 if (EQ (prop
, QCname
)
4096 || EQ (prop
, QCscript
)
4097 || EQ (prop
, QClang
)
4098 || EQ (prop
, QCotf
))
4099 CHECK_FONT_SPEC (font
);
4102 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4107 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4108 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4109 Optional 2nd argument FRAME specifies the target frame.
4110 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4111 Optional 4th argument PREFER, if non-nil, is a font-spec to
4112 control the order of the returned list. Fonts are sorted by
4113 how close they are to PREFER. */)
4114 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4116 Lisp_Object vec
, list
;
4120 frame
= selected_frame
;
4121 CHECK_LIVE_FRAME (frame
);
4122 CHECK_FONT_SPEC (font_spec
);
4130 if (! NILP (prefer
))
4131 CHECK_FONT_SPEC (prefer
);
4133 list
= font_list_entities (frame
, font_spec
);
4136 if (NILP (XCDR (list
))
4137 && ASIZE (XCAR (list
)) == 1)
4138 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4140 if (! NILP (prefer
))
4141 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4143 vec
= font_vconcat_entity_vectors (list
);
4144 if (n
== 0 || n
>= ASIZE (vec
))
4146 Lisp_Object args
[2];
4150 list
= Fappend (2, args
);
4154 for (list
= Qnil
, n
--; n
>= 0; n
--)
4155 list
= Fcons (AREF (vec
, n
), list
);
4160 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4161 doc
: /* List available font families on the current frame.
4162 Optional argument FRAME, if non-nil, specifies the target frame. */)
4166 struct font_driver_list
*driver_list
;
4170 frame
= selected_frame
;
4171 CHECK_LIVE_FRAME (frame
);
4174 for (driver_list
= f
->font_driver_list
; driver_list
;
4175 driver_list
= driver_list
->next
)
4176 if (driver_list
->driver
->list_family
)
4178 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4179 Lisp_Object tail
= list
;
4181 for (; CONSP (val
); val
= XCDR (val
))
4182 if (NILP (Fmemq (XCAR (val
), tail
))
4183 && SYMBOLP (XCAR (val
)))
4184 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4189 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4190 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4191 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4192 (Lisp_Object font_spec
, Lisp_Object frame
)
4194 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4201 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4202 doc
: /* Return XLFD name of FONT.
4203 FONT is a font-spec, font-entity, or font-object.
4204 If the name is too long for XLFD (maximum 255 chars), return nil.
4205 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4206 the consecutive wildcards are folded into one. */)
4207 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4214 if (FONT_OBJECT_P (font
))
4216 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4218 if (STRINGP (font_name
)
4219 && SDATA (font_name
)[0] == '-')
4221 if (NILP (fold_wildcards
))
4223 strcpy (name
, SSDATA (font_name
));
4226 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4228 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4231 if (! NILP (fold_wildcards
))
4233 char *p0
= name
, *p1
;
4235 while ((p1
= strstr (p0
, "-*-*")))
4237 strcpy (p1
, p1
+ 2);
4242 return build_string (name
);
4245 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4246 doc
: /* Clear font cache. */)
4249 Lisp_Object list
, frame
;
4251 FOR_EACH_FRAME (list
, frame
)
4253 FRAME_PTR f
= XFRAME (frame
);
4254 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4256 for (; driver_list
; driver_list
= driver_list
->next
)
4257 if (driver_list
->on
)
4259 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4260 Lisp_Object val
, tmp
;
4264 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4266 font_assert (! NILP (val
));
4267 tmp
= XCDR (XCAR (val
));
4268 if (XINT (XCAR (tmp
)) == 0)
4270 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4271 XSETCDR (cache
, XCDR (val
));
4281 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4283 struct font
*font
= XFONT_OBJECT (font_object
);
4285 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4286 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4287 struct font_metrics metrics
;
4289 LGLYPH_SET_CODE (glyph
, ecode
);
4291 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4292 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4293 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4294 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4295 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4296 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4300 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4301 doc
: /* Shape the glyph-string GSTRING.
4302 Shaping means substituting glyphs and/or adjusting positions of glyphs
4303 to get the correct visual image of character sequences set in the
4304 header of the glyph-string.
4306 If the shaping was successful, the value is GSTRING itself or a newly
4307 created glyph-string. Otherwise, the value is nil. */)
4308 (Lisp_Object gstring
)
4311 Lisp_Object font_object
, n
, glyph
;
4312 EMACS_INT i
, j
, from
, to
;
4314 if (! composition_gstring_p (gstring
))
4315 signal_error ("Invalid glyph-string: ", gstring
);
4316 if (! NILP (LGSTRING_ID (gstring
)))
4318 font_object
= LGSTRING_FONT (gstring
);
4319 CHECK_FONT_OBJECT (font_object
);
4320 font
= XFONT_OBJECT (font_object
);
4321 if (! font
->driver
->shape
)
4324 /* Try at most three times with larger gstring each time. */
4325 for (i
= 0; i
< 3; i
++)
4327 n
= font
->driver
->shape (gstring
);
4330 gstring
= larger_vector (gstring
,
4331 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4334 if (i
== 3 || XINT (n
) == 0)
4336 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4337 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4339 glyph
= LGSTRING_GLYPH (gstring
, 0);
4340 from
= LGLYPH_FROM (glyph
);
4341 to
= LGLYPH_TO (glyph
);
4342 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4344 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4348 if (NILP (LGLYPH_ADJUSTMENT (this)))
4353 glyph
= LGSTRING_GLYPH (gstring
, j
);
4354 LGLYPH_SET_FROM (glyph
, from
);
4355 LGLYPH_SET_TO (glyph
, to
);
4357 from
= LGLYPH_FROM (this);
4358 to
= LGLYPH_TO (this);
4363 if (from
> LGLYPH_FROM (this))
4364 from
= LGLYPH_FROM (this);
4365 if (to
< LGLYPH_TO (this))
4366 to
= LGLYPH_TO (this);
4372 glyph
= LGSTRING_GLYPH (gstring
, j
);
4373 LGLYPH_SET_FROM (glyph
, from
);
4374 LGLYPH_SET_TO (glyph
, to
);
4376 return composition_gstring_put_cache (gstring
, XINT (n
));
4379 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4381 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4382 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4384 VARIATION-SELECTOR is a character code of variation selection
4385 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4386 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4387 (Lisp_Object font_object
, Lisp_Object character
)
4389 unsigned variations
[256];
4394 CHECK_FONT_OBJECT (font_object
);
4395 CHECK_CHARACTER (character
);
4396 font
= XFONT_OBJECT (font_object
);
4397 if (! font
->driver
->get_variation_glyphs
)
4399 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4403 for (i
= 0; i
< 255; i
++)
4406 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4407 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4408 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4415 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4416 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4417 OTF-FEATURES specifies which features to apply in this format:
4418 (SCRIPT LANGSYS GSUB GPOS)
4420 SCRIPT is a symbol specifying a script tag of OpenType,
4421 LANGSYS is a symbol specifying a langsys tag of OpenType,
4422 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4424 If LANGYS is nil, the default langsys is selected.
4426 The features are applied in the order they appear in the list. The
4427 symbol `*' means to apply all available features not present in this
4428 list, and the remaining features are ignored. For instance, (vatu
4429 pstf * haln) is to apply vatu and pstf in this order, then to apply
4430 all available features other than vatu, pstf, and haln.
4432 The features are applied to the glyphs in the range FROM and TO of
4433 the glyph-string GSTRING-IN.
4435 If some feature is actually applicable, the resulting glyphs are
4436 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4437 this case, the value is the number of produced glyphs.
4439 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4442 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4443 produced in GSTRING-OUT, and the value is nil.
4445 See the documentation of `composition-get-gstring' for the format of
4447 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4449 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4454 check_otf_features (otf_features
);
4455 CHECK_FONT_OBJECT (font_object
);
4456 font
= XFONT_OBJECT (font_object
);
4457 if (! font
->driver
->otf_drive
)
4458 error ("Font backend %s can't drive OpenType GSUB table",
4459 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4460 CHECK_CONS (otf_features
);
4461 CHECK_SYMBOL (XCAR (otf_features
));
4462 val
= XCDR (otf_features
);
4463 CHECK_SYMBOL (XCAR (val
));
4464 val
= XCDR (otf_features
);
4467 len
= check_gstring (gstring_in
);
4468 CHECK_VECTOR (gstring_out
);
4469 CHECK_NATNUM (from
);
4471 CHECK_NATNUM (index
);
4473 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4474 args_out_of_range_3 (from
, to
, make_number (len
));
4475 if (XINT (index
) >= ASIZE (gstring_out
))
4476 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4477 num
= font
->driver
->otf_drive (font
, otf_features
,
4478 gstring_in
, XINT (from
), XINT (to
),
4479 gstring_out
, XINT (index
), 0);
4482 return make_number (num
);
4485 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4487 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4488 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4490 (SCRIPT LANGSYS FEATURE ...)
4491 See the documentation of `font-drive-otf' for more detail.
4493 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4494 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4495 character code corresponding to the glyph or nil if there's no
4496 corresponding character. */)
4497 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4500 Lisp_Object gstring_in
, gstring_out
, g
;
4501 Lisp_Object alternates
;
4504 CHECK_FONT_GET_OBJECT (font_object
, font
);
4505 if (! font
->driver
->otf_drive
)
4506 error ("Font backend %s can't drive OpenType GSUB table",
4507 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4508 CHECK_CHARACTER (character
);
4509 CHECK_CONS (otf_features
);
4511 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4512 g
= LGSTRING_GLYPH (gstring_in
, 0);
4513 LGLYPH_SET_CHAR (g
, XINT (character
));
4514 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4515 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4516 gstring_out
, 0, 1)) < 0)
4517 gstring_out
= Ffont_make_gstring (font_object
,
4518 make_number (ASIZE (gstring_out
) * 2));
4520 for (i
= 0; i
< num
; i
++)
4522 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4523 int c
= LGLYPH_CHAR (g
);
4524 unsigned code
= LGLYPH_CODE (g
);
4526 alternates
= Fcons (Fcons (make_number (code
),
4527 c
> 0 ? make_number (c
) : Qnil
),
4530 return Fnreverse (alternates
);
4536 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4537 doc
: /* Open FONT-ENTITY. */)
4538 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4542 CHECK_FONT_ENTITY (font_entity
);
4544 frame
= selected_frame
;
4545 CHECK_LIVE_FRAME (frame
);
4548 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4551 CHECK_NUMBER_OR_FLOAT (size
);
4553 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4555 isize
= XINT (size
);
4559 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4562 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4563 doc
: /* Close FONT-OBJECT. */)
4564 (Lisp_Object font_object
, Lisp_Object frame
)
4566 CHECK_FONT_OBJECT (font_object
);
4568 frame
= selected_frame
;
4569 CHECK_LIVE_FRAME (frame
);
4570 font_close_object (XFRAME (frame
), font_object
);
4574 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4575 doc
: /* Return information about FONT-OBJECT.
4576 The value is a vector:
4577 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4580 NAME is the font name, a string (or nil if the font backend doesn't
4583 FILENAME is the font file name, a string (or nil if the font backend
4584 doesn't provide a file name).
4586 PIXEL-SIZE is a pixel size by which the font is opened.
4588 SIZE is a maximum advance width of the font in pixels.
4590 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4593 CAPABILITY is a list whose first element is a symbol representing the
4594 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4595 remaining elements describe the details of the font capability.
4597 If the font is OpenType font, the form of the list is
4598 \(opentype GSUB GPOS)
4599 where GSUB shows which "GSUB" features the font supports, and GPOS
4600 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4601 lists of the format:
4602 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4604 If the font is not OpenType font, currently the length of the form is
4607 SCRIPT is a symbol representing OpenType script tag.
4609 LANGSYS is a symbol representing OpenType langsys tag, or nil
4610 representing the default langsys.
4612 FEATURE is a symbol representing OpenType feature tag.
4614 If the font is not OpenType font, CAPABILITY is nil. */)
4615 (Lisp_Object font_object
)
4620 CHECK_FONT_GET_OBJECT (font_object
, font
);
4622 val
= Fmake_vector (make_number (9), Qnil
);
4623 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4624 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4625 ASET (val
, 2, make_number (font
->pixel_size
));
4626 ASET (val
, 3, make_number (font
->max_width
));
4627 ASET (val
, 4, make_number (font
->ascent
));
4628 ASET (val
, 5, make_number (font
->descent
));
4629 ASET (val
, 6, make_number (font
->space_width
));
4630 ASET (val
, 7, make_number (font
->average_width
));
4631 if (font
->driver
->otf_capability
)
4632 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4636 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4638 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4639 FROM and TO are positions (integers or markers) specifying a region
4640 of the current buffer.
4641 If the optional fourth arg OBJECT is not nil, it is a string or a
4642 vector containing the target characters.
4644 Each element is a vector containing information of a glyph in this format:
4645 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4647 FROM is an index numbers of a character the glyph corresponds to.
4648 TO is the same as FROM.
4649 C is the character of the glyph.
4650 CODE is the glyph-code of C in FONT-OBJECT.
4651 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4652 ADJUSTMENT is always nil.
4653 If FONT-OBJECT doesn't have a glyph for a character,
4654 the corresponding element is nil. */)
4655 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4660 Lisp_Object
*chars
, vec
;
4663 CHECK_FONT_GET_OBJECT (font_object
, font
);
4666 EMACS_INT charpos
, bytepos
;
4668 validate_region (&from
, &to
);
4671 len
= XFASTINT (to
) - XFASTINT (from
);
4672 SAFE_ALLOCA_LISP (chars
, len
);
4673 charpos
= XFASTINT (from
);
4674 bytepos
= CHAR_TO_BYTE (charpos
);
4675 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4678 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4679 chars
[i
] = make_number (c
);
4682 else if (STRINGP (object
))
4684 const unsigned char *p
;
4686 CHECK_NUMBER (from
);
4688 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4689 || XINT (to
) > SCHARS (object
))
4690 args_out_of_range_3 (object
, from
, to
);
4693 len
= XFASTINT (to
) - XFASTINT (from
);
4694 SAFE_ALLOCA_LISP (chars
, len
);
4696 if (STRING_MULTIBYTE (object
))
4697 for (i
= 0; i
< len
; i
++)
4699 int c
= STRING_CHAR_ADVANCE (p
);
4700 chars
[i
] = make_number (c
);
4703 for (i
= 0; i
< len
; i
++)
4704 chars
[i
] = make_number (p
[i
]);
4708 CHECK_VECTOR (object
);
4709 CHECK_NUMBER (from
);
4711 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4712 || XINT (to
) > ASIZE (object
))
4713 args_out_of_range_3 (object
, from
, to
);
4716 len
= XFASTINT (to
) - XFASTINT (from
);
4717 for (i
= 0; i
< len
; i
++)
4719 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4720 CHECK_CHARACTER (elt
);
4722 chars
= &(AREF (object
, XFASTINT (from
)));
4725 vec
= Fmake_vector (make_number (len
), Qnil
);
4726 for (i
= 0; i
< len
; i
++)
4729 int c
= XFASTINT (chars
[i
]);
4731 struct font_metrics metrics
;
4733 code
= font
->driver
->encode_char (font
, c
);
4734 if (code
== FONT_INVALID_CODE
)
4736 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4737 LGLYPH_SET_FROM (g
, i
);
4738 LGLYPH_SET_TO (g
, i
);
4739 LGLYPH_SET_CHAR (g
, c
);
4740 LGLYPH_SET_CODE (g
, code
);
4741 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4742 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4743 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4744 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4745 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4746 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4749 if (! VECTORP (object
))
4754 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4755 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4756 FONT is a font-spec, font-entity, or font-object. */)
4757 (Lisp_Object spec
, Lisp_Object font
)
4759 CHECK_FONT_SPEC (spec
);
4762 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4765 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4766 doc
: /* Return a font-object for displaying a character at POSITION.
4767 Optional second arg WINDOW, if non-nil, is a window displaying
4768 the current buffer. It defaults to the currently selected window. */)
4769 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4776 CHECK_NUMBER_COERCE_MARKER (position
);
4777 pos
= XINT (position
);
4778 if (pos
< BEGV
|| pos
>= ZV
)
4779 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4783 CHECK_NUMBER (position
);
4784 CHECK_STRING (string
);
4785 pos
= XINT (position
);
4786 if (pos
< 0 || pos
>= SCHARS (string
))
4787 args_out_of_range (string
, position
);
4790 window
= selected_window
;
4791 CHECK_LIVE_WINDOW (window
);
4792 w
= XWINDOW (window
);
4794 return font_at (-1, pos
, NULL
, w
, string
);
4798 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4799 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4800 The value is a number of glyphs drawn.
4801 Type C-l to recover what previously shown. */)
4802 (Lisp_Object font_object
, Lisp_Object string
)
4804 Lisp_Object frame
= selected_frame
;
4805 FRAME_PTR f
= XFRAME (frame
);
4811 CHECK_FONT_GET_OBJECT (font_object
, font
);
4812 CHECK_STRING (string
);
4813 len
= SCHARS (string
);
4814 code
= alloca (sizeof (unsigned) * len
);
4815 for (i
= 0; i
< len
; i
++)
4817 Lisp_Object ch
= Faref (string
, make_number (i
));
4821 code
[i
] = font
->driver
->encode_char (font
, c
);
4822 if (code
[i
] == FONT_INVALID_CODE
)
4825 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4827 if (font
->driver
->prepare_face
)
4828 font
->driver
->prepare_face (f
, face
);
4829 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4830 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4831 if (font
->driver
->done_face
)
4832 font
->driver
->done_face (f
, face
);
4834 return make_number (len
);
4838 #endif /* FONT_DEBUG */
4840 #ifdef HAVE_WINDOW_SYSTEM
4842 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4843 doc
: /* Return information about a font named NAME on frame FRAME.
4844 If FRAME is omitted or nil, use the selected frame.
4845 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4846 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4848 OPENED-NAME is the name used for opening the font,
4849 FULL-NAME is the full name of the font,
4850 SIZE is the pixelsize of the font,
4851 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4852 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4853 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4854 how to compose characters.
4855 If the named font is not yet loaded, return nil. */)
4856 (Lisp_Object name
, Lisp_Object frame
)
4861 Lisp_Object font_object
;
4863 (*check_window_system_func
) ();
4866 CHECK_STRING (name
);
4868 frame
= selected_frame
;
4869 CHECK_LIVE_FRAME (frame
);
4874 int fontset
= fs_query_fontset (name
, 0);
4877 name
= fontset_ascii (fontset
);
4878 font_object
= font_open_by_name (f
, SSDATA (name
));
4880 else if (FONT_OBJECT_P (name
))
4882 else if (FONT_ENTITY_P (name
))
4883 font_object
= font_open_entity (f
, name
, 0);
4886 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4887 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4889 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4891 if (NILP (font_object
))
4893 font
= XFONT_OBJECT (font_object
);
4895 info
= Fmake_vector (make_number (7), Qnil
);
4896 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4897 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4898 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4899 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4900 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4901 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4902 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4905 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4906 close it now. Perhaps, we should manage font-objects
4907 by `reference-count'. */
4908 font_close_object (f
, font_object
);
4915 #define BUILD_STYLE_TABLE(TBL) \
4916 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4919 build_style_table (const struct table_entry
*entry
, int nelement
)
4922 Lisp_Object table
, elt
;
4924 table
= Fmake_vector (make_number (nelement
), Qnil
);
4925 for (i
= 0; i
< nelement
; i
++)
4927 for (j
= 0; entry
[i
].names
[j
]; j
++);
4928 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4929 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4930 for (j
= 0; entry
[i
].names
[j
]; j
++)
4931 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4932 ASET (table
, i
, elt
);
4937 /* The deferred font-log data of the form [ACTION ARG RESULT].
4938 If ACTION is not nil, that is added to the log when font_add_log is
4939 called next time. At that time, ACTION is set back to nil. */
4940 static Lisp_Object Vfont_log_deferred
;
4942 /* Prepend the font-related logging data in Vfont_log if it is not
4943 `t'. ACTION describes a kind of font-related action (e.g. listing,
4944 opening), ARG is the argument for the action, and RESULT is the
4945 result of the action. */
4947 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4952 if (EQ (Vfont_log
, Qt
))
4954 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4956 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4958 ASET (Vfont_log_deferred
, 0, Qnil
);
4959 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4960 AREF (Vfont_log_deferred
, 2));
4965 Lisp_Object tail
, elt
;
4966 Lisp_Object equalstr
= build_string ("=");
4968 val
= Ffont_xlfd_name (arg
, Qt
);
4969 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4973 if (EQ (XCAR (elt
), QCscript
)
4974 && SYMBOLP (XCDR (elt
)))
4975 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4976 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4977 else if (EQ (XCAR (elt
), QClang
)
4978 && SYMBOLP (XCDR (elt
)))
4979 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4980 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4981 else if (EQ (XCAR (elt
), QCotf
)
4982 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4983 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4985 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4991 && VECTORP (XCAR (result
))
4992 && ASIZE (XCAR (result
)) > 0
4993 && FONTP (AREF (XCAR (result
), 0)))
4994 result
= font_vconcat_entity_vectors (result
);
4997 val
= Ffont_xlfd_name (result
, Qt
);
4998 if (! FONT_SPEC_P (result
))
4999 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5000 build_string (":"), val
);
5003 else if (CONSP (result
))
5006 result
= Fcopy_sequence (result
);
5007 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5011 val
= Ffont_xlfd_name (val
, Qt
);
5012 XSETCAR (tail
, val
);
5015 else if (VECTORP (result
))
5017 result
= Fcopy_sequence (result
);
5018 for (i
= 0; i
< ASIZE (result
); i
++)
5020 val
= AREF (result
, i
);
5022 val
= Ffont_xlfd_name (val
, Qt
);
5023 ASET (result
, i
, val
);
5026 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5029 /* Record a font-related logging data to be added to Vfont_log when
5030 font_add_log is called next time. ACTION, ARG, RESULT are the same
5034 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5036 if (EQ (Vfont_log
, Qt
))
5038 ASET (Vfont_log_deferred
, 0, build_string (action
));
5039 ASET (Vfont_log_deferred
, 1, arg
);
5040 ASET (Vfont_log_deferred
, 2, result
);
5046 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5047 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5048 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5049 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5050 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5051 /* Note that the other elements in sort_shift_bits are not used. */
5053 staticpro (&font_charset_alist
);
5054 font_charset_alist
= Qnil
;
5056 DEFSYM (Qopentype
, "opentype");
5058 DEFSYM (Qascii_0
, "ascii-0");
5059 DEFSYM (Qiso8859_1
, "iso8859-1");
5060 DEFSYM (Qiso10646_1
, "iso10646-1");
5061 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5062 DEFSYM (Qunicode_sip
, "unicode-sip");
5066 DEFSYM (QCotf
, ":otf");
5067 DEFSYM (QClang
, ":lang");
5068 DEFSYM (QCscript
, ":script");
5069 DEFSYM (QCantialias
, ":antialias");
5071 DEFSYM (QCfoundry
, ":foundry");
5072 DEFSYM (QCadstyle
, ":adstyle");
5073 DEFSYM (QCregistry
, ":registry");
5074 DEFSYM (QCspacing
, ":spacing");
5075 DEFSYM (QCdpi
, ":dpi");
5076 DEFSYM (QCscalable
, ":scalable");
5077 DEFSYM (QCavgwidth
, ":avgwidth");
5078 DEFSYM (QCfont_entity
, ":font-entity");
5079 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5089 DEFSYM (QCuser_spec
, "user-spec");
5091 staticpro (&null_vector
);
5092 null_vector
= Fmake_vector (make_number (0), Qnil
);
5094 staticpro (&scratch_font_spec
);
5095 scratch_font_spec
= Ffont_spec (0, NULL
);
5096 staticpro (&scratch_font_prefer
);
5097 scratch_font_prefer
= Ffont_spec (0, NULL
);
5099 staticpro (&Vfont_log_deferred
);
5100 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5104 staticpro (&otf_list
);
5106 #endif /* HAVE_LIBOTF */
5110 defsubr (&Sfont_spec
);
5111 defsubr (&Sfont_get
);
5112 #ifdef HAVE_WINDOW_SYSTEM
5113 defsubr (&Sfont_face_attributes
);
5115 defsubr (&Sfont_put
);
5116 defsubr (&Slist_fonts
);
5117 defsubr (&Sfont_family_list
);
5118 defsubr (&Sfind_font
);
5119 defsubr (&Sfont_xlfd_name
);
5120 defsubr (&Sclear_font_cache
);
5121 defsubr (&Sfont_shape_gstring
);
5122 defsubr (&Sfont_variation_glyphs
);
5124 defsubr (&Sfont_drive_otf
);
5125 defsubr (&Sfont_otf_alternates
);
5129 defsubr (&Sopen_font
);
5130 defsubr (&Sclose_font
);
5131 defsubr (&Squery_font
);
5132 defsubr (&Sfont_get_glyphs
);
5133 defsubr (&Sfont_match_p
);
5134 defsubr (&Sfont_at
);
5136 defsubr (&Sdraw_string
);
5138 #endif /* FONT_DEBUG */
5139 #ifdef HAVE_WINDOW_SYSTEM
5140 defsubr (&Sfont_info
);
5143 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5145 Alist of fontname patterns vs the corresponding encoding and repertory info.
5146 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5147 where ENCODING is a charset or a char-table,
5148 and REPERTORY is a charset, a char-table, or nil.
5150 If ENCODING and REPERTORY are the same, the element can have the form
5151 \(REGEXP . ENCODING).
5153 ENCODING is for converting a character to a glyph code of the font.
5154 If ENCODING is a charset, encoding a character by the charset gives
5155 the corresponding glyph code. If ENCODING is a char-table, looking up
5156 the table by a character gives the corresponding glyph code.
5158 REPERTORY specifies a repertory of characters supported by the font.
5159 If REPERTORY is a charset, all characters beloging to the charset are
5160 supported. If REPERTORY is a char-table, all characters who have a
5161 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5162 gets the repertory information by an opened font and ENCODING. */);
5163 Vfont_encoding_alist
= Qnil
;
5165 /* FIXME: These 3 vars are not quite what they appear: setq on them
5166 won't have any effect other than disconnect them from the style
5167 table used by the font display code. So we make them read-only,
5168 to avoid this confusing situation. */
5170 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5171 doc
: /* Vector of valid font weight values.
5172 Each element has the form:
5173 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5174 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5175 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5176 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5178 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5179 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5180 See `font-weight-table' for the format of the vector. */);
5181 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5182 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5184 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5185 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5186 See `font-weight-table' for the format of the vector. */);
5187 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5188 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5190 staticpro (&font_style_table
);
5191 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5192 ASET (font_style_table
, 0, Vfont_weight_table
);
5193 ASET (font_style_table
, 1, Vfont_slant_table
);
5194 ASET (font_style_table
, 2, Vfont_width_table
);
5196 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5197 *Logging list of font related actions and results.
5198 The value t means to suppress the logging.
5199 The initial value is set to nil if the environment variable
5200 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5203 #ifdef HAVE_WINDOW_SYSTEM
5204 #ifdef HAVE_FREETYPE
5206 #ifdef HAVE_X_WINDOWS
5211 #endif /* HAVE_XFT */
5212 #endif /* HAVE_X_WINDOWS */
5213 #else /* not HAVE_FREETYPE */
5214 #ifdef HAVE_X_WINDOWS
5216 #endif /* HAVE_X_WINDOWS */
5217 #endif /* not HAVE_FREETYPE */
5220 #endif /* HAVE_BDFFONT */
5223 #endif /* WINDOWSNT */
5226 #endif /* HAVE_NS */
5227 #endif /* HAVE_WINDOW_SYSTEM */
5233 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;