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
)
1205 val
= SYMBOL_NAME (val
);
1206 if (j
== XLFD_REGISTRY_INDEX
1207 && ! strchr (SSDATA (val
), '-'))
1209 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1210 ptrdiff_t alloc
= SBYTES (val
) + 4;
1211 if (nbytes
<= alloc
)
1213 f
[j
] = p
= alloca (alloc
);
1214 sprintf (p
, "%s%s-*", SDATA (val
),
1215 "*" + (SDATA (val
)[SBYTES (val
) - 1] == '*'));
1218 f
[j
] = SSDATA (val
);
1222 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1225 val
= font_style_symbolic (font
, i
, 0);
1230 val
= SYMBOL_NAME (val
);
1231 f
[j
] = SSDATA (val
);
1235 val
= AREF (font
, FONT_SIZE_INDEX
);
1236 font_assert (NUMBERP (val
) || NILP (val
));
1239 EMACS_INT v
= XINT (val
);
1244 f
[XLFD_PIXEL_INDEX
] = p
=
1245 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1246 sprintf (p
, "%"pI
"d-*", v
);
1249 f
[XLFD_PIXEL_INDEX
] = "*-*";
1251 else if (FLOATP (val
))
1253 double v
= XFLOAT_DATA (val
) * 10;
1254 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1255 sprintf (p
, "*-%.0f", v
);
1258 f
[XLFD_PIXEL_INDEX
] = "*-*";
1260 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1262 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1263 f
[XLFD_RESX_INDEX
] = p
=
1264 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1265 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1268 f
[XLFD_RESX_INDEX
] = "*-*";
1269 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1271 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1273 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1274 : spacing
<= FONT_SPACING_DUAL
? "d"
1275 : spacing
<= FONT_SPACING_MONO
? "m"
1279 f
[XLFD_SPACING_INDEX
] = "*";
1280 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1282 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1283 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1286 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1287 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1288 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1289 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1290 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1291 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1292 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1293 f
[XLFD_REGISTRY_INDEX
]);
1294 return len
< nbytes
? len
: -1;
1297 /* Parse NAME (null terminated) and store information in FONT
1298 (font-spec or font-entity). NAME is supplied in either the
1299 Fontconfig or GTK font name format. If NAME is successfully
1300 parsed, return 0. Otherwise return -1.
1302 The fontconfig format is
1304 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1308 FAMILY [PROPS...] [SIZE]
1310 This function tries to guess which format it is. */
1313 font_parse_fcname (char *name
, Lisp_Object font
)
1316 char *size_beg
= NULL
, *size_end
= NULL
;
1317 char *props_beg
= NULL
, *family_end
= NULL
;
1318 ptrdiff_t len
= strlen (name
);
1323 for (p
= name
; *p
; p
++)
1325 if (*p
== '\\' && p
[1])
1329 props_beg
= family_end
= p
;
1334 int decimal
= 0, size_found
= 1;
1335 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1338 if (*q
!= '.' || decimal
)
1357 Lisp_Object extra_props
= Qnil
;
1359 /* A fontconfig name with size and/or property data. */
1360 if (family_end
> name
)
1363 family
= font_intern_prop (name
, family_end
- name
, 1);
1364 ASET (font
, FONT_FAMILY_INDEX
, family
);
1368 double point_size
= strtod (size_beg
, &size_end
);
1369 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1370 if (*size_end
== ':' && size_end
[1])
1371 props_beg
= size_end
;
1375 /* Now parse ":KEY=VAL" patterns. */
1378 for (p
= props_beg
; *p
; p
= q
)
1380 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1383 /* Must be an enumerated value. */
1387 val
= font_intern_prop (p
, q
- p
, 1);
1389 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1390 && memcmp (p, STR, strlen (STR)) == 0)
1392 if (PROP_MATCH ("light")
1393 || PROP_MATCH ("medium")
1394 || PROP_MATCH ("demibold")
1395 || PROP_MATCH ("bold")
1396 || PROP_MATCH ("black"))
1397 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1398 else if (PROP_MATCH ("roman")
1399 || PROP_MATCH ("italic")
1400 || PROP_MATCH ("oblique"))
1401 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1402 else if (PROP_MATCH ("charcell"))
1403 ASET (font
, FONT_SPACING_INDEX
,
1404 make_number (FONT_SPACING_CHARCELL
));
1405 else if (PROP_MATCH ("mono"))
1406 ASET (font
, FONT_SPACING_INDEX
,
1407 make_number (FONT_SPACING_MONO
));
1408 else if (PROP_MATCH ("proportional"))
1409 ASET (font
, FONT_SPACING_INDEX
,
1410 make_number (FONT_SPACING_PROPORTIONAL
));
1419 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1420 prop
= FONT_SIZE_INDEX
;
1423 key
= font_intern_prop (p
, q
- p
, 1);
1424 prop
= get_font_prop_index (key
);
1428 for (q
= p
; *q
&& *q
!= ':'; q
++);
1429 val
= font_intern_prop (p
, q
- p
, 0);
1431 if (prop
>= FONT_FOUNDRY_INDEX
1432 && prop
< FONT_EXTRA_INDEX
)
1433 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1436 extra_props
= nconc2 (extra_props
,
1437 Fcons (Fcons (key
, val
), Qnil
));
1444 if (! NILP (extra_props
))
1446 struct font_driver_list
*driver_list
= font_driver_list
;
1447 for ( ; driver_list
; driver_list
= driver_list
->next
)
1448 if (driver_list
->driver
->filter_properties
)
1449 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1455 /* Either a fontconfig-style name with no size and property
1456 data, or a GTK-style name. */
1457 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1458 Lisp_Object width
= Qnil
, size
= Qnil
;
1462 /* Scan backwards from the end, looking for a size. */
1463 for (p
= name
+ len
- 1; p
>= name
; p
--)
1467 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1468 /* Found a font size. */
1469 size
= make_float (strtod (p
+ 1, NULL
));
1473 /* Now P points to the termination of the string, sans size.
1474 Scan backwards, looking for font properties. */
1475 for (; p
> name
; p
= q
)
1477 for (q
= p
- 1; q
>= name
; q
--)
1479 if (q
> name
&& *(q
-1) == '\\')
1480 --q
; /* Skip quoting backslashes. */
1486 word_len
= p
- word_start
;
1488 #define PROP_MATCH(STR) \
1489 (word_len == strlen (STR) \
1490 && memcmp (word_start, STR, strlen (STR)) == 0)
1491 #define PROP_SAVE(VAR, STR) \
1492 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1494 if (PROP_MATCH ("Ultra-Light"))
1495 PROP_SAVE (weight
, "ultra-light");
1496 else if (PROP_MATCH ("Light"))
1497 PROP_SAVE (weight
, "light");
1498 else if (PROP_MATCH ("Book"))
1499 PROP_SAVE (weight
, "book");
1500 else if (PROP_MATCH ("Medium"))
1501 PROP_SAVE (weight
, "medium");
1502 else if (PROP_MATCH ("Semi-Bold"))
1503 PROP_SAVE (weight
, "semi-bold");
1504 else if (PROP_MATCH ("Bold"))
1505 PROP_SAVE (weight
, "bold");
1506 else if (PROP_MATCH ("Italic"))
1507 PROP_SAVE (slant
, "italic");
1508 else if (PROP_MATCH ("Oblique"))
1509 PROP_SAVE (slant
, "oblique");
1510 else if (PROP_MATCH ("Semi-Condensed"))
1511 PROP_SAVE (width
, "semi-condensed");
1512 else if (PROP_MATCH ("Condensed"))
1513 PROP_SAVE (width
, "condensed");
1514 /* An unknown word must be part of the font name. */
1525 ASET (font
, FONT_FAMILY_INDEX
,
1526 font_intern_prop (name
, family_end
- name
, 1));
1528 ASET (font
, FONT_SIZE_INDEX
, size
);
1530 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1532 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1534 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1540 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1541 NAME (NBYTES length), and return the name length. If
1542 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1545 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1547 Lisp_Object family
, foundry
;
1553 Lisp_Object styles
[3];
1554 const char *style_names
[3] = { "weight", "slant", "width" };
1556 family
= AREF (font
, FONT_FAMILY_INDEX
);
1557 if (! NILP (family
))
1559 if (SYMBOLP (family
))
1560 family
= SYMBOL_NAME (family
);
1565 val
= AREF (font
, FONT_SIZE_INDEX
);
1568 if (XINT (val
) != 0)
1569 pixel_size
= XINT (val
);
1577 point_size
= (int) XFLOAT_DATA (val
);
1580 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1581 if (! NILP (foundry
))
1583 if (SYMBOLP (foundry
))
1584 foundry
= SYMBOL_NAME (foundry
);
1589 for (i
= 0; i
< 3; i
++)
1590 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1593 lim
= name
+ nbytes
;
1594 # define APPEND_SNPRINTF(args) \
1596 int len = snprintf args; \
1597 if (! (0 <= len && len < lim - p)) \
1601 if (! NILP (family
))
1602 APPEND_SNPRINTF ((p
, lim
- p
, "%s", SSDATA (family
)));
1604 APPEND_SNPRINTF ((p
, lim
- p
, "-%d" + (p
== name
), point_size
));
1605 else if (pixel_size
> 0)
1606 APPEND_SNPRINTF ((p
, lim
- p
, ":pixelsize=%d", pixel_size
));
1607 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1608 APPEND_SNPRINTF ((p
, lim
- p
, ":foundry=%s",
1609 SSDATA (SYMBOL_NAME (AREF (font
,
1610 FONT_FOUNDRY_INDEX
)))));
1611 for (i
= 0; i
< 3; i
++)
1612 if (! NILP (styles
[i
]))
1613 APPEND_SNPRINTF ((p
, lim
- p
, ":%s=%s", style_names
[i
],
1614 SSDATA (SYMBOL_NAME (styles
[i
]))));
1615 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1616 APPEND_SNPRINTF ((p
, lim
- p
, ":dpi=%"pI
"d",
1617 XINT (AREF (font
, FONT_DPI_INDEX
))));
1618 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1619 APPEND_SNPRINTF ((p
, lim
- p
, ":spacing=%"pI
"d",
1620 XINT (AREF (font
, FONT_SPACING_INDEX
))));
1621 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1622 APPEND_SNPRINTF ((p
, lim
- p
,
1623 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1625 : ":scalable=false")));
1629 /* Parse NAME (null terminated) and store information in FONT
1630 (font-spec or font-entity). If NAME is successfully parsed, return
1631 0. Otherwise return -1. */
1634 font_parse_name (char *name
, Lisp_Object font
)
1636 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1637 return font_parse_xlfd (name
, font
);
1638 return font_parse_fcname (name
, font
);
1642 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1643 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1647 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1653 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1655 CHECK_STRING (family
);
1656 len
= SBYTES (family
);
1657 p0
= SSDATA (family
);
1658 p1
= strchr (p0
, '-');
1661 if ((*p0
!= '*' && p1
- p0
> 0)
1662 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1663 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1666 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1669 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1671 if (! NILP (registry
))
1673 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1674 CHECK_STRING (registry
);
1675 len
= SBYTES (registry
);
1676 p0
= SSDATA (registry
);
1677 p1
= strchr (p0
, '-');
1680 if (SDATA (registry
)[len
- 1] == '*')
1681 registry
= concat2 (registry
, build_string ("-*"));
1683 registry
= concat2 (registry
, build_string ("*-*"));
1685 registry
= Fdowncase (registry
);
1686 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1691 /* This part (through the next ^L) is still experimental and not
1692 tested much. We may drastically change codes. */
1698 #define LGSTRING_HEADER_SIZE 6
1699 #define LGSTRING_GLYPH_SIZE 8
1702 check_gstring (Lisp_Object gstring
)
1707 CHECK_VECTOR (gstring
);
1708 val
= AREF (gstring
, 0);
1710 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1712 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1713 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1714 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1715 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1716 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1717 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1718 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1719 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1720 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1721 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1722 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1724 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1726 val
= LGSTRING_GLYPH (gstring
, i
);
1728 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1730 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1732 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1733 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1734 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1735 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1736 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1737 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1738 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1739 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1741 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1743 if (ASIZE (val
) < 3)
1745 for (j
= 0; j
< 3; j
++)
1746 CHECK_NUMBER (AREF (val
, j
));
1751 error ("Invalid glyph-string format");
1756 check_otf_features (Lisp_Object otf_features
)
1760 CHECK_CONS (otf_features
);
1761 CHECK_SYMBOL (XCAR (otf_features
));
1762 otf_features
= XCDR (otf_features
);
1763 CHECK_CONS (otf_features
);
1764 CHECK_SYMBOL (XCAR (otf_features
));
1765 otf_features
= XCDR (otf_features
);
1766 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1768 CHECK_SYMBOL (Fcar (val
));
1769 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1770 error ("Invalid OTF GSUB feature: %s",
1771 SDATA (SYMBOL_NAME (XCAR (val
))));
1773 otf_features
= XCDR (otf_features
);
1774 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1776 CHECK_SYMBOL (Fcar (val
));
1777 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1778 error ("Invalid OTF GPOS feature: %s",
1779 SDATA (SYMBOL_NAME (XCAR (val
))));
1786 Lisp_Object otf_list
;
1789 otf_tag_symbol (OTF_Tag tag
)
1793 OTF_tag_name (tag
, name
);
1794 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1798 otf_open (Lisp_Object file
)
1800 Lisp_Object val
= Fassoc (file
, otf_list
);
1804 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1807 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1808 val
= make_save_value (otf
, 0);
1809 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1815 /* Return a list describing which scripts/languages FONT supports by
1816 which GSUB/GPOS features of OpenType tables. See the comment of
1817 (struct font_driver).otf_capability. */
1820 font_otf_capability (struct font
*font
)
1823 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1826 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1829 for (i
= 0; i
< 2; i
++)
1831 OTF_GSUB_GPOS
*gsub_gpos
;
1832 Lisp_Object script_list
= Qnil
;
1835 if (OTF_get_features (otf
, i
== 0) < 0)
1837 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1838 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1840 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1841 Lisp_Object langsys_list
= Qnil
;
1842 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1845 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1847 OTF_LangSys
*langsys
;
1848 Lisp_Object feature_list
= Qnil
;
1849 Lisp_Object langsys_tag
;
1852 if (k
== script
->LangSysCount
)
1854 langsys
= &script
->DefaultLangSys
;
1859 langsys
= script
->LangSys
+ k
;
1861 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1863 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1865 OTF_Feature
*feature
1866 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1867 Lisp_Object feature_tag
1868 = otf_tag_symbol (feature
->FeatureTag
);
1870 feature_list
= Fcons (feature_tag
, feature_list
);
1872 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1875 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1880 XSETCAR (capability
, script_list
);
1882 XSETCDR (capability
, script_list
);
1888 /* Parse OTF features in SPEC and write a proper features spec string
1889 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1890 assured that the sufficient memory has already allocated for
1894 generate_otf_features (Lisp_Object spec
, char *features
)
1902 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1908 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1913 else if (! asterisk
)
1915 val
= SYMBOL_NAME (val
);
1916 p
+= esprintf (p
, "%s", SDATA (val
));
1920 val
= SYMBOL_NAME (val
);
1921 p
+= esprintf (p
, "~%s", SDATA (val
));
1925 error ("OTF spec too long");
1929 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1931 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1933 return Fcons (make_number (len
),
1934 make_unibyte_string (device_table
->DeltaValue
, len
));
1938 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
1940 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1942 if (value_format
& OTF_XPlacement
)
1943 ASET (val
, 0, make_number (value_record
->XPlacement
));
1944 if (value_format
& OTF_YPlacement
)
1945 ASET (val
, 1, make_number (value_record
->YPlacement
));
1946 if (value_format
& OTF_XAdvance
)
1947 ASET (val
, 2, make_number (value_record
->XAdvance
));
1948 if (value_format
& OTF_YAdvance
)
1949 ASET (val
, 3, make_number (value_record
->YAdvance
));
1950 if (value_format
& OTF_XPlaDevice
)
1951 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1952 if (value_format
& OTF_YPlaDevice
)
1953 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1954 if (value_format
& OTF_XAdvDevice
)
1955 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1956 if (value_format
& OTF_YAdvDevice
)
1957 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1962 font_otf_Anchor (OTF_Anchor
*anchor
)
1966 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1967 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1968 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1969 if (anchor
->AnchorFormat
== 2)
1970 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1973 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1974 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1978 #endif /* HAVE_LIBOTF */
1984 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
1985 static int font_compare (const void *, const void *);
1986 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
1990 font_rescale_ratio (Lisp_Object font_entity
)
1992 Lisp_Object tail
, elt
;
1993 Lisp_Object name
= Qnil
;
1995 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
1998 if (FLOATP (XCDR (elt
)))
2000 if (STRINGP (XCAR (elt
)))
2003 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2004 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2005 return XFLOAT_DATA (XCDR (elt
));
2007 else if (FONT_SPEC_P (XCAR (elt
)))
2009 if (font_match_p (XCAR (elt
), font_entity
))
2010 return XFLOAT_DATA (XCDR (elt
));
2017 /* We sort fonts by scoring each of them against a specified
2018 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2019 the value is, the closer the font is to the font-spec.
2021 The lowest 2 bits of the score are used for driver type. The font
2022 available by the most preferred font driver is 0.
2024 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2025 WEIGHT, SLANT, WIDTH, and SIZE. */
2027 /* How many bits to shift to store the difference value of each font
2028 property in a score. Note that floats for FONT_TYPE_INDEX and
2029 FONT_REGISTRY_INDEX are not used. */
2030 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2032 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2033 The return value indicates how different ENTITY is compared with
2037 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2042 /* Score three style numeric fields. Maximum difference is 127. */
2043 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2044 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2046 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2047 - (XINT (spec_prop
[i
]) >> 8));
2050 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2053 /* Score the size. Maximum difference is 127. */
2054 i
= FONT_SIZE_INDEX
;
2055 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2056 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2058 /* We use the higher 6-bit for the actual size difference. The
2059 lowest bit is set if the DPI is different. */
2061 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2063 if (CONSP (Vface_font_rescale_alist
))
2064 pixel_size
*= font_rescale_ratio (entity
);
2065 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2069 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2070 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2072 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2073 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2075 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2082 /* Concatenate all elements of LIST into one vector. LIST is a list
2083 of font-entity vectors. */
2086 font_vconcat_entity_vectors (Lisp_Object list
)
2088 int nargs
= XINT (Flength (list
));
2089 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2092 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2093 args
[i
] = XCAR (list
);
2094 return Fvconcat (nargs
, args
);
2098 /* The structure for elements being sorted by qsort. */
2099 struct font_sort_data
2102 int font_driver_preference
;
2107 /* The comparison function for qsort. */
2110 font_compare (const void *d1
, const void *d2
)
2112 const struct font_sort_data
*data1
= d1
;
2113 const struct font_sort_data
*data2
= d2
;
2115 if (data1
->score
< data2
->score
)
2117 else if (data1
->score
> data2
->score
)
2119 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2123 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2124 If PREFER specifies a point-size, calculate the corresponding
2125 pixel-size from QCdpi property of PREFER or from the Y-resolution
2126 of FRAME before sorting.
2128 If BEST-ONLY is nonzero, return the best matching entity (that
2129 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2130 if BEST-ONLY is negative). Otherwise, return the sorted result as
2131 a single vector of font-entities.
2133 This function does no optimization for the case that the total
2134 number of elements is 1. The caller should avoid calling this in
2138 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2140 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2142 struct font_sort_data
*data
;
2143 unsigned best_score
;
2144 Lisp_Object best_entity
;
2145 struct frame
*f
= XFRAME (frame
);
2146 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2149 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2150 prefer_prop
[i
] = AREF (prefer
, i
);
2151 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2152 prefer_prop
[FONT_SIZE_INDEX
]
2153 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2155 if (NILP (XCDR (list
)))
2157 /* What we have to take care of is this single vector. */
2159 maxlen
= ASIZE (vec
);
2163 /* We don't have to perform sort, so there's no need of creating
2164 a single vector. But, we must find the length of the longest
2167 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2168 if (maxlen
< ASIZE (XCAR (tail
)))
2169 maxlen
= ASIZE (XCAR (tail
));
2173 /* We have to create a single vector to sort it. */
2174 vec
= font_vconcat_entity_vectors (list
);
2175 maxlen
= ASIZE (vec
);
2178 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2179 best_score
= 0xFFFFFFFF;
2182 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2184 int font_driver_preference
= 0;
2185 Lisp_Object current_font_driver
;
2191 /* We are sure that the length of VEC > 0. */
2192 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2193 /* Score the elements. */
2194 for (i
= 0; i
< len
; i
++)
2196 data
[i
].entity
= AREF (vec
, i
);
2198 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2200 ? font_score (data
[i
].entity
, prefer_prop
)
2202 if (best_only
&& best_score
> data
[i
].score
)
2204 best_score
= data
[i
].score
;
2205 best_entity
= data
[i
].entity
;
2206 if (best_score
== 0)
2209 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2211 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2212 font_driver_preference
++;
2214 data
[i
].font_driver_preference
= font_driver_preference
;
2217 /* Sort if necessary. */
2220 qsort (data
, len
, sizeof *data
, font_compare
);
2221 for (i
= 0; i
< len
; i
++)
2222 ASET (vec
, i
, data
[i
].entity
);
2231 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2236 /* API of Font Service Layer. */
2238 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2239 sort_shift_bits. Finternal_set_font_selection_order calls this
2240 function with font_sort_order after setting up it. */
2243 font_update_sort_order (int *order
)
2247 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2249 int xlfd_idx
= order
[i
];
2251 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2252 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2253 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2254 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2255 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2256 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2258 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2263 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2268 table
= assq_no_quit (script
, table
);
2271 table
= XCDR (table
);
2272 if (! NILP (langsys
))
2274 table
= assq_no_quit (langsys
, table
);
2280 val
= assq_no_quit (Qnil
, table
);
2282 table
= XCAR (table
);
2286 table
= XCDR (table
);
2287 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2289 if (NILP (XCAR (features
)))
2294 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2300 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2303 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2305 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2307 script
= XCAR (spec
);
2311 langsys
= XCAR (spec
);
2322 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2323 XCAR (otf_capability
)))
2325 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2326 XCDR (otf_capability
)))
2333 /* Check if FONT (font-entity or font-object) matches with the font
2334 specification SPEC. */
2337 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2339 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2340 Lisp_Object extra
, font_extra
;
2343 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2344 if (! NILP (AREF (spec
, i
))
2345 && ! NILP (AREF (font
, i
))
2346 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2348 props
= XFONT_SPEC (spec
)->props
;
2349 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2351 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2352 prop
[i
] = AREF (spec
, i
);
2353 prop
[FONT_SIZE_INDEX
]
2354 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2358 if (font_score (font
, props
) > 0)
2360 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2361 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2362 for (; CONSP (extra
); extra
= XCDR (extra
))
2364 Lisp_Object key
= XCAR (XCAR (extra
));
2365 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2367 if (EQ (key
, QClang
))
2369 val2
= assq_no_quit (key
, font_extra
);
2378 if (NILP (Fmemq (val
, val2
)))
2383 ? NILP (Fmemq (val
, XCDR (val2
)))
2387 else if (EQ (key
, QCscript
))
2389 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2395 /* All characters in the list must be supported. */
2396 for (; CONSP (val2
); val2
= XCDR (val2
))
2398 if (! NATNUMP (XCAR (val2
)))
2400 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2401 == FONT_INVALID_CODE
)
2405 else if (VECTORP (val2
))
2407 /* At most one character in the vector must be supported. */
2408 for (i
= 0; i
< ASIZE (val2
); i
++)
2410 if (! NATNUMP (AREF (val2
, i
)))
2412 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2413 != FONT_INVALID_CODE
)
2416 if (i
== ASIZE (val2
))
2421 else if (EQ (key
, QCotf
))
2425 if (! FONT_OBJECT_P (font
))
2427 fontp
= XFONT_OBJECT (font
);
2428 if (! fontp
->driver
->otf_capability
)
2430 val2
= fontp
->driver
->otf_capability (fontp
);
2431 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2442 Each font backend has the callback function get_cache, and it
2443 returns a cons cell of which cdr part can be freely used for
2444 caching fonts. The cons cell may be shared by multiple frames
2445 and/or multiple font drivers. So, we arrange the cdr part as this:
2447 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2449 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2450 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2451 cons (FONT-SPEC FONT-ENTITY ...). */
2453 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2454 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2455 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2456 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2457 struct font_driver
*);
2460 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2462 Lisp_Object cache
, val
;
2464 cache
= driver
->get_cache (f
);
2466 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2470 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2471 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2475 val
= XCDR (XCAR (val
));
2476 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2482 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2484 Lisp_Object cache
, val
, tmp
;
2487 cache
= driver
->get_cache (f
);
2489 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2490 cache
= val
, val
= XCDR (val
);
2491 font_assert (! NILP (val
));
2492 tmp
= XCDR (XCAR (val
));
2493 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2494 if (XINT (XCAR (tmp
)) == 0)
2496 font_clear_cache (f
, XCAR (val
), driver
);
2497 XSETCDR (cache
, XCDR (val
));
2503 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2505 Lisp_Object val
= driver
->get_cache (f
);
2506 Lisp_Object type
= driver
->type
;
2508 font_assert (CONSP (val
));
2509 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2510 font_assert (CONSP (val
));
2511 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2512 val
= XCDR (XCAR (val
));
2516 static int num_fonts
;
2519 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2521 Lisp_Object tail
, elt
;
2522 Lisp_Object tail2
, entity
;
2524 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2525 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2528 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2529 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2531 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2533 entity
= XCAR (tail2
);
2535 if (FONT_ENTITY_P (entity
)
2536 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2538 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2540 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2542 Lisp_Object val
= XCAR (objlist
);
2543 struct font
*font
= XFONT_OBJECT (val
);
2545 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2547 font_assert (font
&& driver
== font
->driver
);
2548 driver
->close (f
, font
);
2552 if (driver
->free_entity
)
2553 driver
->free_entity (entity
);
2558 XSETCDR (cache
, Qnil
);
2562 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2564 /* Check each font-entity in VEC, and return a list of font-entities
2565 that satisfy these conditions:
2566 (1) matches with SPEC and SIZE if SPEC is not nil, and
2567 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2571 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2573 Lisp_Object entity
, val
;
2574 enum font_property_index prop
;
2577 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2579 entity
= AREF (vec
, i
);
2580 if (! NILP (Vface_ignored_fonts
))
2583 Lisp_Object tail
, regexp
;
2585 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2587 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2589 regexp
= XCAR (tail
);
2590 if (STRINGP (regexp
)
2591 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2600 val
= Fcons (entity
, val
);
2603 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2604 if (INTEGERP (AREF (spec
, prop
))
2605 && ((XINT (AREF (spec
, prop
)) >> 8)
2606 != (XINT (AREF (entity
, prop
)) >> 8)))
2607 prop
= FONT_SPEC_MAX
;
2608 if (prop
< FONT_SPEC_MAX
2610 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2612 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2615 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2616 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2617 prop
= FONT_SPEC_MAX
;
2619 if (prop
< FONT_SPEC_MAX
2620 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2621 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2622 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2623 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2624 prop
= FONT_SPEC_MAX
;
2625 if (prop
< FONT_SPEC_MAX
2626 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2627 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2628 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2629 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2630 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2631 prop
= FONT_SPEC_MAX
;
2632 if (prop
< FONT_SPEC_MAX
)
2633 val
= Fcons (entity
, val
);
2635 return (Fvconcat (1, &val
));
2639 /* Return a list of vectors of font-entities matching with SPEC on
2640 FRAME. Each elements in the list is a vector of entities from the
2641 same font-driver. */
2644 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2646 FRAME_PTR f
= XFRAME (frame
);
2647 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2648 Lisp_Object ftype
, val
;
2649 Lisp_Object list
= Qnil
;
2651 int need_filtering
= 0;
2654 font_assert (FONT_SPEC_P (spec
));
2656 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2657 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2658 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2659 size
= font_pixel_size (f
, spec
);
2663 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2664 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2665 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2666 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2667 if (i
!= FONT_SPACING_INDEX
)
2669 ASET (scratch_font_spec
, i
, Qnil
);
2670 if (! NILP (AREF (spec
, i
)))
2673 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2674 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2676 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2678 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2680 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2682 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2683 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2690 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2694 val
= Fvconcat (1, &val
);
2695 copy
= copy_font_spec (scratch_font_spec
);
2696 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2697 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2701 || ! NILP (Vface_ignored_fonts
)))
2702 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2703 if (ASIZE (val
) > 0)
2704 list
= Fcons (val
, list
);
2707 list
= Fnreverse (list
);
2708 FONT_ADD_LOG ("list", spec
, list
);
2713 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2714 nil, is an array of face's attributes, which specifies preferred
2715 font-related attributes. */
2718 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2720 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2721 Lisp_Object ftype
, size
, entity
;
2723 Lisp_Object work
= copy_font_spec (spec
);
2725 XSETFRAME (frame
, f
);
2726 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2727 size
= AREF (spec
, FONT_SIZE_INDEX
);
2730 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2731 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2732 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2733 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2736 for (; driver_list
; driver_list
= driver_list
->next
)
2738 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2740 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2743 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2744 entity
= assoc_no_quit (work
, XCDR (cache
));
2746 entity
= XCDR (entity
);
2749 entity
= driver_list
->driver
->match (frame
, work
);
2750 copy
= copy_font_spec (work
);
2751 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2752 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2754 if (! NILP (entity
))
2757 FONT_ADD_LOG ("match", work
, entity
);
2762 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2763 opened font object. */
2766 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2768 struct font_driver_list
*driver_list
;
2769 Lisp_Object objlist
, size
, val
, font_object
;
2771 int min_width
, height
;
2772 int scaled_pixel_size
= pixel_size
;
2774 font_assert (FONT_ENTITY_P (entity
));
2775 size
= AREF (entity
, FONT_SIZE_INDEX
);
2776 if (XINT (size
) != 0)
2777 scaled_pixel_size
= pixel_size
= XINT (size
);
2778 else if (CONSP (Vface_font_rescale_alist
))
2779 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2781 val
= AREF (entity
, FONT_TYPE_INDEX
);
2782 for (driver_list
= f
->font_driver_list
;
2783 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2784 driver_list
= driver_list
->next
);
2788 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2789 objlist
= XCDR (objlist
))
2791 Lisp_Object fn
= XCAR (objlist
);
2792 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2793 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2795 if (driver_list
->driver
->cached_font_ok
== NULL
2796 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2801 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2802 if (!NILP (font_object
))
2803 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2804 FONT_ADD_LOG ("open", entity
, font_object
);
2805 if (NILP (font_object
))
2807 ASET (entity
, FONT_OBJLIST_INDEX
,
2808 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2811 font
= XFONT_OBJECT (font_object
);
2812 min_width
= (font
->min_width
? font
->min_width
2813 : font
->average_width
? font
->average_width
2814 : font
->space_width
? font
->space_width
2816 height
= (font
->height
? font
->height
: 1);
2817 #ifdef HAVE_WINDOW_SYSTEM
2818 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2819 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2821 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2822 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2823 fonts_changed_p
= 1;
2827 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2828 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2829 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2830 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2838 /* Close FONT_OBJECT that is opened on frame F. */
2841 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2843 struct font
*font
= XFONT_OBJECT (font_object
);
2845 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2846 /* Already closed. */
2848 FONT_ADD_LOG ("close", font_object
, Qnil
);
2849 font
->driver
->close (f
, font
);
2850 #ifdef HAVE_WINDOW_SYSTEM
2851 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2852 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2858 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2859 FONT is a font-entity and it must be opened to check. */
2862 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2866 if (FONT_ENTITY_P (font
))
2868 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2869 struct font_driver_list
*driver_list
;
2871 for (driver_list
= f
->font_driver_list
;
2872 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2873 driver_list
= driver_list
->next
);
2876 if (! driver_list
->driver
->has_char
)
2878 return driver_list
->driver
->has_char (font
, c
);
2881 font_assert (FONT_OBJECT_P (font
));
2882 fontp
= XFONT_OBJECT (font
);
2883 if (fontp
->driver
->has_char
)
2885 int result
= fontp
->driver
->has_char (font
, c
);
2890 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2894 /* Return the glyph ID of FONT_OBJECT for character C. */
2897 font_encode_char (Lisp_Object font_object
, int c
)
2901 font_assert (FONT_OBJECT_P (font_object
));
2902 font
= XFONT_OBJECT (font_object
);
2903 return font
->driver
->encode_char (font
, c
);
2907 /* Return the name of FONT_OBJECT. */
2910 font_get_name (Lisp_Object font_object
)
2912 font_assert (FONT_OBJECT_P (font_object
));
2913 return AREF (font_object
, FONT_NAME_INDEX
);
2917 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2918 could not be parsed by font_parse_name, return Qnil. */
2921 font_spec_from_name (Lisp_Object font_name
)
2923 Lisp_Object spec
= Ffont_spec (0, NULL
);
2925 CHECK_STRING (font_name
);
2926 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2928 font_put_extra (spec
, QCname
, font_name
);
2929 font_put_extra (spec
, QCuser_spec
, font_name
);
2935 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2937 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2942 if (! NILP (Ffont_get (font
, QCname
)))
2944 font
= copy_font_spec (font
);
2945 font_put_extra (font
, QCname
, Qnil
);
2948 if (NILP (AREF (font
, prop
))
2949 && prop
!= FONT_FAMILY_INDEX
2950 && prop
!= FONT_FOUNDRY_INDEX
2951 && prop
!= FONT_WIDTH_INDEX
2952 && prop
!= FONT_SIZE_INDEX
)
2954 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
2955 font
= copy_font_spec (font
);
2956 ASET (font
, prop
, Qnil
);
2957 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2959 if (prop
== FONT_FAMILY_INDEX
)
2961 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2962 /* If we are setting the font family, we must also clear
2963 FONT_WIDTH_INDEX to avoid rejecting families that lack
2964 support for some widths. */
2965 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
2967 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2968 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2969 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2970 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2971 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2972 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2974 else if (prop
== FONT_SIZE_INDEX
)
2976 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2977 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2978 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2980 else if (prop
== FONT_WIDTH_INDEX
)
2981 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2982 attrs
[LFACE_FONT_INDEX
] = font
;
2985 /* Select a font from ENTITIES (list of font-entity vectors) that
2986 supports C and is the best match for ATTRS and PIXEL_SIZE. */
2989 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
2991 Lisp_Object font_entity
;
2994 FRAME_PTR f
= XFRAME (frame
);
2996 if (NILP (XCDR (entities
))
2997 && ASIZE (XCAR (entities
)) == 1)
2999 font_entity
= AREF (XCAR (entities
), 0);
3001 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3006 /* Sort fonts by properties specified in ATTRS. */
3007 prefer
= scratch_font_prefer
;
3009 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3010 ASET (prefer
, i
, Qnil
);
3011 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3013 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3015 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3016 ASET (prefer
, i
, AREF (face_font
, i
));
3018 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3019 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3020 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3021 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3022 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3023 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3024 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3026 return font_sort_entities (entities
, prefer
, frame
, c
);
3029 /* Return a font-entity that satisfies SPEC and is the best match for
3030 face's font related attributes in ATTRS. C, if not negative, is a
3031 character that the entity must support. */
3034 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3037 Lisp_Object frame
, entities
, val
;
3038 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3042 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3043 if (NILP (registry
[0]))
3045 registry
[0] = DEFAULT_ENCODING
;
3046 registry
[1] = Qascii_0
;
3047 registry
[2] = null_vector
;
3050 registry
[1] = null_vector
;
3052 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3054 struct charset
*encoding
, *repertory
;
3056 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3057 &encoding
, &repertory
) < 0)
3060 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3062 else if (c
> encoding
->max_char
)
3066 work
= copy_font_spec (spec
);
3067 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3068 XSETFRAME (frame
, f
);
3069 pixel_size
= font_pixel_size (f
, spec
);
3070 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3072 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3074 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3076 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3077 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3078 if (! NILP (foundry
[0]))
3079 foundry
[1] = null_vector
;
3080 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3082 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3083 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3085 foundry
[2] = null_vector
;
3088 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3090 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3091 if (! NILP (adstyle
[0]))
3092 adstyle
[1] = null_vector
;
3093 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3095 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3097 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3099 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3101 adstyle
[2] = null_vector
;
3104 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3107 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3110 val
= AREF (work
, FONT_FAMILY_INDEX
);
3111 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3113 val
= attrs
[LFACE_FAMILY_INDEX
];
3114 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3118 family
= alloca ((sizeof family
[0]) * 2);
3120 family
[1] = null_vector
; /* terminator. */
3125 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3126 /* Font family names are case-sensitive under NS. */
3134 if (! NILP (alters
))
3136 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3137 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3138 family
[i
] = XCAR (alters
);
3139 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3141 family
[i
] = null_vector
;
3145 family
= alloca ((sizeof family
[0]) * 3);
3148 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3150 family
[i
] = null_vector
;
3154 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3156 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3157 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3159 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3160 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3162 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3163 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3165 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3166 entities
= font_list_entities (frame
, work
);
3167 if (! NILP (entities
))
3169 val
= font_select_entity (frame
, entities
,
3170 attrs
, pixel_size
, c
);
3183 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3187 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3188 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3189 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3190 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3191 size
= font_pixel_size (f
, spec
);
3195 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3196 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3199 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3200 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3201 if (INTEGERP (height
))
3204 abort(); /* We should never end up here. */
3208 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3212 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3213 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3217 return font_open_entity (f
, entity
, size
);
3221 /* Find a font that satisfies SPEC and is the best match for
3222 face's attributes in ATTRS on FRAME, and return the opened
3226 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3228 Lisp_Object entity
, name
;
3230 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3233 /* No font is listed for SPEC, but each font-backend may have
3234 different criteria about "font matching". So, try it. */
3235 entity
= font_matching_entity (f
, attrs
, spec
);
3239 /* Don't lose the original name that was put in initially. We need
3240 it to re-apply the font when font parameters (like hinting or dpi) have
3242 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3245 name
= Ffont_get (spec
, QCuser_spec
);
3246 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3252 /* Make FACE on frame F ready to use the font opened for FACE. */
3255 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3257 if (face
->font
->driver
->prepare_face
)
3258 face
->font
->driver
->prepare_face (f
, face
);
3262 /* Make FACE on frame F stop using the font opened for FACE. */
3265 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3267 if (face
->font
->driver
->done_face
)
3268 face
->font
->driver
->done_face (f
, face
);
3273 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3274 font is found, return Qnil. */
3277 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3279 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3281 /* We set up the default font-related attributes of a face to prefer
3283 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3284 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3285 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3287 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3289 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3291 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3293 return font_load_for_lface (f
, attrs
, spec
);
3297 /* Open a font that matches NAME on frame F. If no proper font is
3298 found, return Qnil. */
3301 font_open_by_name (FRAME_PTR f
, const char *name
)
3303 Lisp_Object args
[2];
3304 Lisp_Object spec
, ret
;
3307 args
[1] = make_unibyte_string (name
, strlen (name
));
3308 spec
= Ffont_spec (2, args
);
3309 ret
= font_open_by_spec (f
, spec
);
3310 /* Do not lose name originally put in. */
3312 font_put_extra (ret
, QCuser_spec
, args
[1]);
3318 /* Register font-driver DRIVER. This function is used in two ways.
3320 The first is with frame F non-NULL. In this case, make DRIVER
3321 available (but not yet activated) on F. All frame creators
3322 (e.g. Fx_create_frame) must call this function at least once with
3323 an available font-driver.
3325 The second is with frame F NULL. In this case, DRIVER is globally
3326 registered in the variable `font_driver_list'. All font-driver
3327 implementations must call this function in its syms_of_XXXX
3328 (e.g. syms_of_xfont). */
3331 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3333 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3334 struct font_driver_list
*prev
, *list
;
3336 if (f
&& ! driver
->draw
)
3337 error ("Unusable font driver for a frame: %s",
3338 SDATA (SYMBOL_NAME (driver
->type
)));
3340 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3341 if (EQ (list
->driver
->type
, driver
->type
))
3342 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3344 list
= xmalloc (sizeof (struct font_driver_list
));
3346 list
->driver
= driver
;
3351 f
->font_driver_list
= list
;
3353 font_driver_list
= list
;
3359 free_font_driver_list (FRAME_PTR f
)
3361 struct font_driver_list
*list
, *next
;
3363 for (list
= f
->font_driver_list
; list
; list
= next
)
3368 f
->font_driver_list
= NULL
;
3372 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3373 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3374 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3376 A caller must free all realized faces if any in advance. The
3377 return value is a list of font backends actually made used on
3381 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3383 Lisp_Object active_drivers
= Qnil
;
3384 struct font_driver_list
*list
;
3386 /* At first, turn off non-requested drivers, and turn on requested
3388 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3390 struct font_driver
*driver
= list
->driver
;
3391 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3396 if (driver
->end_for_frame
)
3397 driver
->end_for_frame (f
);
3398 font_finish_cache (f
, driver
);
3403 if (! driver
->start_for_frame
3404 || driver
->start_for_frame (f
) == 0)
3406 font_prepare_cache (f
, driver
);
3413 if (NILP (new_drivers
))
3416 if (! EQ (new_drivers
, Qt
))
3418 /* Re-order the driver list according to new_drivers. */
3419 struct font_driver_list
**list_table
, **next
;
3423 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3424 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3426 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3427 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3430 list_table
[i
++] = list
;
3432 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3434 list_table
[i
++] = list
;
3435 list_table
[i
] = NULL
;
3437 next
= &f
->font_driver_list
;
3438 for (i
= 0; list_table
[i
]; i
++)
3440 *next
= list_table
[i
];
3441 next
= &(*next
)->next
;
3445 if (! f
->font_driver_list
->on
)
3446 { /* None of the drivers is enabled: enable them all.
3447 Happens if you set the list of drivers to (xft x) in your .emacs
3448 and then use it under w32 or ns. */
3449 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3451 struct font_driver
*driver
= list
->driver
;
3452 eassert (! list
->on
);
3453 if (! driver
->start_for_frame
3454 || driver
->start_for_frame (f
) == 0)
3456 font_prepare_cache (f
, driver
);
3463 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3465 active_drivers
= nconc2 (active_drivers
,
3466 Fcons (list
->driver
->type
, Qnil
));
3467 return active_drivers
;
3471 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3473 struct font_data_list
*list
, *prev
;
3475 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3476 prev
= list
, list
= list
->next
)
3477 if (list
->driver
== driver
)
3484 prev
->next
= list
->next
;
3486 f
->font_data_list
= list
->next
;
3494 list
= xmalloc (sizeof (struct font_data_list
));
3495 list
->driver
= driver
;
3496 list
->next
= f
->font_data_list
;
3497 f
->font_data_list
= list
;
3505 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3507 struct font_data_list
*list
;
3509 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3510 if (list
->driver
== driver
)
3518 /* Sets attributes on a font. Any properties that appear in ALIST and
3519 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3520 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3521 arrays of strings. This function is intended for use by the font
3522 drivers to implement their specific font_filter_properties. */
3524 font_filter_properties (Lisp_Object font
,
3526 const char *const boolean_properties
[],
3527 const char *const non_boolean_properties
[])
3532 /* Set boolean values to Qt or Qnil */
3533 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3534 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3536 Lisp_Object key
= XCAR (XCAR (it
));
3537 Lisp_Object val
= XCDR (XCAR (it
));
3538 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3540 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3542 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3543 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3546 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3547 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3548 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3549 || strcmp ("Off", str
) == 0)
3554 Ffont_put (font
, key
, val
);
3558 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3559 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3561 Lisp_Object key
= XCAR (XCAR (it
));
3562 Lisp_Object val
= XCDR (XCAR (it
));
3563 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3564 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3565 Ffont_put (font
, key
, val
);
3570 /* Return the font used to draw character C by FACE at buffer position
3571 POS in window W. If STRING is non-nil, it is a string containing C
3572 at index POS. If C is negative, get C from the current buffer or
3576 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3581 Lisp_Object font_object
;
3583 multibyte
= (NILP (string
)
3584 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3585 : STRING_MULTIBYTE (string
));
3592 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3594 c
= FETCH_CHAR (pos_byte
);
3597 c
= FETCH_BYTE (pos
);
3603 multibyte
= STRING_MULTIBYTE (string
);
3606 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3608 str
= SDATA (string
) + pos_byte
;
3609 c
= STRING_CHAR (str
);
3612 c
= SDATA (string
)[pos
];
3616 f
= XFRAME (w
->frame
);
3617 if (! FRAME_WINDOW_P (f
))
3624 if (STRINGP (string
))
3625 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3626 DEFAULT_FACE_ID
, 0);
3628 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3630 face
= FACE_FROM_ID (f
, face_id
);
3634 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3635 face
= FACE_FROM_ID (f
, face_id
);
3640 XSETFONT (font_object
, face
->font
);
3645 #ifdef HAVE_WINDOW_SYSTEM
3647 /* Check how many characters after POS (at most to *LIMIT) can be
3648 displayed by the same font in the window W. FACE, if non-NULL, is
3649 the face selected for the character at POS. If STRING is not nil,
3650 it is the string to check instead of the current buffer. In that
3651 case, FACE must be not NULL.
3653 The return value is the font-object for the character at POS.
3654 *LIMIT is set to the position where that font can't be used.
3656 It is assured that the current buffer (or STRING) is multibyte. */
3659 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3661 EMACS_INT pos_byte
, ignore
;
3663 Lisp_Object font_object
= Qnil
;
3667 pos_byte
= CHAR_TO_BYTE (pos
);
3672 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3674 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3680 pos_byte
= string_char_to_byte (string
, pos
);
3683 while (pos
< *limit
)
3685 Lisp_Object category
;
3688 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3690 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3691 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3692 if (INTEGERP (category
)
3693 && (XINT (category
) == UNICODE_CATEGORY_Cf
3694 || CHAR_VARIATION_SELECTOR_P (c
)))
3696 if (NILP (font_object
))
3698 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3699 if (NILP (font_object
))
3703 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3713 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3714 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3715 Return nil otherwise.
3716 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3717 which kind of font it is. It must be one of `font-spec', `font-entity',
3719 (Lisp_Object object
, Lisp_Object extra_type
)
3721 if (NILP (extra_type
))
3722 return (FONTP (object
) ? Qt
: Qnil
);
3723 if (EQ (extra_type
, Qfont_spec
))
3724 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3725 if (EQ (extra_type
, Qfont_entity
))
3726 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3727 if (EQ (extra_type
, Qfont_object
))
3728 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3729 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3732 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3733 doc
: /* Return a newly created font-spec with arguments as properties.
3735 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3736 valid font property name listed below:
3738 `:family', `:weight', `:slant', `:width'
3740 They are the same as face attributes of the same name. See
3741 `set-face-attribute'.
3745 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3749 VALUE must be a string or a symbol specifying the additional
3750 typographic style information of a font, e.g. ``sans''.
3754 VALUE must be a string or a symbol specifying the charset registry and
3755 encoding of a font, e.g. ``iso8859-1''.
3759 VALUE must be a non-negative integer or a floating point number
3760 specifying the font size. It specifies the font size in pixels (if
3761 VALUE is an integer), or in points (if VALUE is a float).
3765 VALUE must be a string of XLFD-style or fontconfig-style font name.
3769 VALUE must be a symbol representing a script that the font must
3770 support. It may be a symbol representing a subgroup of a script
3771 listed in the variable `script-representative-chars'.
3775 VALUE must be a symbol of two-letter ISO-639 language names,
3780 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3781 required OpenType features.
3783 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3784 LANGSYS-TAG: OpenType language system tag symbol,
3785 or nil for the default language system.
3786 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3787 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3789 GSUB and GPOS may contain `nil' element. In such a case, the font
3790 must not have any of the remaining elements.
3792 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3793 be an OpenType font whose GPOS table of `thai' script's default
3794 language system must contain `mark' feature.
3796 usage: (font-spec ARGS...) */)
3797 (ptrdiff_t nargs
, Lisp_Object
*args
)
3799 Lisp_Object spec
= font_make_spec ();
3802 for (i
= 0; i
< nargs
; i
+= 2)
3804 Lisp_Object key
= args
[i
], val
;
3808 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3811 if (EQ (key
, QCname
))
3814 font_parse_name (SSDATA (val
), spec
);
3815 font_put_extra (spec
, key
, val
);
3819 int idx
= get_font_prop_index (key
);
3823 val
= font_prop_validate (idx
, Qnil
, val
);
3824 if (idx
< FONT_EXTRA_INDEX
)
3825 ASET (spec
, idx
, val
);
3827 font_put_extra (spec
, key
, val
);
3830 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3836 /* Return a copy of FONT as a font-spec. */
3838 copy_font_spec (Lisp_Object font
)
3840 Lisp_Object new_spec
, tail
, prev
, extra
;
3844 new_spec
= font_make_spec ();
3845 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3846 ASET (new_spec
, i
, AREF (font
, i
));
3847 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3848 /* We must remove :font-entity property. */
3849 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3850 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3853 extra
= XCDR (extra
);
3855 XSETCDR (prev
, XCDR (tail
));
3858 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3862 /* Merge font-specs FROM and TO, and return a new font-spec.
3863 Every specified property in FROM overrides the corresponding
3866 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3868 Lisp_Object extra
, tail
;
3873 to
= copy_font_spec (to
);
3874 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3875 ASET (to
, i
, AREF (from
, i
));
3876 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3877 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3878 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3880 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3883 XSETCDR (slot
, XCDR (XCAR (tail
)));
3885 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3887 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3891 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3892 doc
: /* Return the value of FONT's property KEY.
3893 FONT is a font-spec, a font-entity, or a font-object.
3894 KEY is any symbol, but these are reserved for specific meanings:
3895 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3896 :size, :name, :script, :otf
3897 See the documentation of `font-spec' for their meanings.
3898 In addition, if FONT is a font-entity or a font-object, values of
3899 :script and :otf are different from those of a font-spec as below:
3901 The value of :script may be a list of scripts that are supported by the font.
3903 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3904 representing the OpenType features supported by the font by this form:
3905 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3906 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3908 (Lisp_Object font
, Lisp_Object key
)
3916 idx
= get_font_prop_index (key
);
3917 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3918 return font_style_symbolic (font
, idx
, 0);
3919 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3920 return AREF (font
, idx
);
3921 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3922 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3924 struct font
*fontp
= XFONT_OBJECT (font
);
3926 if (fontp
->driver
->otf_capability
)
3927 val
= fontp
->driver
->otf_capability (fontp
);
3929 val
= Fcons (Qnil
, Qnil
);
3936 #ifdef HAVE_WINDOW_SYSTEM
3938 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3939 doc
: /* Return a plist of face attributes generated by FONT.
3940 FONT is a font name, a font-spec, a font-entity, or a font-object.
3941 The return value is a list of the form
3943 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3945 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3946 compatible with `set-face-attribute'. Some of these key-attribute pairs
3947 may be omitted from the list if they are not specified by FONT.
3949 The optional argument FRAME specifies the frame that the face attributes
3950 are to be displayed on. If omitted, the selected frame is used. */)
3951 (Lisp_Object font
, Lisp_Object frame
)
3954 Lisp_Object plist
[10];
3959 frame
= selected_frame
;
3960 CHECK_LIVE_FRAME (frame
);
3965 int fontset
= fs_query_fontset (font
, 0);
3966 Lisp_Object name
= font
;
3968 font
= fontset_ascii (fontset
);
3969 font
= font_spec_from_name (name
);
3971 signal_error ("Invalid font name", name
);
3973 else if (! FONTP (font
))
3974 signal_error ("Invalid font object", font
);
3976 val
= AREF (font
, FONT_FAMILY_INDEX
);
3979 plist
[n
++] = QCfamily
;
3980 plist
[n
++] = SYMBOL_NAME (val
);
3983 val
= AREF (font
, FONT_SIZE_INDEX
);
3986 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3987 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3988 plist
[n
++] = QCheight
;
3989 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
3991 else if (FLOATP (val
))
3993 plist
[n
++] = QCheight
;
3994 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3997 val
= FONT_WEIGHT_FOR_FACE (font
);
4000 plist
[n
++] = QCweight
;
4004 val
= FONT_SLANT_FOR_FACE (font
);
4007 plist
[n
++] = QCslant
;
4011 val
= FONT_WIDTH_FOR_FACE (font
);
4014 plist
[n
++] = QCwidth
;
4018 return Flist (n
, plist
);
4023 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4024 doc
: /* Set one property of FONT: give property KEY value VAL.
4025 FONT is a font-spec, a font-entity, or a font-object.
4027 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4028 accepted by the function `font-spec' (which see), VAL must be what
4029 allowed in `font-spec'.
4031 If FONT is a font-entity or a font-object, KEY must not be the one
4032 accepted by `font-spec'. */)
4033 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4037 idx
= get_font_prop_index (prop
);
4038 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4040 CHECK_FONT_SPEC (font
);
4041 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4045 if (EQ (prop
, QCname
)
4046 || EQ (prop
, QCscript
)
4047 || EQ (prop
, QClang
)
4048 || EQ (prop
, QCotf
))
4049 CHECK_FONT_SPEC (font
);
4052 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4057 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4058 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4059 Optional 2nd argument FRAME specifies the target frame.
4060 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4061 Optional 4th argument PREFER, if non-nil, is a font-spec to
4062 control the order of the returned list. Fonts are sorted by
4063 how close they are to PREFER. */)
4064 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4066 Lisp_Object vec
, list
;
4070 frame
= selected_frame
;
4071 CHECK_LIVE_FRAME (frame
);
4072 CHECK_FONT_SPEC (font_spec
);
4080 if (! NILP (prefer
))
4081 CHECK_FONT_SPEC (prefer
);
4083 list
= font_list_entities (frame
, font_spec
);
4086 if (NILP (XCDR (list
))
4087 && ASIZE (XCAR (list
)) == 1)
4088 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4090 if (! NILP (prefer
))
4091 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4093 vec
= font_vconcat_entity_vectors (list
);
4094 if (n
== 0 || n
>= ASIZE (vec
))
4096 Lisp_Object args
[2];
4100 list
= Fappend (2, args
);
4104 for (list
= Qnil
, n
--; n
>= 0; n
--)
4105 list
= Fcons (AREF (vec
, n
), list
);
4110 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4111 doc
: /* List available font families on the current frame.
4112 Optional argument FRAME, if non-nil, specifies the target frame. */)
4116 struct font_driver_list
*driver_list
;
4120 frame
= selected_frame
;
4121 CHECK_LIVE_FRAME (frame
);
4124 for (driver_list
= f
->font_driver_list
; driver_list
;
4125 driver_list
= driver_list
->next
)
4126 if (driver_list
->driver
->list_family
)
4128 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4129 Lisp_Object tail
= list
;
4131 for (; CONSP (val
); val
= XCDR (val
))
4132 if (NILP (Fmemq (XCAR (val
), tail
))
4133 && SYMBOLP (XCAR (val
)))
4134 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4139 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4140 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4141 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4142 (Lisp_Object font_spec
, Lisp_Object frame
)
4144 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4151 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4152 doc
: /* Return XLFD name of FONT.
4153 FONT is a font-spec, font-entity, or font-object.
4154 If the name is too long for XLFD (maximum 255 chars), return nil.
4155 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4156 the consecutive wildcards are folded into one. */)
4157 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4164 if (FONT_OBJECT_P (font
))
4166 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4168 if (STRINGP (font_name
)
4169 && SDATA (font_name
)[0] == '-')
4171 if (NILP (fold_wildcards
))
4173 strcpy (name
, SSDATA (font_name
));
4176 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4178 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4181 if (! NILP (fold_wildcards
))
4183 char *p0
= name
, *p1
;
4185 while ((p1
= strstr (p0
, "-*-*")))
4187 strcpy (p1
, p1
+ 2);
4192 return build_string (name
);
4195 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4196 doc
: /* Clear font cache. */)
4199 Lisp_Object list
, frame
;
4201 FOR_EACH_FRAME (list
, frame
)
4203 FRAME_PTR f
= XFRAME (frame
);
4204 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4206 for (; driver_list
; driver_list
= driver_list
->next
)
4207 if (driver_list
->on
)
4209 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4210 Lisp_Object val
, tmp
;
4214 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4216 font_assert (! NILP (val
));
4217 tmp
= XCDR (XCAR (val
));
4218 if (XINT (XCAR (tmp
)) == 0)
4220 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4221 XSETCDR (cache
, XCDR (val
));
4231 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4233 struct font
*font
= XFONT_OBJECT (font_object
);
4235 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4236 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4237 struct font_metrics metrics
;
4239 LGLYPH_SET_CODE (glyph
, ecode
);
4241 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4242 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4243 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4244 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4245 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4246 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4250 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4251 doc
: /* Shape the glyph-string GSTRING.
4252 Shaping means substituting glyphs and/or adjusting positions of glyphs
4253 to get the correct visual image of character sequences set in the
4254 header of the glyph-string.
4256 If the shaping was successful, the value is GSTRING itself or a newly
4257 created glyph-string. Otherwise, the value is nil. */)
4258 (Lisp_Object gstring
)
4261 Lisp_Object font_object
, n
, glyph
;
4262 EMACS_INT i
, j
, from
, to
;
4264 if (! composition_gstring_p (gstring
))
4265 signal_error ("Invalid glyph-string: ", gstring
);
4266 if (! NILP (LGSTRING_ID (gstring
)))
4268 font_object
= LGSTRING_FONT (gstring
);
4269 CHECK_FONT_OBJECT (font_object
);
4270 font
= XFONT_OBJECT (font_object
);
4271 if (! font
->driver
->shape
)
4274 /* Try at most three times with larger gstring each time. */
4275 for (i
= 0; i
< 3; i
++)
4277 n
= font
->driver
->shape (gstring
);
4280 gstring
= larger_vector (gstring
,
4281 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4284 if (i
== 3 || XINT (n
) == 0)
4286 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4287 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4289 glyph
= LGSTRING_GLYPH (gstring
, 0);
4290 from
= LGLYPH_FROM (glyph
);
4291 to
= LGLYPH_TO (glyph
);
4292 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4294 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4298 if (NILP (LGLYPH_ADJUSTMENT (this)))
4303 glyph
= LGSTRING_GLYPH (gstring
, j
);
4304 LGLYPH_SET_FROM (glyph
, from
);
4305 LGLYPH_SET_TO (glyph
, to
);
4307 from
= LGLYPH_FROM (this);
4308 to
= LGLYPH_TO (this);
4313 if (from
> LGLYPH_FROM (this))
4314 from
= LGLYPH_FROM (this);
4315 if (to
< LGLYPH_TO (this))
4316 to
= LGLYPH_TO (this);
4322 glyph
= LGSTRING_GLYPH (gstring
, j
);
4323 LGLYPH_SET_FROM (glyph
, from
);
4324 LGLYPH_SET_TO (glyph
, to
);
4326 return composition_gstring_put_cache (gstring
, XINT (n
));
4329 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4331 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4332 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4334 VARIATION-SELECTOR is a character code of variation selection
4335 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4336 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4337 (Lisp_Object font_object
, Lisp_Object character
)
4339 unsigned variations
[256];
4344 CHECK_FONT_OBJECT (font_object
);
4345 CHECK_CHARACTER (character
);
4346 font
= XFONT_OBJECT (font_object
);
4347 if (! font
->driver
->get_variation_glyphs
)
4349 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4353 for (i
= 0; i
< 255; i
++)
4356 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4357 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4358 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4365 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4366 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4367 OTF-FEATURES specifies which features to apply in this format:
4368 (SCRIPT LANGSYS GSUB GPOS)
4370 SCRIPT is a symbol specifying a script tag of OpenType,
4371 LANGSYS is a symbol specifying a langsys tag of OpenType,
4372 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4374 If LANGYS is nil, the default langsys is selected.
4376 The features are applied in the order they appear in the list. The
4377 symbol `*' means to apply all available features not present in this
4378 list, and the remaining features are ignored. For instance, (vatu
4379 pstf * haln) is to apply vatu and pstf in this order, then to apply
4380 all available features other than vatu, pstf, and haln.
4382 The features are applied to the glyphs in the range FROM and TO of
4383 the glyph-string GSTRING-IN.
4385 If some feature is actually applicable, the resulting glyphs are
4386 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4387 this case, the value is the number of produced glyphs.
4389 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4392 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4393 produced in GSTRING-OUT, and the value is nil.
4395 See the documentation of `composition-get-gstring' for the format of
4397 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4399 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4404 check_otf_features (otf_features
);
4405 CHECK_FONT_OBJECT (font_object
);
4406 font
= XFONT_OBJECT (font_object
);
4407 if (! font
->driver
->otf_drive
)
4408 error ("Font backend %s can't drive OpenType GSUB table",
4409 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4410 CHECK_CONS (otf_features
);
4411 CHECK_SYMBOL (XCAR (otf_features
));
4412 val
= XCDR (otf_features
);
4413 CHECK_SYMBOL (XCAR (val
));
4414 val
= XCDR (otf_features
);
4417 len
= check_gstring (gstring_in
);
4418 CHECK_VECTOR (gstring_out
);
4419 CHECK_NATNUM (from
);
4421 CHECK_NATNUM (index
);
4423 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4424 args_out_of_range_3 (from
, to
, make_number (len
));
4425 if (XINT (index
) >= ASIZE (gstring_out
))
4426 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4427 num
= font
->driver
->otf_drive (font
, otf_features
,
4428 gstring_in
, XINT (from
), XINT (to
),
4429 gstring_out
, XINT (index
), 0);
4432 return make_number (num
);
4435 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4437 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4438 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4440 (SCRIPT LANGSYS FEATURE ...)
4441 See the documentation of `font-drive-otf' for more detail.
4443 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4444 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4445 character code corresponding to the glyph or nil if there's no
4446 corresponding character. */)
4447 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4450 Lisp_Object gstring_in
, gstring_out
, g
;
4451 Lisp_Object alternates
;
4454 CHECK_FONT_GET_OBJECT (font_object
, font
);
4455 if (! font
->driver
->otf_drive
)
4456 error ("Font backend %s can't drive OpenType GSUB table",
4457 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4458 CHECK_CHARACTER (character
);
4459 CHECK_CONS (otf_features
);
4461 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4462 g
= LGSTRING_GLYPH (gstring_in
, 0);
4463 LGLYPH_SET_CHAR (g
, XINT (character
));
4464 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4465 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4466 gstring_out
, 0, 1)) < 0)
4467 gstring_out
= Ffont_make_gstring (font_object
,
4468 make_number (ASIZE (gstring_out
) * 2));
4470 for (i
= 0; i
< num
; i
++)
4472 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4473 int c
= LGLYPH_CHAR (g
);
4474 unsigned code
= LGLYPH_CODE (g
);
4476 alternates
= Fcons (Fcons (make_number (code
),
4477 c
> 0 ? make_number (c
) : Qnil
),
4480 return Fnreverse (alternates
);
4486 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4487 doc
: /* Open FONT-ENTITY. */)
4488 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4492 CHECK_FONT_ENTITY (font_entity
);
4494 frame
= selected_frame
;
4495 CHECK_LIVE_FRAME (frame
);
4498 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4501 CHECK_NUMBER_OR_FLOAT (size
);
4503 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4505 isize
= XINT (size
);
4509 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4512 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4513 doc
: /* Close FONT-OBJECT. */)
4514 (Lisp_Object font_object
, Lisp_Object frame
)
4516 CHECK_FONT_OBJECT (font_object
);
4518 frame
= selected_frame
;
4519 CHECK_LIVE_FRAME (frame
);
4520 font_close_object (XFRAME (frame
), font_object
);
4524 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4525 doc
: /* Return information about FONT-OBJECT.
4526 The value is a vector:
4527 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4530 NAME is the font name, a string (or nil if the font backend doesn't
4533 FILENAME is the font file name, a string (or nil if the font backend
4534 doesn't provide a file name).
4536 PIXEL-SIZE is a pixel size by which the font is opened.
4538 SIZE is a maximum advance width of the font in pixels.
4540 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4543 CAPABILITY is a list whose first element is a symbol representing the
4544 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4545 remaining elements describe the details of the font capability.
4547 If the font is OpenType font, the form of the list is
4548 \(opentype GSUB GPOS)
4549 where GSUB shows which "GSUB" features the font supports, and GPOS
4550 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4551 lists of the format:
4552 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4554 If the font is not OpenType font, currently the length of the form is
4557 SCRIPT is a symbol representing OpenType script tag.
4559 LANGSYS is a symbol representing OpenType langsys tag, or nil
4560 representing the default langsys.
4562 FEATURE is a symbol representing OpenType feature tag.
4564 If the font is not OpenType font, CAPABILITY is nil. */)
4565 (Lisp_Object font_object
)
4570 CHECK_FONT_GET_OBJECT (font_object
, font
);
4572 val
= Fmake_vector (make_number (9), Qnil
);
4573 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4574 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4575 ASET (val
, 2, make_number (font
->pixel_size
));
4576 ASET (val
, 3, make_number (font
->max_width
));
4577 ASET (val
, 4, make_number (font
->ascent
));
4578 ASET (val
, 5, make_number (font
->descent
));
4579 ASET (val
, 6, make_number (font
->space_width
));
4580 ASET (val
, 7, make_number (font
->average_width
));
4581 if (font
->driver
->otf_capability
)
4582 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4586 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4588 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4589 FROM and TO are positions (integers or markers) specifying a region
4590 of the current buffer.
4591 If the optional fourth arg OBJECT is not nil, it is a string or a
4592 vector containing the target characters.
4594 Each element is a vector containing information of a glyph in this format:
4595 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4597 FROM is an index numbers of a character the glyph corresponds to.
4598 TO is the same as FROM.
4599 C is the character of the glyph.
4600 CODE is the glyph-code of C in FONT-OBJECT.
4601 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4602 ADJUSTMENT is always nil.
4603 If FONT-OBJECT doesn't have a glyph for a character,
4604 the corresponding element is nil. */)
4605 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4610 Lisp_Object
*chars
, vec
;
4613 CHECK_FONT_GET_OBJECT (font_object
, font
);
4616 EMACS_INT charpos
, bytepos
;
4618 validate_region (&from
, &to
);
4621 len
= XFASTINT (to
) - XFASTINT (from
);
4622 SAFE_ALLOCA_LISP (chars
, len
);
4623 charpos
= XFASTINT (from
);
4624 bytepos
= CHAR_TO_BYTE (charpos
);
4625 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4628 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4629 chars
[i
] = make_number (c
);
4632 else if (STRINGP (object
))
4634 const unsigned char *p
;
4636 CHECK_NUMBER (from
);
4638 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4639 || XINT (to
) > SCHARS (object
))
4640 args_out_of_range_3 (object
, from
, to
);
4643 len
= XFASTINT (to
) - XFASTINT (from
);
4644 SAFE_ALLOCA_LISP (chars
, len
);
4646 if (STRING_MULTIBYTE (object
))
4647 for (i
= 0; i
< len
; i
++)
4649 int c
= STRING_CHAR_ADVANCE (p
);
4650 chars
[i
] = make_number (c
);
4653 for (i
= 0; i
< len
; i
++)
4654 chars
[i
] = make_number (p
[i
]);
4658 CHECK_VECTOR (object
);
4659 CHECK_NUMBER (from
);
4661 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4662 || XINT (to
) > ASIZE (object
))
4663 args_out_of_range_3 (object
, from
, to
);
4666 len
= XFASTINT (to
) - XFASTINT (from
);
4667 for (i
= 0; i
< len
; i
++)
4669 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4670 CHECK_CHARACTER (elt
);
4672 chars
= &(AREF (object
, XFASTINT (from
)));
4675 vec
= Fmake_vector (make_number (len
), Qnil
);
4676 for (i
= 0; i
< len
; i
++)
4679 int c
= XFASTINT (chars
[i
]);
4681 struct font_metrics metrics
;
4683 code
= font
->driver
->encode_char (font
, c
);
4684 if (code
== FONT_INVALID_CODE
)
4686 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4687 LGLYPH_SET_FROM (g
, i
);
4688 LGLYPH_SET_TO (g
, i
);
4689 LGLYPH_SET_CHAR (g
, c
);
4690 LGLYPH_SET_CODE (g
, code
);
4691 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4692 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4693 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4694 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4695 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4696 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4699 if (! VECTORP (object
))
4704 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4705 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4706 FONT is a font-spec, font-entity, or font-object. */)
4707 (Lisp_Object spec
, Lisp_Object font
)
4709 CHECK_FONT_SPEC (spec
);
4712 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4715 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4716 doc
: /* Return a font-object for displaying a character at POSITION.
4717 Optional second arg WINDOW, if non-nil, is a window displaying
4718 the current buffer. It defaults to the currently selected window. */)
4719 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4726 CHECK_NUMBER_COERCE_MARKER (position
);
4727 pos
= XINT (position
);
4728 if (pos
< BEGV
|| pos
>= ZV
)
4729 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4733 CHECK_NUMBER (position
);
4734 CHECK_STRING (string
);
4735 pos
= XINT (position
);
4736 if (pos
< 0 || pos
>= SCHARS (string
))
4737 args_out_of_range (string
, position
);
4740 window
= selected_window
;
4741 CHECK_LIVE_WINDOW (window
);
4742 w
= XWINDOW (window
);
4744 return font_at (-1, pos
, NULL
, w
, string
);
4748 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4749 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4750 The value is a number of glyphs drawn.
4751 Type C-l to recover what previously shown. */)
4752 (Lisp_Object font_object
, Lisp_Object string
)
4754 Lisp_Object frame
= selected_frame
;
4755 FRAME_PTR f
= XFRAME (frame
);
4761 CHECK_FONT_GET_OBJECT (font_object
, font
);
4762 CHECK_STRING (string
);
4763 len
= SCHARS (string
);
4764 code
= alloca (sizeof (unsigned) * len
);
4765 for (i
= 0; i
< len
; i
++)
4767 Lisp_Object ch
= Faref (string
, make_number (i
));
4771 code
[i
] = font
->driver
->encode_char (font
, c
);
4772 if (code
[i
] == FONT_INVALID_CODE
)
4775 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4777 if (font
->driver
->prepare_face
)
4778 font
->driver
->prepare_face (f
, face
);
4779 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4780 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4781 if (font
->driver
->done_face
)
4782 font
->driver
->done_face (f
, face
);
4784 return make_number (len
);
4788 #endif /* FONT_DEBUG */
4790 #ifdef HAVE_WINDOW_SYSTEM
4792 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4793 doc
: /* Return information about a font named NAME on frame FRAME.
4794 If FRAME is omitted or nil, use the selected frame.
4795 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4796 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4798 OPENED-NAME is the name used for opening the font,
4799 FULL-NAME is the full name of the font,
4800 SIZE is the pixelsize of the font,
4801 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4802 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4803 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4804 how to compose characters.
4805 If the named font is not yet loaded, return nil. */)
4806 (Lisp_Object name
, Lisp_Object frame
)
4811 Lisp_Object font_object
;
4813 (*check_window_system_func
) ();
4816 CHECK_STRING (name
);
4818 frame
= selected_frame
;
4819 CHECK_LIVE_FRAME (frame
);
4824 int fontset
= fs_query_fontset (name
, 0);
4827 name
= fontset_ascii (fontset
);
4828 font_object
= font_open_by_name (f
, SSDATA (name
));
4830 else if (FONT_OBJECT_P (name
))
4832 else if (FONT_ENTITY_P (name
))
4833 font_object
= font_open_entity (f
, name
, 0);
4836 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4837 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4839 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4841 if (NILP (font_object
))
4843 font
= XFONT_OBJECT (font_object
);
4845 info
= Fmake_vector (make_number (7), Qnil
);
4846 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4847 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4848 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4849 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4850 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4851 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4852 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4855 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4856 close it now. Perhaps, we should manage font-objects
4857 by `reference-count'. */
4858 font_close_object (f
, font_object
);
4865 #define BUILD_STYLE_TABLE(TBL) \
4866 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4869 build_style_table (const struct table_entry
*entry
, int nelement
)
4872 Lisp_Object table
, elt
;
4874 table
= Fmake_vector (make_number (nelement
), Qnil
);
4875 for (i
= 0; i
< nelement
; i
++)
4877 for (j
= 0; entry
[i
].names
[j
]; j
++);
4878 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4879 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4880 for (j
= 0; entry
[i
].names
[j
]; j
++)
4881 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4882 ASET (table
, i
, elt
);
4887 /* The deferred font-log data of the form [ACTION ARG RESULT].
4888 If ACTION is not nil, that is added to the log when font_add_log is
4889 called next time. At that time, ACTION is set back to nil. */
4890 static Lisp_Object Vfont_log_deferred
;
4892 /* Prepend the font-related logging data in Vfont_log if it is not
4893 `t'. ACTION describes a kind of font-related action (e.g. listing,
4894 opening), ARG is the argument for the action, and RESULT is the
4895 result of the action. */
4897 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4902 if (EQ (Vfont_log
, Qt
))
4904 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4906 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4908 ASET (Vfont_log_deferred
, 0, Qnil
);
4909 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4910 AREF (Vfont_log_deferred
, 2));
4915 Lisp_Object tail
, elt
;
4916 Lisp_Object equalstr
= build_string ("=");
4918 val
= Ffont_xlfd_name (arg
, Qt
);
4919 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4923 if (EQ (XCAR (elt
), QCscript
)
4924 && SYMBOLP (XCDR (elt
)))
4925 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4926 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4927 else if (EQ (XCAR (elt
), QClang
)
4928 && SYMBOLP (XCDR (elt
)))
4929 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4930 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4931 else if (EQ (XCAR (elt
), QCotf
)
4932 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4933 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4935 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4941 && VECTORP (XCAR (result
))
4942 && ASIZE (XCAR (result
)) > 0
4943 && FONTP (AREF (XCAR (result
), 0)))
4944 result
= font_vconcat_entity_vectors (result
);
4947 val
= Ffont_xlfd_name (result
, Qt
);
4948 if (! FONT_SPEC_P (result
))
4949 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4950 build_string (":"), val
);
4953 else if (CONSP (result
))
4956 result
= Fcopy_sequence (result
);
4957 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4961 val
= Ffont_xlfd_name (val
, Qt
);
4962 XSETCAR (tail
, val
);
4965 else if (VECTORP (result
))
4967 result
= Fcopy_sequence (result
);
4968 for (i
= 0; i
< ASIZE (result
); i
++)
4970 val
= AREF (result
, i
);
4972 val
= Ffont_xlfd_name (val
, Qt
);
4973 ASET (result
, i
, val
);
4976 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4979 /* Record a font-related logging data to be added to Vfont_log when
4980 font_add_log is called next time. ACTION, ARG, RESULT are the same
4984 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4986 if (EQ (Vfont_log
, Qt
))
4988 ASET (Vfont_log_deferred
, 0, build_string (action
));
4989 ASET (Vfont_log_deferred
, 1, arg
);
4990 ASET (Vfont_log_deferred
, 2, result
);
4996 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4997 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4998 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4999 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5000 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5001 /* Note that the other elements in sort_shift_bits are not used. */
5003 staticpro (&font_charset_alist
);
5004 font_charset_alist
= Qnil
;
5006 DEFSYM (Qopentype
, "opentype");
5008 DEFSYM (Qascii_0
, "ascii-0");
5009 DEFSYM (Qiso8859_1
, "iso8859-1");
5010 DEFSYM (Qiso10646_1
, "iso10646-1");
5011 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5012 DEFSYM (Qunicode_sip
, "unicode-sip");
5016 DEFSYM (QCotf
, ":otf");
5017 DEFSYM (QClang
, ":lang");
5018 DEFSYM (QCscript
, ":script");
5019 DEFSYM (QCantialias
, ":antialias");
5021 DEFSYM (QCfoundry
, ":foundry");
5022 DEFSYM (QCadstyle
, ":adstyle");
5023 DEFSYM (QCregistry
, ":registry");
5024 DEFSYM (QCspacing
, ":spacing");
5025 DEFSYM (QCdpi
, ":dpi");
5026 DEFSYM (QCscalable
, ":scalable");
5027 DEFSYM (QCavgwidth
, ":avgwidth");
5028 DEFSYM (QCfont_entity
, ":font-entity");
5029 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5039 DEFSYM (QCuser_spec
, "user-spec");
5041 staticpro (&null_vector
);
5042 null_vector
= Fmake_vector (make_number (0), Qnil
);
5044 staticpro (&scratch_font_spec
);
5045 scratch_font_spec
= Ffont_spec (0, NULL
);
5046 staticpro (&scratch_font_prefer
);
5047 scratch_font_prefer
= Ffont_spec (0, NULL
);
5049 staticpro (&Vfont_log_deferred
);
5050 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5054 staticpro (&otf_list
);
5056 #endif /* HAVE_LIBOTF */
5060 defsubr (&Sfont_spec
);
5061 defsubr (&Sfont_get
);
5062 #ifdef HAVE_WINDOW_SYSTEM
5063 defsubr (&Sfont_face_attributes
);
5065 defsubr (&Sfont_put
);
5066 defsubr (&Slist_fonts
);
5067 defsubr (&Sfont_family_list
);
5068 defsubr (&Sfind_font
);
5069 defsubr (&Sfont_xlfd_name
);
5070 defsubr (&Sclear_font_cache
);
5071 defsubr (&Sfont_shape_gstring
);
5072 defsubr (&Sfont_variation_glyphs
);
5074 defsubr (&Sfont_drive_otf
);
5075 defsubr (&Sfont_otf_alternates
);
5079 defsubr (&Sopen_font
);
5080 defsubr (&Sclose_font
);
5081 defsubr (&Squery_font
);
5082 defsubr (&Sfont_get_glyphs
);
5083 defsubr (&Sfont_match_p
);
5084 defsubr (&Sfont_at
);
5086 defsubr (&Sdraw_string
);
5088 #endif /* FONT_DEBUG */
5089 #ifdef HAVE_WINDOW_SYSTEM
5090 defsubr (&Sfont_info
);
5093 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5095 Alist of fontname patterns vs the corresponding encoding and repertory info.
5096 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5097 where ENCODING is a charset or a char-table,
5098 and REPERTORY is a charset, a char-table, or nil.
5100 If ENCODING and REPERTORY are the same, the element can have the form
5101 \(REGEXP . ENCODING).
5103 ENCODING is for converting a character to a glyph code of the font.
5104 If ENCODING is a charset, encoding a character by the charset gives
5105 the corresponding glyph code. If ENCODING is a char-table, looking up
5106 the table by a character gives the corresponding glyph code.
5108 REPERTORY specifies a repertory of characters supported by the font.
5109 If REPERTORY is a charset, all characters beloging to the charset are
5110 supported. If REPERTORY is a char-table, all characters who have a
5111 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5112 gets the repertory information by an opened font and ENCODING. */);
5113 Vfont_encoding_alist
= Qnil
;
5115 /* FIXME: These 3 vars are not quite what they appear: setq on them
5116 won't have any effect other than disconnect them from the style
5117 table used by the font display code. So we make them read-only,
5118 to avoid this confusing situation. */
5120 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5121 doc
: /* Vector of valid font weight values.
5122 Each element has the form:
5123 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5124 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5125 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5126 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5128 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5129 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5130 See `font-weight-table' for the format of the vector. */);
5131 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5132 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5134 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5135 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5136 See `font-weight-table' for the format of the vector. */);
5137 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5138 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5140 staticpro (&font_style_table
);
5141 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5142 ASET (font_style_table
, 0, Vfont_weight_table
);
5143 ASET (font_style_table
, 1, Vfont_slant_table
);
5144 ASET (font_style_table
, 2, Vfont_width_table
);
5146 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5147 *Logging list of font related actions and results.
5148 The value t means to suppress the logging.
5149 The initial value is set to nil if the environment variable
5150 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5153 #ifdef HAVE_WINDOW_SYSTEM
5154 #ifdef HAVE_FREETYPE
5156 #ifdef HAVE_X_WINDOWS
5161 #endif /* HAVE_XFT */
5162 #endif /* HAVE_X_WINDOWS */
5163 #else /* not HAVE_FREETYPE */
5164 #ifdef HAVE_X_WINDOWS
5166 #endif /* HAVE_X_WINDOWS */
5167 #endif /* not HAVE_FREETYPE */
5170 #endif /* HAVE_BDFFONT */
5173 #endif /* WINDOWSNT */
5176 #endif /* HAVE_NS */
5177 #endif /* HAVE_WINDOW_SYSTEM */
5183 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;