1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2013 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/>. */
30 #include "character.h"
34 #include "dispextern.h"
36 #include "composite.h"
40 #ifdef HAVE_WINDOW_SYSTEM
42 #endif /* HAVE_WINDOW_SYSTEM */
44 Lisp_Object Qopentype
;
46 /* Important character set strings. */
47 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
49 #define DEFAULT_ENCODING Qiso8859_1
51 /* Unicode category `Cf'. */
52 static Lisp_Object QCf
;
54 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
55 static Lisp_Object font_style_table
;
57 /* Structure used for tables mapping weight, slant, and width numeric
58 values and their names. */
63 /* The first one is a valid name as a face attribute.
64 The second one (if any) is a typical name in XLFD field. */
68 /* Table of weight numeric values and their names. This table must be
69 sorted by numeric values in ascending order. */
71 static const struct table_entry weight_table
[] =
74 { 20, { "ultra-light", "ultralight" }},
75 { 40, { "extra-light", "extralight" }},
77 { 75, { "semi-light", "semilight", "demilight", "book" }},
78 { 100, { "normal", "medium", "regular", "unspecified" }},
79 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
81 { 205, { "extra-bold", "extrabold" }},
82 { 210, { "ultra-bold", "ultrabold", "black" }}
85 /* Table of slant numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static const struct table_entry slant_table
[] =
90 { 0, { "reverse-oblique", "ro" }},
91 { 10, { "reverse-italic", "ri" }},
92 { 100, { "normal", "r", "unspecified" }},
93 { 200, { "italic" ,"i", "ot" }},
94 { 210, { "oblique", "o" }}
97 /* Table of width numeric values and their names. This table must be
98 sorted by numeric values in ascending order. */
100 static const struct table_entry width_table
[] =
102 { 50, { "ultra-condensed", "ultracondensed" }},
103 { 63, { "extra-condensed", "extracondensed" }},
104 { 75, { "condensed", "compressed", "narrow" }},
105 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
106 { 100, { "normal", "medium", "regular", "unspecified" }},
107 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
108 { 125, { "expanded" }},
109 { 150, { "extra-expanded", "extraexpanded" }},
110 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
113 Lisp_Object QCfoundry
;
114 static Lisp_Object QCadstyle
, QCregistry
;
115 /* Symbols representing keys of font extra info. */
116 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
117 Lisp_Object QCantialias
, QCfont_entity
;
118 static Lisp_Object QCfc_unknown_spec
;
119 /* Symbols representing values of font spacing property. */
120 static Lisp_Object Qc
, Qm
, Qd
;
122 /* Special ADSTYLE properties to avoid fonts used for Latin
123 characters; used in xfont.c and ftfont.c. */
124 Lisp_Object Qja
, Qko
;
126 static Lisp_Object QCuser_spec
;
128 /* Alist of font registry symbols and the corresponding charset
129 information. The information is retrieved from
130 Vfont_encoding_alist on demand.
132 Eash element has the form:
133 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
137 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
138 encodes a character code to a glyph code of a font, and
139 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
140 character is supported by a font.
142 The latter form means that the information for REGISTRY couldn't be
144 static Lisp_Object font_charset_alist
;
146 /* List of all font drivers. Each font-backend (XXXfont.c) calls
147 register_font_driver in syms_of_XXXfont to register its font-driver
149 static struct font_driver_list
*font_driver_list
;
153 /* Creators of font-related Lisp object. */
156 font_make_spec (void)
158 Lisp_Object font_spec
;
159 struct font_spec
*spec
160 = ((struct font_spec
*)
161 allocate_pseudovector (VECSIZE (struct font_spec
),
162 FONT_SPEC_MAX
, PVEC_FONT
));
163 XSETFONT (font_spec
, spec
);
168 font_make_entity (void)
170 Lisp_Object font_entity
;
171 struct font_entity
*entity
172 = ((struct font_entity
*)
173 allocate_pseudovector (VECSIZE (struct font_entity
),
174 FONT_ENTITY_MAX
, PVEC_FONT
));
175 XSETFONT (font_entity
, entity
);
177 entity
->driver
= NULL
;
182 /* Create a font-object whose structure size is SIZE. If ENTITY is
183 not nil, copy properties from ENTITY to the font-object. If
184 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
186 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
188 Lisp_Object font_object
;
190 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
193 XSETFONT (font_object
, font
);
197 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
198 font
->props
[i
] = AREF (entity
, i
);
199 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
200 font
->props
[FONT_EXTRA_INDEX
]
201 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
204 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
210 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
211 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
212 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
214 static unsigned font_encode_char (Lisp_Object
, int);
216 /* Number of registered font drivers. */
217 static int num_font_drivers
;
220 /* Return a Lispy value of a font property value at STR and LEN bytes.
221 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
222 consist entirely of one or more digits, return a symbol interned
223 from STR. Otherwise, return an integer. */
226 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
231 ptrdiff_t nbytes
, nchars
;
233 if (len
== 1 && *str
== '*')
235 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
237 for (i
= 1; i
< len
; i
++)
238 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
245 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
248 return make_number (n
);
249 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
253 xsignal1 (Qoverflow_error
, make_string (str
, len
));
257 /* This code is similar to intern function from lread.c. */
258 obarray
= check_obarray (Vobarray
);
259 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
260 tem
= oblookup (obarray
, str
,
261 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
265 if (len
== nchars
|| len
!= nbytes
)
266 tem
= make_unibyte_string (str
, len
);
268 tem
= make_multibyte_string (str
, nchars
, len
);
269 return Fintern (tem
, obarray
);
272 /* Return a pixel size of font-spec SPEC on frame F. */
275 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
277 #ifdef HAVE_WINDOW_SYSTEM
278 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
287 eassert (FLOATP (size
));
288 point_size
= XFLOAT_DATA (size
);
289 val
= AREF (spec
, FONT_DPI_INDEX
);
293 dpi
= FRAME_RES_Y (f
);
294 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
302 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
303 font vector. If VAL is not valid (i.e. not registered in
304 font_style_table), return -1 if NOERROR is zero, and return a
305 proper index if NOERROR is nonzero. In that case, register VAL in
306 font_style_table if VAL is a symbol, and return the closest index if
307 VAL is an integer. */
310 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
313 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
316 CHECK_VECTOR (table
);
323 Lisp_Object args
[2], elt
;
325 /* At first try exact match. */
326 for (i
= 0; i
< len
; i
++)
328 CHECK_VECTOR (AREF (table
, i
));
329 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
330 if (EQ (val
, AREF (AREF (table
, i
), j
)))
332 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
333 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
334 | (i
<< 4) | (j
- 1));
337 /* Try also with case-folding match. */
338 s
= SSDATA (SYMBOL_NAME (val
));
339 for (i
= 0; i
< len
; i
++)
340 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
342 elt
= AREF (AREF (table
, i
), j
);
343 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
345 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
346 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
347 | (i
<< 4) | (j
- 1));
353 elt
= Fmake_vector (make_number (2), make_number (100));
356 args
[1] = Fmake_vector (make_number (1), elt
);
357 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
358 return (100 << 8) | (i
<< 4);
363 EMACS_INT numeric
= XINT (val
);
365 for (i
= 0, last_n
= -1; i
< len
; i
++)
369 CHECK_VECTOR (AREF (table
, i
));
370 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
371 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
,
393 Lisp_Object val
= AREF (font
, prop
);
394 Lisp_Object table
, elt
;
399 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
400 CHECK_VECTOR (table
);
401 i
= XINT (val
) & 0xFF;
402 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
403 elt
= AREF (table
, ((i
>> 4) & 0xF));
405 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
406 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
411 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
412 FONTNAME. ENCODING is a charset symbol that specifies the encoding
413 of the font. REPERTORY is a charset symbol or nil. */
416 find_font_encoding (Lisp_Object fontname
)
418 Lisp_Object tail
, elt
;
420 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
424 && STRINGP (XCAR (elt
))
425 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
426 && (SYMBOLP (XCDR (elt
))
427 ? CHARSETP (XCDR (elt
))
428 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
434 /* Return encoding charset and repertory charset for REGISTRY in
435 ENCODING and REPERTORY correspondingly. If correct information for
436 REGISTRY is available, return 0. Otherwise return -1. */
439 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
442 int encoding_id
, repertory_id
;
444 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
450 encoding_id
= XINT (XCAR (val
));
451 repertory_id
= XINT (XCDR (val
));
455 val
= find_font_encoding (SYMBOL_NAME (registry
));
456 if (SYMBOLP (val
) && CHARSETP (val
))
458 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
460 else if (CONSP (val
))
462 if (! CHARSETP (XCAR (val
)))
464 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
465 if (NILP (XCDR (val
)))
469 if (! CHARSETP (XCDR (val
)))
471 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
476 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
478 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
482 *encoding
= CHARSET_FROM_ID (encoding_id
);
484 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
489 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
494 /* Font property value validators. See the comment of
495 font_property_table for the meaning of the arguments. */
497 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
498 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
499 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
500 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
501 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
502 static int get_font_prop_index (Lisp_Object
);
505 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
508 val
= Fintern (val
, Qnil
);
511 else if (EQ (prop
, QCregistry
))
512 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
518 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
520 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
521 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
525 EMACS_INT n
= XINT (val
);
526 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
528 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
532 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
535 if ((n
& 0xF) + 1 >= ASIZE (elt
))
539 CHECK_NUMBER (AREF (elt
, 0));
540 if (XINT (AREF (elt
, 0)) != (n
>> 8))
545 else if (SYMBOLP (val
))
547 int n
= font_style_to_value (prop
, val
, 0);
549 val
= n
>= 0 ? make_number (n
) : Qerror
;
557 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
559 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
564 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
566 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
568 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
570 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
572 if (spacing
== 'c' || spacing
== 'C')
573 return make_number (FONT_SPACING_CHARCELL
);
574 if (spacing
== 'm' || spacing
== 'M')
575 return make_number (FONT_SPACING_MONO
);
576 if (spacing
== 'p' || spacing
== 'P')
577 return make_number (FONT_SPACING_PROPORTIONAL
);
578 if (spacing
== 'd' || spacing
== 'D')
579 return make_number (FONT_SPACING_DUAL
);
585 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
587 Lisp_Object tail
, tmp
;
590 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
591 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
592 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
595 if (! SYMBOLP (XCAR (val
)))
600 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
602 for (i
= 0; i
< 2; i
++)
609 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
610 if (! SYMBOLP (XCAR (tmp
)))
618 /* Structure of known font property keys and validator of the
622 /* Pointer to the key symbol. */
624 /* Function to validate PROP's value VAL, or NULL if any value is
625 ok. The value is VAL or its regularized value if VAL is valid,
626 and Qerror if not. */
627 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
628 } font_property_table
[] =
629 { { &QCtype
, font_prop_validate_symbol
},
630 { &QCfoundry
, font_prop_validate_symbol
},
631 { &QCfamily
, font_prop_validate_symbol
},
632 { &QCadstyle
, font_prop_validate_symbol
},
633 { &QCregistry
, font_prop_validate_symbol
},
634 { &QCweight
, font_prop_validate_style
},
635 { &QCslant
, font_prop_validate_style
},
636 { &QCwidth
, font_prop_validate_style
},
637 { &QCsize
, font_prop_validate_non_neg
},
638 { &QCdpi
, font_prop_validate_non_neg
},
639 { &QCspacing
, font_prop_validate_spacing
},
640 { &QCavgwidth
, font_prop_validate_non_neg
},
641 /* The order of the above entries must match with enum
642 font_property_index. */
643 { &QClang
, font_prop_validate_symbol
},
644 { &QCscript
, font_prop_validate_symbol
},
645 { &QCotf
, font_prop_validate_otf
}
648 /* Size (number of elements) of the above table. */
649 #define FONT_PROPERTY_TABLE_SIZE \
650 ((sizeof font_property_table) / (sizeof *font_property_table))
652 /* Return an index number of font property KEY or -1 if KEY is not an
653 already known property. */
656 get_font_prop_index (Lisp_Object key
)
660 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
661 if (EQ (key
, *font_property_table
[i
].key
))
666 /* Validate the font property. The property key is specified by the
667 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
668 signal an error. The value is VAL or the regularized one. */
671 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
673 Lisp_Object validated
;
678 prop
= *font_property_table
[idx
].key
;
681 idx
= get_font_prop_index (prop
);
685 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
686 if (EQ (validated
, Qerror
))
687 signal_error ("invalid font property", Fcons (prop
, val
));
692 /* Store VAL as a value of extra font property PROP in FONT while
693 keeping the sorting order. Don't check the validity of VAL. */
696 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
698 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
699 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
703 Lisp_Object prev
= Qnil
;
706 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
707 prev
= extra
, extra
= XCDR (extra
);
710 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
712 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
718 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
723 /* Font name parser and unparser. */
725 static int parse_matrix (const char *);
726 static int font_expand_wildcards (Lisp_Object
*, int);
727 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
729 /* An enumerator for each field of an XLFD font name. */
730 enum xlfd_field_index
749 /* An enumerator for mask bit corresponding to each XLFD field. */
752 XLFD_FOUNDRY_MASK
= 0x0001,
753 XLFD_FAMILY_MASK
= 0x0002,
754 XLFD_WEIGHT_MASK
= 0x0004,
755 XLFD_SLANT_MASK
= 0x0008,
756 XLFD_SWIDTH_MASK
= 0x0010,
757 XLFD_ADSTYLE_MASK
= 0x0020,
758 XLFD_PIXEL_MASK
= 0x0040,
759 XLFD_POINT_MASK
= 0x0080,
760 XLFD_RESX_MASK
= 0x0100,
761 XLFD_RESY_MASK
= 0x0200,
762 XLFD_SPACING_MASK
= 0x0400,
763 XLFD_AVGWIDTH_MASK
= 0x0800,
764 XLFD_REGISTRY_MASK
= 0x1000,
765 XLFD_ENCODING_MASK
= 0x2000
769 /* Parse P pointing to the pixel/point size field of the form
770 `[A B C D]' which specifies a transformation matrix:
776 by which all glyphs of the font are transformed. The spec says
777 that scalar value N for the pixel/point size is equivalent to:
778 A = N * resx/resy, B = C = 0, D = N.
780 Return the scalar value N if the form is valid. Otherwise return
784 parse_matrix (const char *p
)
790 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
793 matrix
[i
] = - strtod (p
+ 1, &end
);
795 matrix
[i
] = strtod (p
, &end
);
798 return (i
== 4 ? (int) matrix
[3] : -1);
801 /* Expand a wildcard field in FIELD (the first N fields are filled) to
802 multiple fields to fill in all 14 XLFD fields while restricting a
803 field position by its contents. */
806 font_expand_wildcards (Lisp_Object
*field
, int n
)
809 Lisp_Object tmp
[XLFD_LAST_INDEX
];
810 /* Array of information about where this element can go. Nth
811 element is for Nth element of FIELD. */
813 /* Minimum possible field. */
815 /* Maximum possible field. */
817 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
819 } range
[XLFD_LAST_INDEX
];
821 int range_from
, range_to
;
824 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
825 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
826 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
827 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
828 | XLFD_AVGWIDTH_MASK)
829 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
831 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
832 field. The value is shifted to left one bit by one in the
834 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
835 range_mask
= (range_mask
<< 1) | 1;
837 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
838 position-based restriction for FIELD[I]. */
839 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
840 i
++, range_from
++, range_to
++, range_mask
<<= 1)
842 Lisp_Object val
= field
[i
];
848 range
[i
].from
= range_from
;
849 range
[i
].to
= range_to
;
850 range
[i
].mask
= range_mask
;
854 /* The triplet FROM, TO, and MASK is a value-based
855 restriction for FIELD[I]. */
861 EMACS_INT numeric
= XINT (val
);
864 from
= to
= XLFD_ENCODING_INDEX
,
865 mask
= XLFD_ENCODING_MASK
;
866 else if (numeric
== 0)
867 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
868 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
869 else if (numeric
<= 48)
870 from
= to
= XLFD_PIXEL_INDEX
,
871 mask
= XLFD_PIXEL_MASK
;
873 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
874 mask
= XLFD_LARGENUM_MASK
;
876 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
877 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
878 mask
= XLFD_NULL_MASK
;
880 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
883 Lisp_Object name
= SYMBOL_NAME (val
);
885 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
886 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
887 mask
= XLFD_REGENC_MASK
;
889 from
= to
= XLFD_ENCODING_INDEX
,
890 mask
= XLFD_ENCODING_MASK
;
892 else if (range_from
<= XLFD_WEIGHT_INDEX
893 && range_to
>= XLFD_WEIGHT_INDEX
894 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
895 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
896 else if (range_from
<= XLFD_SLANT_INDEX
897 && range_to
>= XLFD_SLANT_INDEX
898 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
899 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
900 else if (range_from
<= XLFD_SWIDTH_INDEX
901 && range_to
>= XLFD_SWIDTH_INDEX
902 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
903 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
906 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
907 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
909 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
910 mask
= XLFD_SYMBOL_MASK
;
913 /* Merge position-based and value-based restrictions. */
915 while (from
< range_from
)
916 mask
&= ~(1 << from
++);
917 while (from
< 14 && ! (mask
& (1 << from
)))
919 while (to
> range_to
)
920 mask
&= ~(1 << to
--);
921 while (to
>= 0 && ! (mask
& (1 << to
)))
925 range
[i
].from
= from
;
927 range
[i
].mask
= mask
;
929 if (from
> range_from
|| to
< range_to
)
931 /* The range is narrowed by value-based restrictions.
932 Reflect it to the other fields. */
934 /* Following fields should be after FROM. */
936 /* Preceding fields should be before TO. */
937 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
939 /* Check FROM for non-wildcard field. */
940 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
942 while (range
[j
].from
< from
)
943 range
[j
].mask
&= ~(1 << range
[j
].from
++);
944 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
946 range
[j
].from
= from
;
949 from
= range
[j
].from
;
950 if (range
[j
].to
> to
)
952 while (range
[j
].to
> to
)
953 range
[j
].mask
&= ~(1 << range
[j
].to
--);
954 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
967 /* Decide all fields from restrictions in RANGE. */
968 for (i
= j
= 0; i
< n
; i
++)
970 if (j
< range
[i
].from
)
972 if (i
== 0 || ! NILP (tmp
[i
- 1]))
973 /* None of TMP[X] corresponds to Jth field. */
975 for (; j
< range
[i
].from
; j
++)
980 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
982 for (; j
< XLFD_LAST_INDEX
; j
++)
984 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
985 field
[XLFD_ENCODING_INDEX
]
986 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
991 /* Parse NAME (null terminated) as XLFD and store information in FONT
992 (font-spec or font-entity). Size property of FONT is set as
994 specified XLFD fields FONT property
995 --------------------- -------------
996 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
997 POINT_SIZE and RESY calculated pixel size (Lisp integer)
998 POINT_SIZE POINT_SIZE/10 (Lisp float)
1000 If NAME is successfully parsed, return 0. Otherwise return -1.
1002 FONT is usually a font-spec, but when this function is called from
1003 X font backend driver, it is a font-entity. In that case, NAME is
1004 a fully specified XLFD. */
1007 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1010 char *f
[XLFD_LAST_INDEX
+ 1];
1014 if (len
> 255 || !len
)
1015 /* Maximum XLFD name length is 255. */
1017 /* Accept "*-.." as a fully specified XLFD. */
1018 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1019 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1022 for (p
= name
+ i
; *p
; p
++)
1026 if (i
== XLFD_LAST_INDEX
)
1031 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1032 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1034 if (i
== XLFD_LAST_INDEX
)
1036 /* Fully specified XLFD. */
1039 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1040 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1041 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1042 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1044 val
= INTERN_FIELD_SYM (i
);
1047 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1049 ASET (font
, j
, make_number (n
));
1052 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1053 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1054 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1056 ASET (font
, FONT_REGISTRY_INDEX
,
1057 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1058 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1060 p
= f
[XLFD_PIXEL_INDEX
];
1061 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1062 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1065 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1067 ASET (font
, FONT_SIZE_INDEX
, val
);
1068 else if (FONT_ENTITY_P (font
))
1072 double point_size
= -1;
1074 eassert (FONT_SPEC_P (font
));
1075 p
= f
[XLFD_POINT_INDEX
];
1077 point_size
= parse_matrix (p
);
1078 else if (c_isdigit (*p
))
1079 point_size
= atoi (p
), point_size
/= 10;
1080 if (point_size
>= 0)
1081 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1085 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1086 if (! NILP (val
) && ! INTEGERP (val
))
1088 ASET (font
, FONT_DPI_INDEX
, val
);
1089 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1092 val
= font_prop_validate_spacing (QCspacing
, val
);
1093 if (! INTEGERP (val
))
1095 ASET (font
, FONT_SPACING_INDEX
, val
);
1097 p
= f
[XLFD_AVGWIDTH_INDEX
];
1100 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1101 if (! NILP (val
) && ! INTEGERP (val
))
1103 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1107 bool wild_card_found
= 0;
1108 Lisp_Object prop
[XLFD_LAST_INDEX
];
1110 if (FONT_ENTITY_P (font
))
1112 for (j
= 0; j
< i
; j
++)
1116 if (f
[j
][1] && f
[j
][1] != '-')
1119 wild_card_found
= 1;
1122 prop
[j
] = INTERN_FIELD (j
);
1124 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1126 if (! wild_card_found
)
1128 if (font_expand_wildcards (prop
, i
) < 0)
1131 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1132 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1133 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1134 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1135 if (! NILP (prop
[i
]))
1137 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1139 ASET (font
, j
, make_number (n
));
1141 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1142 val
= prop
[XLFD_REGISTRY_INDEX
];
1145 val
= prop
[XLFD_ENCODING_INDEX
];
1147 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1149 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1150 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1152 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1153 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1155 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1157 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1158 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1159 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1161 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1163 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1166 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1167 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1168 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1170 val
= font_prop_validate_spacing (QCspacing
,
1171 prop
[XLFD_SPACING_INDEX
]);
1172 if (! INTEGERP (val
))
1174 ASET (font
, FONT_SPACING_INDEX
, val
);
1176 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1177 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1183 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1184 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1185 0, use PIXEL_SIZE instead. */
1188 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1191 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1195 eassert (FONTP (font
));
1197 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1200 if (i
== FONT_ADSTYLE_INDEX
)
1201 j
= XLFD_ADSTYLE_INDEX
;
1202 else if (i
== FONT_REGISTRY_INDEX
)
1203 j
= XLFD_REGISTRY_INDEX
;
1204 val
= AREF (font
, i
);
1207 if (j
== XLFD_REGISTRY_INDEX
)
1215 val
= SYMBOL_NAME (val
);
1216 if (j
== XLFD_REGISTRY_INDEX
1217 && ! strchr (SSDATA (val
), '-'))
1219 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1220 ptrdiff_t alloc
= SBYTES (val
) + 4;
1221 if (nbytes
<= alloc
)
1223 f
[j
] = p
= alloca (alloc
);
1224 sprintf (p
, "%s%s-*", SDATA (val
),
1225 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1228 f
[j
] = SSDATA (val
);
1232 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1235 val
= font_style_symbolic (font
, i
, 0);
1243 val
= SYMBOL_NAME (val
);
1244 alloc
= SBYTES (val
) + 1;
1245 if (nbytes
<= alloc
)
1247 f
[j
] = p
= alloca (alloc
);
1248 /* Copy the name while excluding '-', '?', ',', and '"'. */
1249 for (k
= l
= 0; k
< alloc
; k
++)
1252 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1258 val
= AREF (font
, FONT_SIZE_INDEX
);
1259 eassert (NUMBERP (val
) || NILP (val
));
1262 EMACS_INT v
= XINT (val
);
1267 f
[XLFD_PIXEL_INDEX
] = p
=
1268 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1269 sprintf (p
, "%"pI
"d-*", v
);
1272 f
[XLFD_PIXEL_INDEX
] = "*-*";
1274 else if (FLOATP (val
))
1276 double v
= XFLOAT_DATA (val
) * 10;
1277 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1278 sprintf (p
, "*-%.0f", v
);
1281 f
[XLFD_PIXEL_INDEX
] = "*-*";
1283 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1285 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1286 f
[XLFD_RESX_INDEX
] = p
=
1287 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1288 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1291 f
[XLFD_RESX_INDEX
] = "*-*";
1292 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1294 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1296 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1297 : spacing
<= FONT_SPACING_DUAL
? "d"
1298 : spacing
<= FONT_SPACING_MONO
? "m"
1302 f
[XLFD_SPACING_INDEX
] = "*";
1303 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1305 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1306 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1309 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1310 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1311 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1312 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1313 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1314 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1315 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1316 f
[XLFD_REGISTRY_INDEX
]);
1317 return len
< nbytes
? len
: -1;
1320 /* Parse NAME (null terminated) and store information in FONT
1321 (font-spec or font-entity). NAME is supplied in either the
1322 Fontconfig or GTK font name format. If NAME is successfully
1323 parsed, return 0. Otherwise return -1.
1325 The fontconfig format is
1327 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1331 FAMILY [PROPS...] [SIZE]
1333 This function tries to guess which format it is. */
1336 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1339 char *size_beg
= NULL
, *size_end
= NULL
;
1340 char *props_beg
= NULL
, *family_end
= NULL
;
1345 for (p
= name
; *p
; p
++)
1347 if (*p
== '\\' && p
[1])
1351 props_beg
= family_end
= p
;
1356 bool decimal
= 0, size_found
= 1;
1357 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1358 if (! c_isdigit (*q
))
1360 if (*q
!= '.' || decimal
)
1379 Lisp_Object extra_props
= Qnil
;
1381 /* A fontconfig name with size and/or property data. */
1382 if (family_end
> name
)
1385 family
= font_intern_prop (name
, family_end
- name
, 1);
1386 ASET (font
, FONT_FAMILY_INDEX
, family
);
1390 double point_size
= strtod (size_beg
, &size_end
);
1391 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1392 if (*size_end
== ':' && size_end
[1])
1393 props_beg
= size_end
;
1397 /* Now parse ":KEY=VAL" patterns. */
1400 for (p
= props_beg
; *p
; p
= q
)
1402 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1405 /* Must be an enumerated value. */
1409 val
= font_intern_prop (p
, q
- p
, 1);
1411 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1412 && memcmp (p, STR, strlen (STR)) == 0)
1414 if (PROP_MATCH ("light")
1415 || PROP_MATCH ("medium")
1416 || PROP_MATCH ("demibold")
1417 || PROP_MATCH ("bold")
1418 || PROP_MATCH ("black"))
1419 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1420 else if (PROP_MATCH ("roman")
1421 || PROP_MATCH ("italic")
1422 || PROP_MATCH ("oblique"))
1423 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1424 else if (PROP_MATCH ("charcell"))
1425 ASET (font
, FONT_SPACING_INDEX
,
1426 make_number (FONT_SPACING_CHARCELL
));
1427 else if (PROP_MATCH ("mono"))
1428 ASET (font
, FONT_SPACING_INDEX
,
1429 make_number (FONT_SPACING_MONO
));
1430 else if (PROP_MATCH ("proportional"))
1431 ASET (font
, FONT_SPACING_INDEX
,
1432 make_number (FONT_SPACING_PROPORTIONAL
));
1441 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1442 prop
= FONT_SIZE_INDEX
;
1445 key
= font_intern_prop (p
, q
- p
, 1);
1446 prop
= get_font_prop_index (key
);
1450 for (q
= p
; *q
&& *q
!= ':'; q
++);
1451 val
= font_intern_prop (p
, q
- p
, 0);
1453 if (prop
>= FONT_FOUNDRY_INDEX
1454 && prop
< FONT_EXTRA_INDEX
)
1455 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1458 extra_props
= nconc2 (extra_props
,
1459 list1 (Fcons (key
, val
)));
1466 if (! NILP (extra_props
))
1468 struct font_driver_list
*driver_list
= font_driver_list
;
1469 for ( ; driver_list
; driver_list
= driver_list
->next
)
1470 if (driver_list
->driver
->filter_properties
)
1471 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1477 /* Either a fontconfig-style name with no size and property
1478 data, or a GTK-style name. */
1479 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1480 Lisp_Object width
= Qnil
, size
= Qnil
;
1484 /* Scan backwards from the end, looking for a size. */
1485 for (p
= name
+ len
- 1; p
>= name
; p
--)
1486 if (!c_isdigit (*p
))
1489 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1490 /* Found a font size. */
1491 size
= make_float (strtod (p
+ 1, NULL
));
1495 /* Now P points to the termination of the string, sans size.
1496 Scan backwards, looking for font properties. */
1497 for (; p
> name
; p
= q
)
1499 for (q
= p
- 1; q
>= name
; q
--)
1501 if (q
> name
&& *(q
-1) == '\\')
1502 --q
; /* Skip quoting backslashes. */
1508 word_len
= p
- word_start
;
1510 #define PROP_MATCH(STR) \
1511 (word_len == strlen (STR) \
1512 && memcmp (word_start, STR, strlen (STR)) == 0)
1513 #define PROP_SAVE(VAR, STR) \
1514 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1516 if (PROP_MATCH ("Ultra-Light"))
1517 PROP_SAVE (weight
, "ultra-light");
1518 else if (PROP_MATCH ("Light"))
1519 PROP_SAVE (weight
, "light");
1520 else if (PROP_MATCH ("Book"))
1521 PROP_SAVE (weight
, "book");
1522 else if (PROP_MATCH ("Medium"))
1523 PROP_SAVE (weight
, "medium");
1524 else if (PROP_MATCH ("Semi-Bold"))
1525 PROP_SAVE (weight
, "semi-bold");
1526 else if (PROP_MATCH ("Bold"))
1527 PROP_SAVE (weight
, "bold");
1528 else if (PROP_MATCH ("Italic"))
1529 PROP_SAVE (slant
, "italic");
1530 else if (PROP_MATCH ("Oblique"))
1531 PROP_SAVE (slant
, "oblique");
1532 else if (PROP_MATCH ("Semi-Condensed"))
1533 PROP_SAVE (width
, "semi-condensed");
1534 else if (PROP_MATCH ("Condensed"))
1535 PROP_SAVE (width
, "condensed");
1536 /* An unknown word must be part of the font name. */
1547 ASET (font
, FONT_FAMILY_INDEX
,
1548 font_intern_prop (name
, family_end
- name
, 1));
1550 ASET (font
, FONT_SIZE_INDEX
, size
);
1552 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1554 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1556 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1562 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1563 NAME (NBYTES length), and return the name length. If
1564 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1567 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1569 Lisp_Object family
, foundry
;
1575 Lisp_Object styles
[3];
1576 const char *style_names
[3] = { "weight", "slant", "width" };
1578 family
= AREF (font
, FONT_FAMILY_INDEX
);
1579 if (! NILP (family
))
1581 if (SYMBOLP (family
))
1582 family
= SYMBOL_NAME (family
);
1587 val
= AREF (font
, FONT_SIZE_INDEX
);
1590 if (XINT (val
) != 0)
1591 pixel_size
= XINT (val
);
1596 eassert (FLOATP (val
));
1598 point_size
= (int) XFLOAT_DATA (val
);
1601 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1602 if (! NILP (foundry
))
1604 if (SYMBOLP (foundry
))
1605 foundry
= SYMBOL_NAME (foundry
);
1610 for (i
= 0; i
< 3; i
++)
1611 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1614 lim
= name
+ nbytes
;
1615 if (! NILP (family
))
1617 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1618 if (! (0 <= len
&& len
< lim
- p
))
1624 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1625 if (! (0 <= len
&& len
< lim
- p
))
1629 else if (pixel_size
> 0)
1631 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1632 if (! (0 <= len
&& len
< lim
- p
))
1636 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1638 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1639 SSDATA (SYMBOL_NAME (AREF (font
,
1640 FONT_FOUNDRY_INDEX
))));
1641 if (! (0 <= len
&& len
< lim
- p
))
1645 for (i
= 0; i
< 3; i
++)
1646 if (! NILP (styles
[i
]))
1648 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1649 SSDATA (SYMBOL_NAME (styles
[i
])));
1650 if (! (0 <= len
&& len
< lim
- p
))
1655 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1657 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1658 XINT (AREF (font
, FONT_DPI_INDEX
)));
1659 if (! (0 <= len
&& len
< lim
- p
))
1664 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1666 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1667 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1668 if (! (0 <= len
&& len
< lim
- p
))
1673 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1675 int len
= snprintf (p
, lim
- p
,
1676 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1678 : ":scalable=false"));
1679 if (! (0 <= len
&& len
< lim
- p
))
1687 /* Parse NAME (null terminated) and store information in FONT
1688 (font-spec or font-entity). If NAME is successfully parsed, return
1689 0. Otherwise return -1. */
1692 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1694 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1695 return font_parse_xlfd (name
, namelen
, font
);
1696 return font_parse_fcname (name
, namelen
, font
);
1700 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1701 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1705 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1711 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1713 CHECK_STRING (family
);
1714 len
= SBYTES (family
);
1715 p0
= SSDATA (family
);
1716 p1
= strchr (p0
, '-');
1719 if ((*p0
!= '*' && p1
- p0
> 0)
1720 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1721 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1724 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1727 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1729 if (! NILP (registry
))
1731 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1732 CHECK_STRING (registry
);
1733 len
= SBYTES (registry
);
1734 p0
= SSDATA (registry
);
1735 p1
= strchr (p0
, '-');
1738 if (SDATA (registry
)[len
- 1] == '*')
1739 registry
= concat2 (registry
, build_string ("-*"));
1741 registry
= concat2 (registry
, build_string ("*-*"));
1743 registry
= Fdowncase (registry
);
1744 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1749 /* This part (through the next ^L) is still experimental and not
1750 tested much. We may drastically change codes. */
1756 #define LGSTRING_HEADER_SIZE 6
1757 #define LGSTRING_GLYPH_SIZE 8
1760 check_gstring (Lisp_Object gstring
)
1766 CHECK_VECTOR (gstring
);
1767 val
= AREF (gstring
, 0);
1769 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1771 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1772 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1773 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1774 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1775 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1776 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1777 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1778 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1779 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1780 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1781 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1783 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1785 val
= LGSTRING_GLYPH (gstring
, i
);
1787 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1789 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1791 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1792 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1793 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1794 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1795 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1796 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1797 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1798 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1800 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1802 if (ASIZE (val
) < 3)
1804 for (j
= 0; j
< 3; j
++)
1805 CHECK_NUMBER (AREF (val
, j
));
1810 error ("Invalid glyph-string format");
1815 check_otf_features (Lisp_Object otf_features
)
1819 CHECK_CONS (otf_features
);
1820 CHECK_SYMBOL (XCAR (otf_features
));
1821 otf_features
= XCDR (otf_features
);
1822 CHECK_CONS (otf_features
);
1823 CHECK_SYMBOL (XCAR (otf_features
));
1824 otf_features
= XCDR (otf_features
);
1825 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1827 CHECK_SYMBOL (XCAR (val
));
1828 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1829 error ("Invalid OTF GSUB feature: %s",
1830 SDATA (SYMBOL_NAME (XCAR (val
))));
1832 otf_features
= XCDR (otf_features
);
1833 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1835 CHECK_SYMBOL (XCAR (val
));
1836 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1837 error ("Invalid OTF GPOS feature: %s",
1838 SDATA (SYMBOL_NAME (XCAR (val
))));
1845 Lisp_Object otf_list
;
1848 otf_tag_symbol (OTF_Tag tag
)
1852 OTF_tag_name (tag
, name
);
1853 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1857 otf_open (Lisp_Object file
)
1859 Lisp_Object val
= Fassoc (file
, otf_list
);
1863 otf
= XSAVE_POINTER (XCDR (val
), 0);
1866 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1867 val
= make_save_ptr (otf
);
1868 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1874 /* Return a list describing which scripts/languages FONT supports by
1875 which GSUB/GPOS features of OpenType tables. See the comment of
1876 (struct font_driver).otf_capability. */
1879 font_otf_capability (struct font
*font
)
1882 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1885 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1888 for (i
= 0; i
< 2; i
++)
1890 OTF_GSUB_GPOS
*gsub_gpos
;
1891 Lisp_Object script_list
= Qnil
;
1894 if (OTF_get_features (otf
, i
== 0) < 0)
1896 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1897 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1899 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1900 Lisp_Object langsys_list
= Qnil
;
1901 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1904 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1906 OTF_LangSys
*langsys
;
1907 Lisp_Object feature_list
= Qnil
;
1908 Lisp_Object langsys_tag
;
1911 if (k
== script
->LangSysCount
)
1913 langsys
= &script
->DefaultLangSys
;
1918 langsys
= script
->LangSys
+ k
;
1920 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1922 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1924 OTF_Feature
*feature
1925 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1926 Lisp_Object feature_tag
1927 = otf_tag_symbol (feature
->FeatureTag
);
1929 feature_list
= Fcons (feature_tag
, feature_list
);
1931 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1934 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1939 XSETCAR (capability
, script_list
);
1941 XSETCDR (capability
, script_list
);
1947 /* Parse OTF features in SPEC and write a proper features spec string
1948 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1949 assured that the sufficient memory has already allocated for
1953 generate_otf_features (Lisp_Object spec
, char *features
)
1961 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1967 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1972 else if (! asterisk
)
1974 val
= SYMBOL_NAME (val
);
1975 p
+= esprintf (p
, "%s", SDATA (val
));
1979 val
= SYMBOL_NAME (val
);
1980 p
+= esprintf (p
, "~%s", SDATA (val
));
1984 error ("OTF spec too long");
1988 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1990 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1992 return Fcons (make_number (len
),
1993 make_unibyte_string (device_table
->DeltaValue
, len
));
1997 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
1999 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2001 if (value_format
& OTF_XPlacement
)
2002 ASET (val
, 0, make_number (value_record
->XPlacement
));
2003 if (value_format
& OTF_YPlacement
)
2004 ASET (val
, 1, make_number (value_record
->YPlacement
));
2005 if (value_format
& OTF_XAdvance
)
2006 ASET (val
, 2, make_number (value_record
->XAdvance
));
2007 if (value_format
& OTF_YAdvance
)
2008 ASET (val
, 3, make_number (value_record
->YAdvance
));
2009 if (value_format
& OTF_XPlaDevice
)
2010 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2011 if (value_format
& OTF_YPlaDevice
)
2012 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2013 if (value_format
& OTF_XAdvDevice
)
2014 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2015 if (value_format
& OTF_YAdvDevice
)
2016 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2021 font_otf_Anchor (OTF_Anchor
*anchor
)
2025 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2026 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2027 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2028 if (anchor
->AnchorFormat
== 2)
2029 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2032 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2033 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2037 #endif /* HAVE_LIBOTF */
2044 font_rescale_ratio (Lisp_Object font_entity
)
2046 Lisp_Object tail
, elt
;
2047 Lisp_Object name
= Qnil
;
2049 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2052 if (FLOATP (XCDR (elt
)))
2054 if (STRINGP (XCAR (elt
)))
2057 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2058 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2059 return XFLOAT_DATA (XCDR (elt
));
2061 else if (FONT_SPEC_P (XCAR (elt
)))
2063 if (font_match_p (XCAR (elt
), font_entity
))
2064 return XFLOAT_DATA (XCDR (elt
));
2071 /* We sort fonts by scoring each of them against a specified
2072 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2073 the value is, the closer the font is to the font-spec.
2075 The lowest 2 bits of the score are used for driver type. The font
2076 available by the most preferred font driver is 0.
2078 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2079 WEIGHT, SLANT, WIDTH, and SIZE. */
2081 /* How many bits to shift to store the difference value of each font
2082 property in a score. Note that floats for FONT_TYPE_INDEX and
2083 FONT_REGISTRY_INDEX are not used. */
2084 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2086 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2087 The return value indicates how different ENTITY is compared with
2091 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2096 /* Score three style numeric fields. Maximum difference is 127. */
2097 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2098 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2100 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2101 - (XINT (spec_prop
[i
]) >> 8));
2102 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2105 /* Score the size. Maximum difference is 127. */
2106 i
= FONT_SIZE_INDEX
;
2107 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2108 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2110 /* We use the higher 6-bit for the actual size difference. The
2111 lowest bit is set if the DPI is different. */
2113 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2115 if (CONSP (Vface_font_rescale_alist
))
2116 pixel_size
*= font_rescale_ratio (entity
);
2117 diff
= eabs (pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
))) << 1;
2118 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2119 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2121 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2122 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2124 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2131 /* Concatenate all elements of LIST into one vector. LIST is a list
2132 of font-entity vectors. */
2135 font_vconcat_entity_vectors (Lisp_Object list
)
2137 int nargs
= XINT (Flength (list
));
2138 Lisp_Object
*args
= alloca (word_size
* nargs
);
2141 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2142 args
[i
] = XCAR (list
);
2143 return Fvconcat (nargs
, args
);
2147 /* The structure for elements being sorted by qsort. */
2148 struct font_sort_data
2151 int font_driver_preference
;
2156 /* The comparison function for qsort. */
2159 font_compare (const void *d1
, const void *d2
)
2161 const struct font_sort_data
*data1
= d1
;
2162 const struct font_sort_data
*data2
= d2
;
2164 if (data1
->score
< data2
->score
)
2166 else if (data1
->score
> data2
->score
)
2168 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2172 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2173 If PREFER specifies a point-size, calculate the corresponding
2174 pixel-size from QCdpi property of PREFER or from the Y-resolution
2175 of FRAME before sorting.
2177 If BEST-ONLY is nonzero, return the best matching entity (that
2178 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2179 if BEST-ONLY is negative). Otherwise, return the sorted result as
2180 a single vector of font-entities.
2182 This function does no optimization for the case that the total
2183 number of elements is 1. The caller should avoid calling this in
2187 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2188 struct frame
*f
, int best_only
)
2190 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2192 struct font_sort_data
*data
;
2193 unsigned best_score
;
2194 Lisp_Object best_entity
;
2195 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2198 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2199 prefer_prop
[i
] = AREF (prefer
, i
);
2200 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2201 prefer_prop
[FONT_SIZE_INDEX
]
2202 = make_number (font_pixel_size (f
, prefer
));
2204 if (NILP (XCDR (list
)))
2206 /* What we have to take care of is this single vector. */
2208 maxlen
= ASIZE (vec
);
2212 /* We don't have to perform sort, so there's no need of creating
2213 a single vector. But, we must find the length of the longest
2216 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2217 if (maxlen
< ASIZE (XCAR (tail
)))
2218 maxlen
= ASIZE (XCAR (tail
));
2222 /* We have to create a single vector to sort it. */
2223 vec
= font_vconcat_entity_vectors (list
);
2224 maxlen
= ASIZE (vec
);
2227 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2228 best_score
= 0xFFFFFFFF;
2231 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2233 int font_driver_preference
= 0;
2234 Lisp_Object current_font_driver
;
2240 /* We are sure that the length of VEC > 0. */
2241 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2242 /* Score the elements. */
2243 for (i
= 0; i
< len
; i
++)
2245 data
[i
].entity
= AREF (vec
, i
);
2247 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2249 ? font_score (data
[i
].entity
, prefer_prop
)
2251 if (best_only
&& best_score
> data
[i
].score
)
2253 best_score
= data
[i
].score
;
2254 best_entity
= data
[i
].entity
;
2255 if (best_score
== 0)
2258 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2260 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2261 font_driver_preference
++;
2263 data
[i
].font_driver_preference
= font_driver_preference
;
2266 /* Sort if necessary. */
2269 qsort (data
, len
, sizeof *data
, font_compare
);
2270 for (i
= 0; i
< len
; i
++)
2271 ASET (vec
, i
, data
[i
].entity
);
2280 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2285 /* API of Font Service Layer. */
2287 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2288 sort_shift_bits. Finternal_set_font_selection_order calls this
2289 function with font_sort_order after setting up it. */
2292 font_update_sort_order (int *order
)
2296 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2298 int xlfd_idx
= order
[i
];
2300 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2301 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2302 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2303 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2304 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2305 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2307 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2312 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2313 Lisp_Object features
, Lisp_Object table
)
2318 table
= assq_no_quit (script
, table
);
2321 table
= XCDR (table
);
2322 if (! NILP (langsys
))
2324 table
= assq_no_quit (langsys
, table
);
2330 val
= assq_no_quit (Qnil
, table
);
2332 table
= XCAR (table
);
2336 table
= XCDR (table
);
2337 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2339 if (NILP (XCAR (features
)))
2344 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2350 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2353 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2355 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2357 script
= XCAR (spec
);
2361 langsys
= XCAR (spec
);
2372 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2373 XCAR (otf_capability
)))
2375 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2376 XCDR (otf_capability
)))
2383 /* Check if FONT (font-entity or font-object) matches with the font
2384 specification SPEC. */
2387 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2389 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2390 Lisp_Object extra
, font_extra
;
2393 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2394 if (! NILP (AREF (spec
, i
))
2395 && ! NILP (AREF (font
, i
))
2396 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2398 props
= XFONT_SPEC (spec
)->props
;
2399 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2401 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2402 prop
[i
] = AREF (spec
, i
);
2403 prop
[FONT_SIZE_INDEX
]
2404 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2408 if (font_score (font
, props
) > 0)
2410 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2411 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2412 for (; CONSP (extra
); extra
= XCDR (extra
))
2414 Lisp_Object key
= XCAR (XCAR (extra
));
2415 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2417 if (EQ (key
, QClang
))
2419 val2
= assq_no_quit (key
, font_extra
);
2428 if (NILP (Fmemq (val
, val2
)))
2433 ? NILP (Fmemq (val
, XCDR (val2
)))
2437 else if (EQ (key
, QCscript
))
2439 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2445 /* All characters in the list must be supported. */
2446 for (; CONSP (val2
); val2
= XCDR (val2
))
2448 if (! CHARACTERP (XCAR (val2
)))
2450 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2451 == FONT_INVALID_CODE
)
2455 else if (VECTORP (val2
))
2457 /* At most one character in the vector must be supported. */
2458 for (i
= 0; i
< ASIZE (val2
); i
++)
2460 if (! CHARACTERP (AREF (val2
, i
)))
2462 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2463 != FONT_INVALID_CODE
)
2466 if (i
== ASIZE (val2
))
2471 else if (EQ (key
, QCotf
))
2475 if (! FONT_OBJECT_P (font
))
2477 fontp
= XFONT_OBJECT (font
);
2478 if (! fontp
->driver
->otf_capability
)
2480 val2
= fontp
->driver
->otf_capability (fontp
);
2481 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2492 Each font backend has the callback function get_cache, and it
2493 returns a cons cell of which cdr part can be freely used for
2494 caching fonts. The cons cell may be shared by multiple frames
2495 and/or multiple font drivers. So, we arrange the cdr part as this:
2497 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2499 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2500 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2501 cons (FONT-SPEC FONT-ENTITY ...). */
2503 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2504 static void font_finish_cache (struct frame
*, struct font_driver
*);
2505 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2506 static void font_clear_cache (struct frame
*, Lisp_Object
,
2507 struct font_driver
*);
2510 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2512 Lisp_Object cache
, val
;
2514 cache
= driver
->get_cache (f
);
2516 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2520 val
= list2 (driver
->type
, make_number (1));
2521 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2525 val
= XCDR (XCAR (val
));
2526 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2532 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2534 Lisp_Object cache
, val
, tmp
;
2537 cache
= driver
->get_cache (f
);
2539 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2540 cache
= val
, val
= XCDR (val
);
2541 eassert (! NILP (val
));
2542 tmp
= XCDR (XCAR (val
));
2543 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2544 if (XINT (XCAR (tmp
)) == 0)
2546 font_clear_cache (f
, XCAR (val
), driver
);
2547 XSETCDR (cache
, XCDR (val
));
2553 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2555 Lisp_Object val
= driver
->get_cache (f
);
2556 Lisp_Object type
= driver
->type
;
2558 eassert (CONSP (val
));
2559 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2560 eassert (CONSP (val
));
2561 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2562 val
= XCDR (XCAR (val
));
2568 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2570 Lisp_Object tail
, elt
;
2571 Lisp_Object tail2
, entity
;
2573 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2574 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2577 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2578 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2580 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2582 entity
= XCAR (tail2
);
2584 if (FONT_ENTITY_P (entity
)
2585 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2587 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2589 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2591 Lisp_Object val
= XCAR (objlist
);
2592 struct font
*font
= XFONT_OBJECT (val
);
2594 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2596 eassert (font
&& driver
== font
->driver
);
2597 driver
->close (font
);
2600 if (driver
->free_entity
)
2601 driver
->free_entity (entity
);
2606 XSETCDR (cache
, Qnil
);
2610 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2612 /* Check each font-entity in VEC, and return a list of font-entities
2613 that satisfy these conditions:
2614 (1) matches with SPEC and SIZE if SPEC is not nil, and
2615 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2619 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2621 Lisp_Object entity
, val
;
2622 enum font_property_index prop
;
2625 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2627 entity
= AREF (vec
, i
);
2628 if (! NILP (Vface_ignored_fonts
))
2632 Lisp_Object tail
, regexp
;
2634 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2637 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2639 regexp
= XCAR (tail
);
2640 if (STRINGP (regexp
)
2641 && fast_c_string_match_ignore_case (regexp
, name
,
2651 val
= Fcons (entity
, val
);
2654 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2655 if (INTEGERP (AREF (spec
, prop
))
2656 && ((XINT (AREF (spec
, prop
)) >> 8)
2657 != (XINT (AREF (entity
, prop
)) >> 8)))
2658 prop
= FONT_SPEC_MAX
;
2659 if (prop
< FONT_SPEC_MAX
2661 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2663 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2665 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2666 prop
= FONT_SPEC_MAX
;
2668 if (prop
< FONT_SPEC_MAX
2669 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2670 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2671 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2672 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2673 prop
= FONT_SPEC_MAX
;
2674 if (prop
< FONT_SPEC_MAX
2675 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2676 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2677 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2678 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2679 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2680 prop
= FONT_SPEC_MAX
;
2681 if (prop
< FONT_SPEC_MAX
)
2682 val
= Fcons (entity
, val
);
2684 return (Fvconcat (1, &val
));
2688 /* Return a list of vectors of font-entities matching with SPEC on
2689 FRAME. Each elements in the list is a vector of entities from the
2690 same font-driver. */
2693 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2695 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2696 Lisp_Object ftype
, val
;
2697 Lisp_Object list
= Qnil
;
2699 bool need_filtering
= 0;
2702 eassert (FONT_SPEC_P (spec
));
2704 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2705 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2706 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2707 size
= font_pixel_size (f
, spec
);
2711 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2712 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2713 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2714 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2715 if (i
!= FONT_SPACING_INDEX
)
2717 ASET (scratch_font_spec
, i
, Qnil
);
2718 if (! NILP (AREF (spec
, i
)))
2721 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2722 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2724 for (; driver_list
; driver_list
= driver_list
->next
)
2726 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2728 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2730 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2731 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2738 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2742 val
= Fvconcat (1, &val
);
2743 copy
= copy_font_spec (scratch_font_spec
);
2744 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2745 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2749 || ! NILP (Vface_ignored_fonts
)))
2750 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2751 if (ASIZE (val
) > 0)
2752 list
= Fcons (val
, list
);
2755 list
= Fnreverse (list
);
2756 FONT_ADD_LOG ("list", spec
, list
);
2761 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2762 nil, is an array of face's attributes, which specifies preferred
2763 font-related attributes. */
2766 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2768 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2769 Lisp_Object ftype
, size
, entity
;
2770 Lisp_Object work
= copy_font_spec (spec
);
2772 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2773 size
= AREF (spec
, FONT_SIZE_INDEX
);
2776 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2777 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2778 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2779 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2782 for (; driver_list
; driver_list
= driver_list
->next
)
2784 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2786 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2789 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2790 entity
= assoc_no_quit (work
, XCDR (cache
));
2792 entity
= XCDR (entity
);
2795 entity
= driver_list
->driver
->match (f
, work
);
2796 copy
= copy_font_spec (work
);
2797 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2798 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2800 if (! NILP (entity
))
2803 FONT_ADD_LOG ("match", work
, entity
);
2808 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2809 opened font object. */
2812 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2814 struct font_driver_list
*driver_list
;
2815 Lisp_Object objlist
, size
, val
, font_object
;
2817 int min_width
, height
, psize
;
2819 eassert (FONT_ENTITY_P (entity
));
2820 size
= AREF (entity
, FONT_SIZE_INDEX
);
2821 if (XINT (size
) != 0)
2822 pixel_size
= XINT (size
);
2824 val
= AREF (entity
, FONT_TYPE_INDEX
);
2825 for (driver_list
= f
->font_driver_list
;
2826 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2827 driver_list
= driver_list
->next
);
2831 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2832 objlist
= XCDR (objlist
))
2834 Lisp_Object fn
= XCAR (objlist
);
2835 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2836 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2838 if (driver_list
->driver
->cached_font_ok
== NULL
2839 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2844 /* We always open a font of manageable size; i.e non-zero average
2845 width and height. */
2846 for (psize
= pixel_size
; ; psize
++)
2848 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2849 if (NILP (font_object
))
2851 font
= XFONT_OBJECT (font_object
);
2852 if (font
->average_width
> 0 && font
->height
> 0)
2855 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2856 FONT_ADD_LOG ("open", entity
, font_object
);
2857 ASET (entity
, FONT_OBJLIST_INDEX
,
2858 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2860 font
= XFONT_OBJECT (font_object
);
2861 min_width
= (font
->min_width
? font
->min_width
2862 : font
->average_width
? font
->average_width
2863 : font
->space_width
? font
->space_width
2865 height
= (font
->height
? font
->height
: 1);
2866 #ifdef HAVE_WINDOW_SYSTEM
2867 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2868 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2870 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2871 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2872 f
->fonts_changed
= 1;
2876 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2877 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2878 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2879 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2887 /* Close FONT_OBJECT. */
2890 font_close_object (Lisp_Object font_object
)
2892 struct font
*font
= XFONT_OBJECT (font_object
);
2894 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2895 /* Already closed. */
2897 FONT_ADD_LOG ("close", font_object
, Qnil
);
2898 font
->driver
->close (font
);
2899 #ifdef HAVE_WINDOW_SYSTEM
2900 eassert (font
->frame
);
2901 eassert (FRAME_DISPLAY_INFO (font
->frame
)->n_fonts
);
2902 FRAME_DISPLAY_INFO (font
->frame
)->n_fonts
--;
2907 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2908 FONT is a font-entity and it must be opened to check. */
2911 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2915 if (FONT_ENTITY_P (font
))
2917 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2918 struct font_driver_list
*driver_list
;
2920 for (driver_list
= f
->font_driver_list
;
2921 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2922 driver_list
= driver_list
->next
);
2925 if (! driver_list
->driver
->has_char
)
2927 return driver_list
->driver
->has_char (font
, c
);
2930 eassert (FONT_OBJECT_P (font
));
2931 fontp
= XFONT_OBJECT (font
);
2932 if (fontp
->driver
->has_char
)
2934 int result
= fontp
->driver
->has_char (font
, c
);
2939 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2943 /* Return the glyph ID of FONT_OBJECT for character C. */
2946 font_encode_char (Lisp_Object font_object
, int c
)
2950 eassert (FONT_OBJECT_P (font_object
));
2951 font
= XFONT_OBJECT (font_object
);
2952 return font
->driver
->encode_char (font
, c
);
2956 /* Return the name of FONT_OBJECT. */
2959 font_get_name (Lisp_Object font_object
)
2961 eassert (FONT_OBJECT_P (font_object
));
2962 return AREF (font_object
, FONT_NAME_INDEX
);
2966 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2967 could not be parsed by font_parse_name, return Qnil. */
2970 font_spec_from_name (Lisp_Object font_name
)
2972 Lisp_Object spec
= Ffont_spec (0, NULL
);
2974 CHECK_STRING (font_name
);
2975 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2977 font_put_extra (spec
, QCname
, font_name
);
2978 font_put_extra (spec
, QCuser_spec
, font_name
);
2984 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2986 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2991 if (! NILP (Ffont_get (font
, QCname
)))
2993 font
= copy_font_spec (font
);
2994 font_put_extra (font
, QCname
, Qnil
);
2997 if (NILP (AREF (font
, prop
))
2998 && prop
!= FONT_FAMILY_INDEX
2999 && prop
!= FONT_FOUNDRY_INDEX
3000 && prop
!= FONT_WIDTH_INDEX
3001 && prop
!= FONT_SIZE_INDEX
)
3003 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3004 font
= copy_font_spec (font
);
3005 ASET (font
, prop
, Qnil
);
3006 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3008 if (prop
== FONT_FAMILY_INDEX
)
3010 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3011 /* If we are setting the font family, we must also clear
3012 FONT_WIDTH_INDEX to avoid rejecting families that lack
3013 support for some widths. */
3014 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3016 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3017 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3018 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3019 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3020 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3021 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3023 else if (prop
== FONT_SIZE_INDEX
)
3025 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3026 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3027 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3029 else if (prop
== FONT_WIDTH_INDEX
)
3030 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3031 attrs
[LFACE_FONT_INDEX
] = font
;
3034 /* Select a font from ENTITIES (list of font-entity vectors) that
3035 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3038 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3039 Lisp_Object
*attrs
, int pixel_size
, int c
)
3041 Lisp_Object font_entity
;
3045 if (NILP (XCDR (entities
))
3046 && ASIZE (XCAR (entities
)) == 1)
3048 font_entity
= AREF (XCAR (entities
), 0);
3049 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3054 /* Sort fonts by properties specified in ATTRS. */
3055 prefer
= scratch_font_prefer
;
3057 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3058 ASET (prefer
, i
, Qnil
);
3059 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3061 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3063 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3064 ASET (prefer
, i
, AREF (face_font
, i
));
3066 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3067 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3068 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3069 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3070 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3071 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3072 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3074 return font_sort_entities (entities
, prefer
, f
, c
);
3077 /* Return a font-entity that satisfies SPEC and is the best match for
3078 face's font related attributes in ATTRS. C, if not negative, is a
3079 character that the entity must support. */
3082 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3085 Lisp_Object entities
, val
;
3086 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3091 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3092 if (NILP (registry
[0]))
3094 registry
[0] = DEFAULT_ENCODING
;
3095 registry
[1] = Qascii_0
;
3096 registry
[2] = zero_vector
;
3099 registry
[1] = zero_vector
;
3101 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3103 struct charset
*encoding
, *repertory
;
3105 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3106 &encoding
, &repertory
) < 0)
3109 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3111 else if (c
> encoding
->max_char
)
3115 work
= copy_font_spec (spec
);
3116 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3117 pixel_size
= font_pixel_size (f
, spec
);
3118 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3120 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3122 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3126 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3127 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3128 if (! NILP (foundry
[0]))
3129 foundry
[1] = zero_vector
;
3130 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3132 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3133 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3135 foundry
[2] = zero_vector
;
3138 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3140 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3141 if (! NILP (adstyle
[0]))
3142 adstyle
[1] = zero_vector
;
3143 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3145 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3147 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3149 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3151 adstyle
[2] = zero_vector
;
3154 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3157 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3160 val
= AREF (work
, FONT_FAMILY_INDEX
);
3161 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3163 val
= attrs
[LFACE_FAMILY_INDEX
];
3164 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3168 family
= alloca ((sizeof family
[0]) * 2);
3170 family
[1] = zero_vector
; /* terminator. */
3175 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3177 if (! NILP (alters
))
3179 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3180 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3181 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3182 family
[i
] = XCAR (alters
);
3183 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3185 family
[i
] = zero_vector
;
3189 family
= alloca ((sizeof family
[0]) * 3);
3192 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3194 family
[i
] = zero_vector
;
3198 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3200 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3201 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3203 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3204 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3206 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3207 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3209 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3210 entities
= font_list_entities (f
, work
);
3211 if (! NILP (entities
))
3213 val
= font_select_entity (f
, entities
,
3214 attrs
, pixel_size
, c
);
3232 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3236 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3237 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3238 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3241 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3242 size
= font_pixel_size (f
, spec
);
3246 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3247 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3250 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3251 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3252 eassert (INTEGERP (height
));
3257 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3261 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3262 size
= (NUMBERP (ffsize
)
3263 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3267 size
*= font_rescale_ratio (entity
);
3270 return font_open_entity (f
, entity
, size
);
3274 /* Find a font that satisfies SPEC and is the best match for
3275 face's attributes in ATTRS on FRAME, and return the opened
3279 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3281 Lisp_Object entity
, name
;
3283 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3286 /* No font is listed for SPEC, but each font-backend may have
3287 different criteria about "font matching". So, try it. */
3288 entity
= font_matching_entity (f
, attrs
, spec
);
3292 /* Don't lose the original name that was put in initially. We need
3293 it to re-apply the font when font parameters (like hinting or dpi) have
3295 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3298 name
= Ffont_get (spec
, QCuser_spec
);
3299 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3305 /* Make FACE on frame F ready to use the font opened for FACE. */
3308 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3310 if (face
->font
->driver
->prepare_face
)
3311 face
->font
->driver
->prepare_face (f
, face
);
3315 /* Make FACE on frame F stop using the font opened for FACE. */
3318 font_done_for_face (struct frame
*f
, struct face
*face
)
3320 if (face
->font
->driver
->done_face
)
3321 face
->font
->driver
->done_face (f
, face
);
3326 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3327 font is found, return Qnil. */
3330 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3332 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3334 /* We set up the default font-related attributes of a face to prefer
3336 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3337 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3338 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3340 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3342 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3344 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3346 return font_load_for_lface (f
, attrs
, spec
);
3350 /* Open a font that matches NAME on frame F. If no proper font is
3351 found, return Qnil. */
3354 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3356 Lisp_Object args
[2];
3357 Lisp_Object spec
, ret
;
3361 spec
= Ffont_spec (2, args
);
3362 ret
= font_open_by_spec (f
, spec
);
3363 /* Do not lose name originally put in. */
3365 font_put_extra (ret
, QCuser_spec
, args
[1]);
3371 /* Register font-driver DRIVER. This function is used in two ways.
3373 The first is with frame F non-NULL. In this case, make DRIVER
3374 available (but not yet activated) on F. All frame creators
3375 (e.g. Fx_create_frame) must call this function at least once with
3376 an available font-driver.
3378 The second is with frame F NULL. In this case, DRIVER is globally
3379 registered in the variable `font_driver_list'. All font-driver
3380 implementations must call this function in its syms_of_XXXX
3381 (e.g. syms_of_xfont). */
3384 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3386 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3387 struct font_driver_list
*prev
, *list
;
3389 #ifdef HAVE_WINDOW_SYSTEM
3390 if (f
&& ! driver
->draw
)
3391 error ("Unusable font driver for a frame: %s",
3392 SDATA (SYMBOL_NAME (driver
->type
)));
3393 #endif /* HAVE_WINDOW_SYSTEM */
3395 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3396 if (EQ (list
->driver
->type
, driver
->type
))
3397 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3399 list
= xmalloc (sizeof *list
);
3401 list
->driver
= driver
;
3406 f
->font_driver_list
= list
;
3408 font_driver_list
= list
;
3414 free_font_driver_list (struct frame
*f
)
3416 struct font_driver_list
*list
, *next
;
3418 for (list
= f
->font_driver_list
; list
; list
= next
)
3423 f
->font_driver_list
= NULL
;
3427 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3428 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3429 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3431 A caller must free all realized faces if any in advance. The
3432 return value is a list of font backends actually made used on
3436 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3438 Lisp_Object active_drivers
= Qnil
;
3439 struct font_driver_list
*list
;
3441 /* At first, turn off non-requested drivers, and turn on requested
3443 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3445 struct font_driver
*driver
= list
->driver
;
3446 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3451 if (driver
->end_for_frame
)
3452 driver
->end_for_frame (f
);
3453 font_finish_cache (f
, driver
);
3458 if (! driver
->start_for_frame
3459 || driver
->start_for_frame (f
) == 0)
3461 font_prepare_cache (f
, driver
);
3468 if (NILP (new_drivers
))
3471 if (! EQ (new_drivers
, Qt
))
3473 /* Re-order the driver list according to new_drivers. */
3474 struct font_driver_list
**list_table
, **next
;
3478 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3479 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3481 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3482 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3485 list_table
[i
++] = list
;
3487 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3489 list_table
[i
++] = list
;
3490 list_table
[i
] = NULL
;
3492 next
= &f
->font_driver_list
;
3493 for (i
= 0; list_table
[i
]; i
++)
3495 *next
= list_table
[i
];
3496 next
= &(*next
)->next
;
3500 if (! f
->font_driver_list
->on
)
3501 { /* None of the drivers is enabled: enable them all.
3502 Happens if you set the list of drivers to (xft x) in your .emacs
3503 and then use it under w32 or ns. */
3504 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3506 struct font_driver
*driver
= list
->driver
;
3507 eassert (! list
->on
);
3508 if (! driver
->start_for_frame
3509 || driver
->start_for_frame (f
) == 0)
3511 font_prepare_cache (f
, driver
);
3518 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3520 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3521 return active_drivers
;
3525 font_put_frame_data (struct frame
*f
, struct font_driver
*driver
, void *data
)
3527 struct font_data_list
*list
, *prev
;
3529 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3530 prev
= list
, list
= list
->next
)
3531 if (list
->driver
== driver
)
3538 prev
->next
= list
->next
;
3540 f
->font_data_list
= list
->next
;
3548 list
= xmalloc (sizeof *list
);
3549 list
->driver
= driver
;
3550 list
->next
= f
->font_data_list
;
3551 f
->font_data_list
= list
;
3559 font_get_frame_data (struct frame
*f
, struct font_driver
*driver
)
3561 struct font_data_list
*list
;
3563 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3564 if (list
->driver
== driver
)
3572 /* Sets attributes on a font. Any properties that appear in ALIST and
3573 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3574 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3575 arrays of strings. This function is intended for use by the font
3576 drivers to implement their specific font_filter_properties. */
3578 font_filter_properties (Lisp_Object font
,
3580 const char *const boolean_properties
[],
3581 const char *const non_boolean_properties
[])
3586 /* Set boolean values to Qt or Qnil. */
3587 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3588 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3590 Lisp_Object key
= XCAR (XCAR (it
));
3591 Lisp_Object val
= XCDR (XCAR (it
));
3592 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3594 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3596 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3597 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3600 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3601 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3602 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3603 || strcmp ("Off", str
) == 0)
3608 Ffont_put (font
, key
, val
);
3612 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3613 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3615 Lisp_Object key
= XCAR (XCAR (it
));
3616 Lisp_Object val
= XCDR (XCAR (it
));
3617 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3618 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3619 Ffont_put (font
, key
, val
);
3624 /* Return the font used to draw character C by FACE at buffer position
3625 POS in window W. If STRING is non-nil, it is a string containing C
3626 at index POS. If C is negative, get C from the current buffer or
3630 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3635 Lisp_Object font_object
;
3637 multibyte
= (NILP (string
)
3638 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3639 : STRING_MULTIBYTE (string
));
3646 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3648 c
= FETCH_CHAR (pos_byte
);
3651 c
= FETCH_BYTE (pos
);
3657 multibyte
= STRING_MULTIBYTE (string
);
3660 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3662 str
= SDATA (string
) + pos_byte
;
3663 c
= STRING_CHAR (str
);
3666 c
= SDATA (string
)[pos
];
3670 f
= XFRAME (w
->frame
);
3671 if (! FRAME_WINDOW_P (f
))
3678 if (STRINGP (string
))
3679 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3680 DEFAULT_FACE_ID
, 0);
3682 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3684 face
= FACE_FROM_ID (f
, face_id
);
3688 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3689 face
= FACE_FROM_ID (f
, face_id
);
3694 XSETFONT (font_object
, face
->font
);
3699 #ifdef HAVE_WINDOW_SYSTEM
3701 /* Check how many characters after character/byte position POS/POS_BYTE
3702 (at most to *LIMIT) can be displayed by the same font in the window W.
3703 FACE, if non-NULL, is the face selected for the character at POS.
3704 If STRING is not nil, it is the string to check instead of the current
3705 buffer. In that case, FACE must be not NULL.
3707 The return value is the font-object for the character at POS.
3708 *LIMIT is set to the position where that font can't be used.
3710 It is assured that the current buffer (or STRING) is multibyte. */
3713 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3714 struct window
*w
, struct face
*face
, Lisp_Object string
)
3718 Lisp_Object font_object
= Qnil
;
3726 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3728 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3734 while (pos
< *limit
)
3736 Lisp_Object category
;
3739 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3741 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3742 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3743 if (INTEGERP (category
)
3744 && (XINT (category
) == UNICODE_CATEGORY_Cf
3745 || CHAR_VARIATION_SELECTOR_P (c
)))
3747 if (NILP (font_object
))
3749 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3750 if (NILP (font_object
))
3754 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3764 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3765 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3766 Return nil otherwise.
3767 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3768 which kind of font it is. It must be one of `font-spec', `font-entity',
3770 (Lisp_Object object
, Lisp_Object extra_type
)
3772 if (NILP (extra_type
))
3773 return (FONTP (object
) ? Qt
: Qnil
);
3774 if (EQ (extra_type
, Qfont_spec
))
3775 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3776 if (EQ (extra_type
, Qfont_entity
))
3777 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3778 if (EQ (extra_type
, Qfont_object
))
3779 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3780 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3783 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3784 doc
: /* Return a newly created font-spec with arguments as properties.
3786 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3787 valid font property name listed below:
3789 `:family', `:weight', `:slant', `:width'
3791 They are the same as face attributes of the same name. See
3792 `set-face-attribute'.
3796 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3800 VALUE must be a string or a symbol specifying the additional
3801 typographic style information of a font, e.g. ``sans''.
3805 VALUE must be a string or a symbol specifying the charset registry and
3806 encoding of a font, e.g. ``iso8859-1''.
3810 VALUE must be a non-negative integer or a floating point number
3811 specifying the font size. It specifies the font size in pixels (if
3812 VALUE is an integer), or in points (if VALUE is a float).
3816 VALUE must be a string of XLFD-style or fontconfig-style font name.
3820 VALUE must be a symbol representing a script that the font must
3821 support. It may be a symbol representing a subgroup of a script
3822 listed in the variable `script-representative-chars'.
3826 VALUE must be a symbol of two-letter ISO-639 language names,
3831 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3832 required OpenType features.
3834 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3835 LANGSYS-TAG: OpenType language system tag symbol,
3836 or nil for the default language system.
3837 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3838 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3840 GSUB and GPOS may contain `nil' element. In such a case, the font
3841 must not have any of the remaining elements.
3843 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3844 be an OpenType font whose GPOS table of `thai' script's default
3845 language system must contain `mark' feature.
3847 usage: (font-spec ARGS...) */)
3848 (ptrdiff_t nargs
, Lisp_Object
*args
)
3850 Lisp_Object spec
= font_make_spec ();
3853 for (i
= 0; i
< nargs
; i
+= 2)
3855 Lisp_Object key
= args
[i
], val
;
3859 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3862 if (EQ (key
, QCname
))
3865 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3866 error ("Invalid font name: %s", SSDATA (val
));
3867 font_put_extra (spec
, key
, val
);
3871 int idx
= get_font_prop_index (key
);
3875 val
= font_prop_validate (idx
, Qnil
, val
);
3876 if (idx
< FONT_EXTRA_INDEX
)
3877 ASET (spec
, idx
, val
);
3879 font_put_extra (spec
, key
, val
);
3882 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3888 /* Return a copy of FONT as a font-spec. */
3890 copy_font_spec (Lisp_Object font
)
3892 Lisp_Object new_spec
, tail
, prev
, extra
;
3896 new_spec
= font_make_spec ();
3897 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3898 ASET (new_spec
, i
, AREF (font
, i
));
3899 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3900 /* We must remove :font-entity property. */
3901 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3902 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3905 extra
= XCDR (extra
);
3907 XSETCDR (prev
, XCDR (tail
));
3910 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3914 /* Merge font-specs FROM and TO, and return a new font-spec.
3915 Every specified property in FROM overrides the corresponding
3918 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3920 Lisp_Object extra
, tail
;
3925 to
= copy_font_spec (to
);
3926 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3927 ASET (to
, i
, AREF (from
, i
));
3928 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3929 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3930 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3932 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3935 XSETCDR (slot
, XCDR (XCAR (tail
)));
3937 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3939 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3943 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3944 doc
: /* Return the value of FONT's property KEY.
3945 FONT is a font-spec, a font-entity, or a font-object.
3946 KEY is any symbol, but these are reserved for specific meanings:
3947 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3948 :size, :name, :script, :otf
3949 See the documentation of `font-spec' for their meanings.
3950 In addition, if FONT is a font-entity or a font-object, values of
3951 :script and :otf are different from those of a font-spec as below:
3953 The value of :script may be a list of scripts that are supported by the font.
3955 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3956 representing the OpenType features supported by the font by this form:
3957 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3958 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3960 (Lisp_Object font
, Lisp_Object key
)
3968 idx
= get_font_prop_index (key
);
3969 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3970 return font_style_symbolic (font
, idx
, 0);
3971 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3972 return AREF (font
, idx
);
3973 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3974 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3976 struct font
*fontp
= XFONT_OBJECT (font
);
3978 if (fontp
->driver
->otf_capability
)
3979 val
= fontp
->driver
->otf_capability (fontp
);
3981 val
= Fcons (Qnil
, Qnil
);
3988 #ifdef HAVE_WINDOW_SYSTEM
3990 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3991 doc
: /* Return a plist of face attributes generated by FONT.
3992 FONT is a font name, a font-spec, a font-entity, or a font-object.
3993 The return value is a list of the form
3995 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3997 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3998 compatible with `set-face-attribute'. Some of these key-attribute pairs
3999 may be omitted from the list if they are not specified by FONT.
4001 The optional argument FRAME specifies the frame that the face attributes
4002 are to be displayed on. If omitted, the selected frame is used. */)
4003 (Lisp_Object font
, Lisp_Object frame
)
4005 struct frame
*f
= decode_live_frame (frame
);
4006 Lisp_Object plist
[10];
4012 int fontset
= fs_query_fontset (font
, 0);
4013 Lisp_Object name
= font
;
4015 font
= fontset_ascii (fontset
);
4016 font
= font_spec_from_name (name
);
4018 signal_error ("Invalid font name", name
);
4020 else if (! FONTP (font
))
4021 signal_error ("Invalid font object", font
);
4023 val
= AREF (font
, FONT_FAMILY_INDEX
);
4026 plist
[n
++] = QCfamily
;
4027 plist
[n
++] = SYMBOL_NAME (val
);
4030 val
= AREF (font
, FONT_SIZE_INDEX
);
4033 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4034 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4035 plist
[n
++] = QCheight
;
4036 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4038 else if (FLOATP (val
))
4040 plist
[n
++] = QCheight
;
4041 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4044 val
= FONT_WEIGHT_FOR_FACE (font
);
4047 plist
[n
++] = QCweight
;
4051 val
= FONT_SLANT_FOR_FACE (font
);
4054 plist
[n
++] = QCslant
;
4058 val
= FONT_WIDTH_FOR_FACE (font
);
4061 plist
[n
++] = QCwidth
;
4065 return Flist (n
, plist
);
4070 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4071 doc
: /* Set one property of FONT: give property KEY value VAL.
4072 FONT is a font-spec, a font-entity, or a font-object.
4074 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4075 accepted by the function `font-spec' (which see), VAL must be what
4076 allowed in `font-spec'.
4078 If FONT is a font-entity or a font-object, KEY must not be the one
4079 accepted by `font-spec'. */)
4080 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4084 idx
= get_font_prop_index (prop
);
4085 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4087 CHECK_FONT_SPEC (font
);
4088 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4092 if (EQ (prop
, QCname
)
4093 || EQ (prop
, QCscript
)
4094 || EQ (prop
, QClang
)
4095 || EQ (prop
, QCotf
))
4096 CHECK_FONT_SPEC (font
);
4099 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4104 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4105 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4106 Optional 2nd argument FRAME specifies the target frame.
4107 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4108 Optional 4th argument PREFER, if non-nil, is a font-spec to
4109 control the order of the returned list. Fonts are sorted by
4110 how close they are to PREFER. */)
4111 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4113 struct frame
*f
= decode_live_frame (frame
);
4114 Lisp_Object vec
, list
;
4117 CHECK_FONT_SPEC (font_spec
);
4125 if (! NILP (prefer
))
4126 CHECK_FONT_SPEC (prefer
);
4128 list
= font_list_entities (f
, font_spec
);
4131 if (NILP (XCDR (list
))
4132 && ASIZE (XCAR (list
)) == 1)
4133 return list1 (AREF (XCAR (list
), 0));
4135 if (! NILP (prefer
))
4136 vec
= font_sort_entities (list
, prefer
, f
, 0);
4138 vec
= font_vconcat_entity_vectors (list
);
4139 if (n
== 0 || n
>= ASIZE (vec
))
4141 Lisp_Object args
[2];
4145 list
= Fappend (2, args
);
4149 for (list
= Qnil
, n
--; n
>= 0; n
--)
4150 list
= Fcons (AREF (vec
, n
), list
);
4155 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4156 doc
: /* List available font families on the current frame.
4157 If FRAME is omitted or nil, the selected frame is used. */)
4160 struct frame
*f
= decode_live_frame (frame
);
4161 struct font_driver_list
*driver_list
;
4162 Lisp_Object list
= Qnil
;
4164 for (driver_list
= f
->font_driver_list
; driver_list
;
4165 driver_list
= driver_list
->next
)
4166 if (driver_list
->driver
->list_family
)
4168 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4169 Lisp_Object tail
= list
;
4171 for (; CONSP (val
); val
= XCDR (val
))
4172 if (NILP (Fmemq (XCAR (val
), tail
))
4173 && SYMBOLP (XCAR (val
)))
4174 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4179 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4180 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4181 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4182 (Lisp_Object font_spec
, Lisp_Object frame
)
4184 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4191 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4192 doc
: /* Return XLFD name of FONT.
4193 FONT is a font-spec, font-entity, or font-object.
4194 If the name is too long for XLFD (maximum 255 chars), return nil.
4195 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4196 the consecutive wildcards are folded into one. */)
4197 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4200 int namelen
, pixel_size
= 0;
4204 if (FONT_OBJECT_P (font
))
4206 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4208 if (STRINGP (font_name
)
4209 && SDATA (font_name
)[0] == '-')
4211 if (NILP (fold_wildcards
))
4213 strcpy (name
, SSDATA (font_name
));
4214 namelen
= SBYTES (font_name
);
4217 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4219 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4223 if (! NILP (fold_wildcards
))
4225 char *p0
= name
, *p1
;
4227 while ((p1
= strstr (p0
, "-*-*")))
4229 strcpy (p1
, p1
+ 2);
4235 return make_string (name
, namelen
);
4239 clear_font_cache (struct frame
*f
)
4241 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4243 for (; driver_list
; driver_list
= driver_list
->next
)
4244 if (driver_list
->on
)
4246 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4250 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4252 eassert (! NILP (val
));
4253 tmp
= XCDR (XCAR (val
));
4254 if (XINT (XCAR (tmp
)) == 0)
4256 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4257 XSETCDR (cache
, XCDR (val
));
4262 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4263 doc
: /* Clear font cache of each frame. */)
4266 Lisp_Object list
, frame
;
4268 FOR_EACH_FRAME (list
, frame
)
4269 clear_font_cache (XFRAME (frame
));
4276 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4278 struct font
*font
= XFONT_OBJECT (font_object
);
4279 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4280 struct font_metrics metrics
;
4282 LGLYPH_SET_CODE (glyph
, code
);
4283 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4284 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4285 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4286 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4287 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4288 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4292 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4293 doc
: /* Shape the glyph-string GSTRING.
4294 Shaping means substituting glyphs and/or adjusting positions of glyphs
4295 to get the correct visual image of character sequences set in the
4296 header of the glyph-string.
4298 If the shaping was successful, the value is GSTRING itself or a newly
4299 created glyph-string. Otherwise, the value is nil.
4301 See the documentation of `composition-get-gstring' for the format of
4303 (Lisp_Object gstring
)
4306 Lisp_Object font_object
, n
, glyph
;
4307 ptrdiff_t i
, from
, to
;
4309 if (! composition_gstring_p (gstring
))
4310 signal_error ("Invalid glyph-string: ", gstring
);
4311 if (! NILP (LGSTRING_ID (gstring
)))
4313 font_object
= LGSTRING_FONT (gstring
);
4314 CHECK_FONT_OBJECT (font_object
);
4315 font
= XFONT_OBJECT (font_object
);
4316 if (! font
->driver
->shape
)
4319 /* Try at most three times with larger gstring each time. */
4320 for (i
= 0; i
< 3; i
++)
4322 n
= font
->driver
->shape (gstring
);
4325 gstring
= larger_vector (gstring
,
4326 LGSTRING_GLYPH_LEN (gstring
), -1);
4328 if (i
== 3 || XINT (n
) == 0)
4330 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4331 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4333 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4334 GLYPHS covers all characters (except for the last few ones) in
4335 GSTRING. More formally, provided that NCHARS is the number of
4336 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4337 and TO_IDX of each glyph must satisfy these conditions:
4339 GLYPHS[0].FROM_IDX == 0
4340 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4341 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4342 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4343 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4345 ;; Be sure to cover all characters.
4346 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4347 glyph
= LGSTRING_GLYPH (gstring
, 0);
4348 from
= LGLYPH_FROM (glyph
);
4349 to
= LGLYPH_TO (glyph
);
4350 if (from
!= 0 || to
< from
)
4352 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4354 glyph
= LGSTRING_GLYPH (gstring
, i
);
4357 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4358 && (LGLYPH_FROM (glyph
) == from
4359 ? LGLYPH_TO (glyph
) == to
4360 : LGLYPH_FROM (glyph
) == to
+ 1)))
4362 from
= LGLYPH_FROM (glyph
);
4363 to
= LGLYPH_TO (glyph
);
4365 return composition_gstring_put_cache (gstring
, XINT (n
));
4371 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4373 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4374 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4376 VARIATION-SELECTOR is a character code of variation selection
4377 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4378 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4379 (Lisp_Object font_object
, Lisp_Object character
)
4381 unsigned variations
[256];
4386 CHECK_FONT_OBJECT (font_object
);
4387 CHECK_CHARACTER (character
);
4388 font
= XFONT_OBJECT (font_object
);
4389 if (! font
->driver
->get_variation_glyphs
)
4391 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4395 for (i
= 0; i
< 255; i
++)
4398 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4399 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4400 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4407 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4408 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4409 OTF-FEATURES specifies which features to apply in this format:
4410 (SCRIPT LANGSYS GSUB GPOS)
4412 SCRIPT is a symbol specifying a script tag of OpenType,
4413 LANGSYS is a symbol specifying a langsys tag of OpenType,
4414 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4416 If LANGYS is nil, the default langsys is selected.
4418 The features are applied in the order they appear in the list. The
4419 symbol `*' means to apply all available features not present in this
4420 list, and the remaining features are ignored. For instance, (vatu
4421 pstf * haln) is to apply vatu and pstf in this order, then to apply
4422 all available features other than vatu, pstf, and haln.
4424 The features are applied to the glyphs in the range FROM and TO of
4425 the glyph-string GSTRING-IN.
4427 If some feature is actually applicable, the resulting glyphs are
4428 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4429 this case, the value is the number of produced glyphs.
4431 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4434 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4435 produced in GSTRING-OUT, and the value is nil.
4437 See the documentation of `composition-get-gstring' for the format of
4439 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4441 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4446 check_otf_features (otf_features
);
4447 CHECK_FONT_OBJECT (font_object
);
4448 font
= XFONT_OBJECT (font_object
);
4449 if (! font
->driver
->otf_drive
)
4450 error ("Font backend %s can't drive OpenType GSUB table",
4451 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4452 CHECK_CONS (otf_features
);
4453 CHECK_SYMBOL (XCAR (otf_features
));
4454 val
= XCDR (otf_features
);
4455 CHECK_SYMBOL (XCAR (val
));
4456 val
= XCDR (otf_features
);
4459 len
= check_gstring (gstring_in
);
4460 CHECK_VECTOR (gstring_out
);
4461 CHECK_NATNUM (from
);
4463 CHECK_NATNUM (index
);
4465 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4466 args_out_of_range_3 (from
, to
, make_number (len
));
4467 if (XINT (index
) >= ASIZE (gstring_out
))
4468 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4469 num
= font
->driver
->otf_drive (font
, otf_features
,
4470 gstring_in
, XINT (from
), XINT (to
),
4471 gstring_out
, XINT (index
), 0);
4474 return make_number (num
);
4477 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4479 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4480 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4482 (SCRIPT LANGSYS FEATURE ...)
4483 See the documentation of `font-drive-otf' for more detail.
4485 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4486 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4487 character code corresponding to the glyph or nil if there's no
4488 corresponding character. */)
4489 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4492 Lisp_Object gstring_in
, gstring_out
, g
;
4493 Lisp_Object alternates
;
4496 CHECK_FONT_GET_OBJECT (font_object
, font
);
4497 if (! font
->driver
->otf_drive
)
4498 error ("Font backend %s can't drive OpenType GSUB table",
4499 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4500 CHECK_CHARACTER (character
);
4501 CHECK_CONS (otf_features
);
4503 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4504 g
= LGSTRING_GLYPH (gstring_in
, 0);
4505 LGLYPH_SET_CHAR (g
, XINT (character
));
4506 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4507 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4508 gstring_out
, 0, 1)) < 0)
4509 gstring_out
= Ffont_make_gstring (font_object
,
4510 make_number (ASIZE (gstring_out
) * 2));
4512 for (i
= 0; i
< num
; i
++)
4514 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4515 int c
= LGLYPH_CHAR (g
);
4516 unsigned code
= LGLYPH_CODE (g
);
4518 alternates
= Fcons (Fcons (make_number (code
),
4519 c
> 0 ? make_number (c
) : Qnil
),
4522 return Fnreverse (alternates
);
4528 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4529 doc
: /* Open FONT-ENTITY. */)
4530 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4533 struct frame
*f
= decode_live_frame (frame
);
4535 CHECK_FONT_ENTITY (font_entity
);
4538 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4541 CHECK_NUMBER_OR_FLOAT (size
);
4543 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4545 isize
= XINT (size
);
4546 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4547 args_out_of_range (font_entity
, size
);
4551 return font_open_entity (f
, font_entity
, isize
);
4554 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4555 doc
: /* Close FONT-OBJECT. Optional FRAME is unused. */)
4556 (Lisp_Object font_object
, Lisp_Object frame
)
4558 CHECK_FONT_OBJECT (font_object
);
4559 font_close_object (font_object
);
4563 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4564 doc
: /* Return information about FONT-OBJECT.
4565 The value is a vector:
4566 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4569 NAME is the font name, a string (or nil if the font backend doesn't
4572 FILENAME is the font file name, a string (or nil if the font backend
4573 doesn't provide a file name).
4575 PIXEL-SIZE is a pixel size by which the font is opened.
4577 SIZE is a maximum advance width of the font in pixels.
4579 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4582 CAPABILITY is a list whose first element is a symbol representing the
4583 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4584 remaining elements describe the details of the font capability.
4586 If the font is OpenType font, the form of the list is
4587 \(opentype GSUB GPOS)
4588 where GSUB shows which "GSUB" features the font supports, and GPOS
4589 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4590 lists of the format:
4591 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4593 If the font is not OpenType font, currently the length of the form is
4596 SCRIPT is a symbol representing OpenType script tag.
4598 LANGSYS is a symbol representing OpenType langsys tag, or nil
4599 representing the default langsys.
4601 FEATURE is a symbol representing OpenType feature tag.
4603 If the font is not OpenType font, CAPABILITY is nil. */)
4604 (Lisp_Object font_object
)
4609 CHECK_FONT_GET_OBJECT (font_object
, font
);
4611 val
= make_uninit_vector (9);
4612 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4613 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4614 ASET (val
, 2, make_number (font
->pixel_size
));
4615 ASET (val
, 3, make_number (font
->max_width
));
4616 ASET (val
, 4, make_number (font
->ascent
));
4617 ASET (val
, 5, make_number (font
->descent
));
4618 ASET (val
, 6, make_number (font
->space_width
));
4619 ASET (val
, 7, make_number (font
->average_width
));
4620 if (font
->driver
->otf_capability
)
4621 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4623 ASET (val
, 8, Qnil
);
4627 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4629 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4630 FROM and TO are positions (integers or markers) specifying a region
4631 of the current buffer.
4632 If the optional fourth arg OBJECT is not nil, it is a string or a
4633 vector containing the target characters.
4635 Each element is a vector containing information of a glyph in this format:
4636 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4638 FROM is an index numbers of a character the glyph corresponds to.
4639 TO is the same as FROM.
4640 C is the character of the glyph.
4641 CODE is the glyph-code of C in FONT-OBJECT.
4642 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4643 ADJUSTMENT is always nil.
4644 If FONT-OBJECT doesn't have a glyph for a character,
4645 the corresponding element is nil. */)
4646 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4651 Lisp_Object
*chars
, vec
;
4654 CHECK_FONT_GET_OBJECT (font_object
, font
);
4657 ptrdiff_t charpos
, bytepos
;
4659 validate_region (&from
, &to
);
4662 len
= XFASTINT (to
) - XFASTINT (from
);
4663 SAFE_ALLOCA_LISP (chars
, len
);
4664 charpos
= XFASTINT (from
);
4665 bytepos
= CHAR_TO_BYTE (charpos
);
4666 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4669 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4670 chars
[i
] = make_number (c
);
4673 else if (STRINGP (object
))
4675 const unsigned char *p
;
4677 CHECK_NUMBER (from
);
4679 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4680 || XINT (to
) > SCHARS (object
))
4681 args_out_of_range_3 (object
, from
, to
);
4684 len
= XFASTINT (to
) - XFASTINT (from
);
4685 SAFE_ALLOCA_LISP (chars
, len
);
4687 if (STRING_MULTIBYTE (object
))
4688 for (i
= 0; i
< len
; i
++)
4690 int c
= STRING_CHAR_ADVANCE (p
);
4691 chars
[i
] = make_number (c
);
4694 for (i
= 0; i
< len
; i
++)
4695 chars
[i
] = make_number (p
[i
]);
4699 CHECK_VECTOR (object
);
4700 CHECK_NUMBER (from
);
4702 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4703 || XINT (to
) > ASIZE (object
))
4704 args_out_of_range_3 (object
, from
, to
);
4707 len
= XFASTINT (to
) - XFASTINT (from
);
4708 for (i
= 0; i
< len
; i
++)
4710 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4711 CHECK_CHARACTER (elt
);
4713 chars
= aref_addr (object
, XFASTINT (from
));
4716 vec
= make_uninit_vector (len
);
4717 for (i
= 0; i
< len
; i
++)
4720 int c
= XFASTINT (chars
[i
]);
4722 struct font_metrics metrics
;
4724 code
= font
->driver
->encode_char (font
, c
);
4725 if (code
== FONT_INVALID_CODE
)
4727 ASET (vec
, i
, Qnil
);
4731 LGLYPH_SET_FROM (g
, i
);
4732 LGLYPH_SET_TO (g
, i
);
4733 LGLYPH_SET_CHAR (g
, c
);
4734 LGLYPH_SET_CODE (g
, code
);
4735 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4736 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4737 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4738 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4739 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4740 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4743 if (! VECTORP (object
))
4748 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4749 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4750 FONT is a font-spec, font-entity, or font-object. */)
4751 (Lisp_Object spec
, Lisp_Object font
)
4753 CHECK_FONT_SPEC (spec
);
4756 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4759 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4760 doc
: /* Return a font-object for displaying a character at POSITION.
4761 Optional second arg WINDOW, if non-nil, is a window displaying
4762 the current buffer. It defaults to the currently selected window.
4763 Optional third arg STRING, if non-nil, is a string containing the target
4764 character at index specified by POSITION. */)
4765 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4767 struct window
*w
= decode_live_window (window
);
4771 if (XBUFFER (w
->contents
) != current_buffer
)
4772 error ("Specified window is not displaying the current buffer.");
4773 CHECK_NUMBER_COERCE_MARKER (position
);
4774 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4775 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4779 CHECK_NUMBER (position
);
4780 CHECK_STRING (string
);
4781 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4782 args_out_of_range (string
, position
);
4785 return font_at (-1, XINT (position
), NULL
, w
, string
);
4789 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4790 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4791 The value is a number of glyphs drawn.
4792 Type C-l to recover what previously shown. */)
4793 (Lisp_Object font_object
, Lisp_Object string
)
4795 Lisp_Object frame
= selected_frame
;
4796 struct frame
*f
= XFRAME (frame
);
4802 CHECK_FONT_GET_OBJECT (font_object
, font
);
4803 CHECK_STRING (string
);
4804 len
= SCHARS (string
);
4805 code
= alloca (sizeof (unsigned) * len
);
4806 for (i
= 0; i
< len
; i
++)
4808 Lisp_Object ch
= Faref (string
, make_number (i
));
4812 code
[i
] = font
->driver
->encode_char (font
, c
);
4813 if (code
[i
] == FONT_INVALID_CODE
)
4816 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4818 if (font
->driver
->prepare_face
)
4819 font
->driver
->prepare_face (f
, face
);
4820 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4821 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4822 if (font
->driver
->done_face
)
4823 font
->driver
->done_face (f
, face
);
4825 return make_number (len
);
4829 #endif /* FONT_DEBUG */
4831 #ifdef HAVE_WINDOW_SYSTEM
4833 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4834 doc
: /* Return information about a font named NAME on frame FRAME.
4835 If FRAME is omitted or nil, use the selected frame.
4836 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4837 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4839 OPENED-NAME is the name used for opening the font,
4840 FULL-NAME is the full name of the font,
4841 SIZE is the pixelsize of the font,
4842 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4843 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4844 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4845 how to compose characters.
4846 If the named font is not yet loaded, return nil. */)
4847 (Lisp_Object name
, Lisp_Object frame
)
4852 Lisp_Object font_object
;
4855 CHECK_STRING (name
);
4856 f
= decode_window_system_frame (frame
);
4860 int fontset
= fs_query_fontset (name
, 0);
4863 name
= fontset_ascii (fontset
);
4864 font_object
= font_open_by_name (f
, name
);
4866 else if (FONT_OBJECT_P (name
))
4868 else if (FONT_ENTITY_P (name
))
4869 font_object
= font_open_entity (f
, name
, 0);
4872 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4873 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4875 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4877 if (NILP (font_object
))
4879 font
= XFONT_OBJECT (font_object
);
4881 info
= make_uninit_vector (7);
4882 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4883 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4884 ASET (info
, 2, make_number (font
->pixel_size
));
4885 ASET (info
, 3, make_number (font
->height
));
4886 ASET (info
, 4, make_number (font
->baseline_offset
));
4887 ASET (info
, 5, make_number (font
->relative_compose
));
4888 ASET (info
, 6, make_number (font
->default_ascent
));
4891 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4892 close it now. Perhaps, we should manage font-objects
4893 by `reference-count'. */
4894 font_close_object (font_object
);
4901 #define BUILD_STYLE_TABLE(TBL) \
4902 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4905 build_style_table (const struct table_entry
*entry
, int nelement
)
4908 Lisp_Object table
, elt
;
4910 table
= make_uninit_vector (nelement
);
4911 for (i
= 0; i
< nelement
; i
++)
4913 for (j
= 0; entry
[i
].names
[j
]; j
++);
4914 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4915 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4916 for (j
= 0; entry
[i
].names
[j
]; j
++)
4917 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4918 ASET (table
, i
, elt
);
4923 /* The deferred font-log data of the form [ACTION ARG RESULT].
4924 If ACTION is not nil, that is added to the log when font_add_log is
4925 called next time. At that time, ACTION is set back to nil. */
4926 static Lisp_Object Vfont_log_deferred
;
4928 /* Prepend the font-related logging data in Vfont_log if it is not
4929 `t'. ACTION describes a kind of font-related action (e.g. listing,
4930 opening), ARG is the argument for the action, and RESULT is the
4931 result of the action. */
4933 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4938 if (EQ (Vfont_log
, Qt
))
4940 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4942 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4944 ASET (Vfont_log_deferred
, 0, Qnil
);
4945 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4946 AREF (Vfont_log_deferred
, 2));
4951 Lisp_Object tail
, elt
;
4952 Lisp_Object equalstr
= build_string ("=");
4954 val
= Ffont_xlfd_name (arg
, Qt
);
4955 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4959 if (EQ (XCAR (elt
), QCscript
)
4960 && SYMBOLP (XCDR (elt
)))
4961 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4962 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4963 else if (EQ (XCAR (elt
), QClang
)
4964 && SYMBOLP (XCDR (elt
)))
4965 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4966 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4967 else if (EQ (XCAR (elt
), QCotf
)
4968 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4969 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4971 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4977 && VECTORP (XCAR (result
))
4978 && ASIZE (XCAR (result
)) > 0
4979 && FONTP (AREF (XCAR (result
), 0)))
4980 result
= font_vconcat_entity_vectors (result
);
4983 val
= Ffont_xlfd_name (result
, Qt
);
4984 if (! FONT_SPEC_P (result
))
4985 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4986 build_string (":"), val
);
4989 else if (CONSP (result
))
4992 result
= Fcopy_sequence (result
);
4993 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4997 val
= Ffont_xlfd_name (val
, Qt
);
4998 XSETCAR (tail
, val
);
5001 else if (VECTORP (result
))
5003 result
= Fcopy_sequence (result
);
5004 for (i
= 0; i
< ASIZE (result
); i
++)
5006 val
= AREF (result
, i
);
5008 val
= Ffont_xlfd_name (val
, Qt
);
5009 ASET (result
, i
, val
);
5012 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5015 /* Record a font-related logging data to be added to Vfont_log when
5016 font_add_log is called next time. ACTION, ARG, RESULT are the same
5020 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5022 if (EQ (Vfont_log
, Qt
))
5024 ASET (Vfont_log_deferred
, 0, build_string (action
));
5025 ASET (Vfont_log_deferred
, 1, arg
);
5026 ASET (Vfont_log_deferred
, 2, result
);
5032 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5033 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5034 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5035 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5036 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5037 /* Note that the other elements in sort_shift_bits are not used. */
5039 staticpro (&font_charset_alist
);
5040 font_charset_alist
= Qnil
;
5042 DEFSYM (Qopentype
, "opentype");
5044 DEFSYM (Qascii_0
, "ascii-0");
5045 DEFSYM (Qiso8859_1
, "iso8859-1");
5046 DEFSYM (Qiso10646_1
, "iso10646-1");
5047 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5048 DEFSYM (Qunicode_sip
, "unicode-sip");
5052 DEFSYM (QCotf
, ":otf");
5053 DEFSYM (QClang
, ":lang");
5054 DEFSYM (QCscript
, ":script");
5055 DEFSYM (QCantialias
, ":antialias");
5057 DEFSYM (QCfoundry
, ":foundry");
5058 DEFSYM (QCadstyle
, ":adstyle");
5059 DEFSYM (QCregistry
, ":registry");
5060 DEFSYM (QCspacing
, ":spacing");
5061 DEFSYM (QCdpi
, ":dpi");
5062 DEFSYM (QCscalable
, ":scalable");
5063 DEFSYM (QCavgwidth
, ":avgwidth");
5064 DEFSYM (QCfont_entity
, ":font-entity");
5065 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5075 DEFSYM (QCuser_spec
, "user-spec");
5077 staticpro (&scratch_font_spec
);
5078 scratch_font_spec
= Ffont_spec (0, NULL
);
5079 staticpro (&scratch_font_prefer
);
5080 scratch_font_prefer
= Ffont_spec (0, NULL
);
5082 staticpro (&Vfont_log_deferred
);
5083 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5087 staticpro (&otf_list
);
5089 #endif /* HAVE_LIBOTF */
5093 defsubr (&Sfont_spec
);
5094 defsubr (&Sfont_get
);
5095 #ifdef HAVE_WINDOW_SYSTEM
5096 defsubr (&Sfont_face_attributes
);
5098 defsubr (&Sfont_put
);
5099 defsubr (&Slist_fonts
);
5100 defsubr (&Sfont_family_list
);
5101 defsubr (&Sfind_font
);
5102 defsubr (&Sfont_xlfd_name
);
5103 defsubr (&Sclear_font_cache
);
5104 defsubr (&Sfont_shape_gstring
);
5105 defsubr (&Sfont_variation_glyphs
);
5107 defsubr (&Sfont_drive_otf
);
5108 defsubr (&Sfont_otf_alternates
);
5112 defsubr (&Sopen_font
);
5113 defsubr (&Sclose_font
);
5114 defsubr (&Squery_font
);
5115 defsubr (&Sfont_get_glyphs
);
5116 defsubr (&Sfont_match_p
);
5117 defsubr (&Sfont_at
);
5119 defsubr (&Sdraw_string
);
5121 #endif /* FONT_DEBUG */
5122 #ifdef HAVE_WINDOW_SYSTEM
5123 defsubr (&Sfont_info
);
5126 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5128 Alist of fontname patterns vs the corresponding encoding and repertory info.
5129 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5130 where ENCODING is a charset or a char-table,
5131 and REPERTORY is a charset, a char-table, or nil.
5133 If ENCODING and REPERTORY are the same, the element can have the form
5134 \(REGEXP . ENCODING).
5136 ENCODING is for converting a character to a glyph code of the font.
5137 If ENCODING is a charset, encoding a character by the charset gives
5138 the corresponding glyph code. If ENCODING is a char-table, looking up
5139 the table by a character gives the corresponding glyph code.
5141 REPERTORY specifies a repertory of characters supported by the font.
5142 If REPERTORY is a charset, all characters belonging to the charset are
5143 supported. If REPERTORY is a char-table, all characters who have a
5144 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5145 gets the repertory information by an opened font and ENCODING. */);
5146 Vfont_encoding_alist
= Qnil
;
5148 /* FIXME: These 3 vars are not quite what they appear: setq on them
5149 won't have any effect other than disconnect them from the style
5150 table used by the font display code. So we make them read-only,
5151 to avoid this confusing situation. */
5153 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5154 doc
: /* Vector of valid font weight values.
5155 Each element has the form:
5156 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5157 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5158 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5159 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5161 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5162 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5163 See `font-weight-table' for the format of the vector. */);
5164 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5165 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5167 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5168 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5169 See `font-weight-table' for the format of the vector. */);
5170 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5171 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5173 staticpro (&font_style_table
);
5174 font_style_table
= make_uninit_vector (3);
5175 ASET (font_style_table
, 0, Vfont_weight_table
);
5176 ASET (font_style_table
, 1, Vfont_slant_table
);
5177 ASET (font_style_table
, 2, Vfont_width_table
);
5179 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5180 *Logging list of font related actions and results.
5181 The value t means to suppress the logging.
5182 The initial value is set to nil if the environment variable
5183 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5186 #ifdef HAVE_WINDOW_SYSTEM
5187 #ifdef HAVE_FREETYPE
5189 #ifdef HAVE_X_WINDOWS
5194 #endif /* HAVE_XFT */
5195 #endif /* HAVE_X_WINDOWS */
5196 #else /* not HAVE_FREETYPE */
5197 #ifdef HAVE_X_WINDOWS
5199 #endif /* HAVE_X_WINDOWS */
5200 #endif /* not HAVE_FREETYPE */
5203 #endif /* HAVE_BDFFONT */
5206 #endif /* HAVE_NTGUI */
5207 #endif /* HAVE_WINDOW_SYSTEM */
5213 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;