1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2014 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
;
151 #ifdef ENABLE_CHECKING
153 /* Used to catch bogus pointers in font objects. */
156 valid_font_driver (struct font_driver
*drv
)
158 Lisp_Object tail
, frame
;
159 struct font_driver_list
*fdl
;
161 for (fdl
= font_driver_list
; fdl
; fdl
= fdl
->next
)
162 if (fdl
->driver
== drv
)
164 FOR_EACH_FRAME (tail
, frame
)
165 for (fdl
= XFRAME (frame
)->font_driver_list
; fdl
; fdl
= fdl
->next
)
166 if (fdl
->driver
== drv
)
171 #endif /* ENABLE_CHECKING */
173 /* Creators of font-related Lisp object. */
176 font_make_spec (void)
178 Lisp_Object font_spec
;
179 struct font_spec
*spec
180 = ((struct font_spec
*)
181 allocate_pseudovector (VECSIZE (struct font_spec
),
182 FONT_SPEC_MAX
, PVEC_FONT
));
183 XSETFONT (font_spec
, spec
);
188 font_make_entity (void)
190 Lisp_Object font_entity
;
191 struct font_entity
*entity
192 = ((struct font_entity
*)
193 allocate_pseudovector (VECSIZE (struct font_entity
),
194 FONT_ENTITY_MAX
, PVEC_FONT
));
195 XSETFONT (font_entity
, entity
);
199 /* Create a font-object whose structure size is SIZE. If ENTITY is
200 not nil, copy properties from ENTITY to the font-object. If
201 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
203 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
205 Lisp_Object font_object
;
207 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
210 /* GC can happen before the driver is set up,
211 so avoid dangling pointer here (Bug#17771). */
213 XSETFONT (font_object
, font
);
217 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
218 font
->props
[i
] = AREF (entity
, i
);
219 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
220 font
->props
[FONT_EXTRA_INDEX
]
221 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
224 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
228 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
230 static int font_unparse_fcname (Lisp_Object
, int, char *, int);
232 /* Like above, but also set `type', `name' and `fullname' properties
236 font_build_object (int vectorsize
, Lisp_Object type
,
237 Lisp_Object entity
, double pixelsize
)
241 Lisp_Object font_object
= font_make_object (vectorsize
, entity
, pixelsize
);
243 ASET (font_object
, FONT_TYPE_INDEX
, type
);
244 len
= font_unparse_xlfd (entity
, pixelsize
, name
, sizeof name
);
246 ASET (font_object
, FONT_NAME_INDEX
, make_string (name
, len
));
247 len
= font_unparse_fcname (entity
, pixelsize
, name
, sizeof name
);
249 ASET (font_object
, FONT_FULLNAME_INDEX
, make_string (name
, len
));
251 ASET (font_object
, FONT_FULLNAME_INDEX
,
252 AREF (font_object
, FONT_NAME_INDEX
));
256 #endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */
258 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
259 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
260 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
262 static unsigned font_encode_char (Lisp_Object
, int);
264 /* Number of registered font drivers. */
265 static int num_font_drivers
;
268 /* Return a Lispy value of a font property value at STR and LEN bytes.
269 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
270 consist entirely of one or more digits, return a symbol interned
271 from STR. Otherwise, return an integer. */
274 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
279 ptrdiff_t nbytes
, nchars
;
281 if (len
== 1 && *str
== '*')
283 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
285 for (i
= 1; i
< len
; i
++)
286 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
293 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
296 return make_number (n
);
297 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
301 xsignal1 (Qoverflow_error
, make_string (str
, len
));
305 /* This code is similar to intern function from lread.c. */
306 obarray
= check_obarray (Vobarray
);
307 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
308 tem
= oblookup (obarray
, str
,
309 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
313 tem
= make_specified_string (str
, nchars
, len
,
314 len
!= nchars
&& len
== nbytes
);
315 return Fintern (tem
, obarray
);
318 /* Return a pixel size of font-spec SPEC on frame F. */
321 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
323 #ifdef HAVE_WINDOW_SYSTEM
324 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
333 eassert (FLOATP (size
));
334 point_size
= XFLOAT_DATA (size
);
335 val
= AREF (spec
, FONT_DPI_INDEX
);
339 dpi
= FRAME_RES_Y (f
);
340 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
348 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
349 font vector. If VAL is not valid (i.e. not registered in
350 font_style_table), return -1 if NOERROR is zero, and return a
351 proper index if NOERROR is nonzero. In that case, register VAL in
352 font_style_table if VAL is a symbol, and return the closest index if
353 VAL is an integer. */
356 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
359 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
362 CHECK_VECTOR (table
);
369 Lisp_Object args
[2], elt
;
371 /* At first try exact match. */
372 for (i
= 0; i
< len
; i
++)
374 CHECK_VECTOR (AREF (table
, i
));
375 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
376 if (EQ (val
, AREF (AREF (table
, i
), j
)))
378 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
379 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
380 | (i
<< 4) | (j
- 1));
383 /* Try also with case-folding match. */
384 s
= SSDATA (SYMBOL_NAME (val
));
385 for (i
= 0; i
< len
; i
++)
386 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
388 elt
= AREF (AREF (table
, i
), j
);
389 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
391 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
392 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
393 | (i
<< 4) | (j
- 1));
399 elt
= Fmake_vector (make_number (2), make_number (100));
402 args
[1] = Fmake_vector (make_number (1), elt
);
403 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
404 return (100 << 8) | (i
<< 4);
409 EMACS_INT numeric
= XINT (val
);
411 for (i
= 0, last_n
= -1; i
< len
; i
++)
415 CHECK_VECTOR (AREF (table
, i
));
416 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
417 n
= XINT (AREF (AREF (table
, i
), 0));
419 return (n
<< 8) | (i
<< 4);
424 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
425 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
431 return ((last_n
<< 8) | ((i
- 1) << 4));
436 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
439 Lisp_Object val
= AREF (font
, prop
);
440 Lisp_Object table
, elt
;
445 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
446 CHECK_VECTOR (table
);
447 i
= XINT (val
) & 0xFF;
448 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
449 elt
= AREF (table
, ((i
>> 4) & 0xF));
451 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
452 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
457 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
458 FONTNAME. ENCODING is a charset symbol that specifies the encoding
459 of the font. REPERTORY is a charset symbol or nil. */
462 find_font_encoding (Lisp_Object fontname
)
464 Lisp_Object tail
, elt
;
466 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
470 && STRINGP (XCAR (elt
))
471 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
472 && (SYMBOLP (XCDR (elt
))
473 ? CHARSETP (XCDR (elt
))
474 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
480 /* Return encoding charset and repertory charset for REGISTRY in
481 ENCODING and REPERTORY correspondingly. If correct information for
482 REGISTRY is available, return 0. Otherwise return -1. */
485 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
488 int encoding_id
, repertory_id
;
490 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
496 encoding_id
= XINT (XCAR (val
));
497 repertory_id
= XINT (XCDR (val
));
501 val
= find_font_encoding (SYMBOL_NAME (registry
));
502 if (SYMBOLP (val
) && CHARSETP (val
))
504 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
506 else if (CONSP (val
))
508 if (! CHARSETP (XCAR (val
)))
510 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
511 if (NILP (XCDR (val
)))
515 if (! CHARSETP (XCDR (val
)))
517 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
522 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
524 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
528 *encoding
= CHARSET_FROM_ID (encoding_id
);
530 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
535 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
540 /* Font property value validators. See the comment of
541 font_property_table for the meaning of the arguments. */
543 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
544 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
545 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
546 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
547 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
548 static int get_font_prop_index (Lisp_Object
);
551 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
554 val
= Fintern (val
, Qnil
);
557 else if (EQ (prop
, QCregistry
))
558 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
564 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
566 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
567 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
571 EMACS_INT n
= XINT (val
);
572 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
574 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
578 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
581 if ((n
& 0xF) + 1 >= ASIZE (elt
))
585 CHECK_NUMBER (AREF (elt
, 0));
586 if (XINT (AREF (elt
, 0)) != (n
>> 8))
591 else if (SYMBOLP (val
))
593 int n
= font_style_to_value (prop
, val
, 0);
595 val
= n
>= 0 ? make_number (n
) : Qerror
;
603 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
605 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
610 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
612 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
614 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
616 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
618 if (spacing
== 'c' || spacing
== 'C')
619 return make_number (FONT_SPACING_CHARCELL
);
620 if (spacing
== 'm' || spacing
== 'M')
621 return make_number (FONT_SPACING_MONO
);
622 if (spacing
== 'p' || spacing
== 'P')
623 return make_number (FONT_SPACING_PROPORTIONAL
);
624 if (spacing
== 'd' || spacing
== 'D')
625 return make_number (FONT_SPACING_DUAL
);
631 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
633 Lisp_Object tail
, tmp
;
636 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
637 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
638 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
641 if (! SYMBOLP (XCAR (val
)))
646 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
648 for (i
= 0; i
< 2; i
++)
655 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
656 if (! SYMBOLP (XCAR (tmp
)))
664 /* Structure of known font property keys and validator of the
668 /* Pointer to the key symbol. */
670 /* Function to validate PROP's value VAL, or NULL if any value is
671 ok. The value is VAL or its regularized value if VAL is valid,
672 and Qerror if not. */
673 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
674 } font_property_table
[] =
675 { { &QCtype
, font_prop_validate_symbol
},
676 { &QCfoundry
, font_prop_validate_symbol
},
677 { &QCfamily
, font_prop_validate_symbol
},
678 { &QCadstyle
, font_prop_validate_symbol
},
679 { &QCregistry
, font_prop_validate_symbol
},
680 { &QCweight
, font_prop_validate_style
},
681 { &QCslant
, font_prop_validate_style
},
682 { &QCwidth
, font_prop_validate_style
},
683 { &QCsize
, font_prop_validate_non_neg
},
684 { &QCdpi
, font_prop_validate_non_neg
},
685 { &QCspacing
, font_prop_validate_spacing
},
686 { &QCavgwidth
, font_prop_validate_non_neg
},
687 /* The order of the above entries must match with enum
688 font_property_index. */
689 { &QClang
, font_prop_validate_symbol
},
690 { &QCscript
, font_prop_validate_symbol
},
691 { &QCotf
, font_prop_validate_otf
}
694 /* Return an index number of font property KEY or -1 if KEY is not an
695 already known property. */
698 get_font_prop_index (Lisp_Object key
)
702 for (i
= 0; i
< ARRAYELTS (font_property_table
); i
++)
703 if (EQ (key
, *font_property_table
[i
].key
))
708 /* Validate the font property. The property key is specified by the
709 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
710 signal an error. The value is VAL or the regularized one. */
713 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
715 Lisp_Object validated
;
720 prop
= *font_property_table
[idx
].key
;
723 idx
= get_font_prop_index (prop
);
727 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
728 if (EQ (validated
, Qerror
))
729 signal_error ("invalid font property", Fcons (prop
, val
));
734 /* Store VAL as a value of extra font property PROP in FONT while
735 keeping the sorting order. Don't check the validity of VAL. */
738 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
740 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
741 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
745 Lisp_Object prev
= Qnil
;
748 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
749 prev
= extra
, extra
= XCDR (extra
);
752 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
754 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
760 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
765 /* Font name parser and unparser. */
767 static int parse_matrix (const char *);
768 static int font_expand_wildcards (Lisp_Object
*, int);
769 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
771 /* An enumerator for each field of an XLFD font name. */
772 enum xlfd_field_index
791 /* An enumerator for mask bit corresponding to each XLFD field. */
794 XLFD_FOUNDRY_MASK
= 0x0001,
795 XLFD_FAMILY_MASK
= 0x0002,
796 XLFD_WEIGHT_MASK
= 0x0004,
797 XLFD_SLANT_MASK
= 0x0008,
798 XLFD_SWIDTH_MASK
= 0x0010,
799 XLFD_ADSTYLE_MASK
= 0x0020,
800 XLFD_PIXEL_MASK
= 0x0040,
801 XLFD_POINT_MASK
= 0x0080,
802 XLFD_RESX_MASK
= 0x0100,
803 XLFD_RESY_MASK
= 0x0200,
804 XLFD_SPACING_MASK
= 0x0400,
805 XLFD_AVGWIDTH_MASK
= 0x0800,
806 XLFD_REGISTRY_MASK
= 0x1000,
807 XLFD_ENCODING_MASK
= 0x2000
811 /* Parse P pointing to the pixel/point size field of the form
812 `[A B C D]' which specifies a transformation matrix:
818 by which all glyphs of the font are transformed. The spec says
819 that scalar value N for the pixel/point size is equivalent to:
820 A = N * resx/resy, B = C = 0, D = N.
822 Return the scalar value N if the form is valid. Otherwise return
826 parse_matrix (const char *p
)
832 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
835 matrix
[i
] = - strtod (p
+ 1, &end
);
837 matrix
[i
] = strtod (p
, &end
);
840 return (i
== 4 ? (int) matrix
[3] : -1);
843 /* Expand a wildcard field in FIELD (the first N fields are filled) to
844 multiple fields to fill in all 14 XLFD fields while restricting a
845 field position by its contents. */
848 font_expand_wildcards (Lisp_Object
*field
, int n
)
851 Lisp_Object tmp
[XLFD_LAST_INDEX
];
852 /* Array of information about where this element can go. Nth
853 element is for Nth element of FIELD. */
855 /* Minimum possible field. */
857 /* Maximum possible field. */
859 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
861 } range
[XLFD_LAST_INDEX
];
863 int range_from
, range_to
;
866 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
867 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
868 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
869 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
870 | XLFD_AVGWIDTH_MASK)
871 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
873 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
874 field. The value is shifted to left one bit by one in the
876 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
877 range_mask
= (range_mask
<< 1) | 1;
879 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
880 position-based restriction for FIELD[I]. */
881 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
882 i
++, range_from
++, range_to
++, range_mask
<<= 1)
884 Lisp_Object val
= field
[i
];
890 range
[i
].from
= range_from
;
891 range
[i
].to
= range_to
;
892 range
[i
].mask
= range_mask
;
896 /* The triplet FROM, TO, and MASK is a value-based
897 restriction for FIELD[I]. */
903 EMACS_INT numeric
= XINT (val
);
906 from
= to
= XLFD_ENCODING_INDEX
,
907 mask
= XLFD_ENCODING_MASK
;
908 else if (numeric
== 0)
909 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
910 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
911 else if (numeric
<= 48)
912 from
= to
= XLFD_PIXEL_INDEX
,
913 mask
= XLFD_PIXEL_MASK
;
915 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
916 mask
= XLFD_LARGENUM_MASK
;
918 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
919 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
920 mask
= XLFD_NULL_MASK
;
922 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
925 Lisp_Object name
= SYMBOL_NAME (val
);
927 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
928 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
929 mask
= XLFD_REGENC_MASK
;
931 from
= to
= XLFD_ENCODING_INDEX
,
932 mask
= XLFD_ENCODING_MASK
;
934 else if (range_from
<= XLFD_WEIGHT_INDEX
935 && range_to
>= XLFD_WEIGHT_INDEX
936 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
937 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
938 else if (range_from
<= XLFD_SLANT_INDEX
939 && range_to
>= XLFD_SLANT_INDEX
940 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
941 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
942 else if (range_from
<= XLFD_SWIDTH_INDEX
943 && range_to
>= XLFD_SWIDTH_INDEX
944 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
945 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
948 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
949 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
951 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
952 mask
= XLFD_SYMBOL_MASK
;
955 /* Merge position-based and value-based restrictions. */
957 while (from
< range_from
)
958 mask
&= ~(1 << from
++);
959 while (from
< 14 && ! (mask
& (1 << from
)))
961 while (to
> range_to
)
962 mask
&= ~(1 << to
--);
963 while (to
>= 0 && ! (mask
& (1 << to
)))
967 range
[i
].from
= from
;
969 range
[i
].mask
= mask
;
971 if (from
> range_from
|| to
< range_to
)
973 /* The range is narrowed by value-based restrictions.
974 Reflect it to the other fields. */
976 /* Following fields should be after FROM. */
978 /* Preceding fields should be before TO. */
979 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
981 /* Check FROM for non-wildcard field. */
982 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
984 while (range
[j
].from
< from
)
985 range
[j
].mask
&= ~(1 << range
[j
].from
++);
986 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
988 range
[j
].from
= from
;
991 from
= range
[j
].from
;
992 if (range
[j
].to
> to
)
994 while (range
[j
].to
> to
)
995 range
[j
].mask
&= ~(1 << range
[j
].to
--);
996 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
1009 /* Decide all fields from restrictions in RANGE. */
1010 for (i
= j
= 0; i
< n
; i
++)
1012 if (j
< range
[i
].from
)
1014 if (i
== 0 || ! NILP (tmp
[i
- 1]))
1015 /* None of TMP[X] corresponds to Jth field. */
1017 for (; j
< range
[i
].from
; j
++)
1020 field
[j
++] = tmp
[i
];
1022 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1024 for (; j
< XLFD_LAST_INDEX
; j
++)
1026 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1027 field
[XLFD_ENCODING_INDEX
]
1028 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1033 /* Parse NAME (null terminated) as XLFD and store information in FONT
1034 (font-spec or font-entity). Size property of FONT is set as
1036 specified XLFD fields FONT property
1037 --------------------- -------------
1038 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1039 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1040 POINT_SIZE POINT_SIZE/10 (Lisp float)
1042 If NAME is successfully parsed, return 0. Otherwise return -1.
1044 FONT is usually a font-spec, but when this function is called from
1045 X font backend driver, it is a font-entity. In that case, NAME is
1046 a fully specified XLFD. */
1049 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1052 char *f
[XLFD_LAST_INDEX
+ 1];
1056 if (len
> 255 || !len
)
1057 /* Maximum XLFD name length is 255. */
1059 /* Accept "*-.." as a fully specified XLFD. */
1060 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1061 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1064 for (p
= name
+ i
; *p
; p
++)
1068 if (i
== XLFD_LAST_INDEX
)
1073 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1074 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1076 if (i
== XLFD_LAST_INDEX
)
1078 /* Fully specified XLFD. */
1081 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1082 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1083 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1084 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1086 val
= INTERN_FIELD_SYM (i
);
1089 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1091 ASET (font
, j
, make_number (n
));
1094 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1095 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1096 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1098 ASET (font
, FONT_REGISTRY_INDEX
,
1099 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1100 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1102 p
= f
[XLFD_PIXEL_INDEX
];
1103 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1104 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1107 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1109 ASET (font
, FONT_SIZE_INDEX
, val
);
1110 else if (FONT_ENTITY_P (font
))
1114 double point_size
= -1;
1116 eassert (FONT_SPEC_P (font
));
1117 p
= f
[XLFD_POINT_INDEX
];
1119 point_size
= parse_matrix (p
);
1120 else if (c_isdigit (*p
))
1121 point_size
= atoi (p
), point_size
/= 10;
1122 if (point_size
>= 0)
1123 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1127 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1128 if (! NILP (val
) && ! INTEGERP (val
))
1130 ASET (font
, FONT_DPI_INDEX
, val
);
1131 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1134 val
= font_prop_validate_spacing (QCspacing
, val
);
1135 if (! INTEGERP (val
))
1137 ASET (font
, FONT_SPACING_INDEX
, val
);
1139 p
= f
[XLFD_AVGWIDTH_INDEX
];
1142 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1143 if (! NILP (val
) && ! INTEGERP (val
))
1145 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1149 bool wild_card_found
= 0;
1150 Lisp_Object prop
[XLFD_LAST_INDEX
];
1152 if (FONT_ENTITY_P (font
))
1154 for (j
= 0; j
< i
; j
++)
1158 if (f
[j
][1] && f
[j
][1] != '-')
1161 wild_card_found
= 1;
1164 prop
[j
] = INTERN_FIELD (j
);
1166 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1168 if (! wild_card_found
)
1170 if (font_expand_wildcards (prop
, i
) < 0)
1173 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1174 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1175 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1176 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1177 if (! NILP (prop
[i
]))
1179 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1181 ASET (font
, j
, make_number (n
));
1183 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1184 val
= prop
[XLFD_REGISTRY_INDEX
];
1187 val
= prop
[XLFD_ENCODING_INDEX
];
1189 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1191 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1192 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1194 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1195 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1197 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1199 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1200 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1201 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1203 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1205 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1208 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1209 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1210 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1212 val
= font_prop_validate_spacing (QCspacing
,
1213 prop
[XLFD_SPACING_INDEX
]);
1214 if (! INTEGERP (val
))
1216 ASET (font
, FONT_SPACING_INDEX
, val
);
1218 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1219 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1225 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1226 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1227 0, use PIXEL_SIZE instead. */
1230 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1233 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1237 eassert (FONTP (font
));
1239 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1242 if (i
== FONT_ADSTYLE_INDEX
)
1243 j
= XLFD_ADSTYLE_INDEX
;
1244 else if (i
== FONT_REGISTRY_INDEX
)
1245 j
= XLFD_REGISTRY_INDEX
;
1246 val
= AREF (font
, i
);
1249 if (j
== XLFD_REGISTRY_INDEX
)
1257 val
= SYMBOL_NAME (val
);
1258 if (j
== XLFD_REGISTRY_INDEX
1259 && ! strchr (SSDATA (val
), '-'))
1261 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1262 ptrdiff_t alloc
= SBYTES (val
) + 4;
1263 if (nbytes
<= alloc
)
1265 f
[j
] = p
= alloca (alloc
);
1266 sprintf (p
, "%s%s-*", SDATA (val
),
1267 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1270 f
[j
] = SSDATA (val
);
1274 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1277 val
= font_style_symbolic (font
, i
, 0);
1285 val
= SYMBOL_NAME (val
);
1286 alloc
= SBYTES (val
) + 1;
1287 if (nbytes
<= alloc
)
1289 f
[j
] = p
= alloca (alloc
);
1290 /* Copy the name while excluding '-', '?', ',', and '"'. */
1291 for (k
= l
= 0; k
< alloc
; k
++)
1294 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1300 val
= AREF (font
, FONT_SIZE_INDEX
);
1301 eassert (NUMBERP (val
) || NILP (val
));
1304 EMACS_INT v
= XINT (val
);
1309 f
[XLFD_PIXEL_INDEX
] = p
=
1310 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1311 sprintf (p
, "%"pI
"d-*", v
);
1314 f
[XLFD_PIXEL_INDEX
] = "*-*";
1316 else if (FLOATP (val
))
1318 double v
= XFLOAT_DATA (val
) * 10;
1319 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1320 sprintf (p
, "*-%.0f", v
);
1323 f
[XLFD_PIXEL_INDEX
] = "*-*";
1325 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1327 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1328 f
[XLFD_RESX_INDEX
] = p
=
1329 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1330 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1333 f
[XLFD_RESX_INDEX
] = "*-*";
1334 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1336 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1338 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1339 : spacing
<= FONT_SPACING_DUAL
? "d"
1340 : spacing
<= FONT_SPACING_MONO
? "m"
1344 f
[XLFD_SPACING_INDEX
] = "*";
1345 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1347 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1348 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1351 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1352 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1353 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1354 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1355 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1356 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1357 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1358 f
[XLFD_REGISTRY_INDEX
]);
1359 return len
< nbytes
? len
: -1;
1362 /* Parse NAME (null terminated) and store information in FONT
1363 (font-spec or font-entity). NAME is supplied in either the
1364 Fontconfig or GTK font name format. If NAME is successfully
1365 parsed, return 0. Otherwise return -1.
1367 The fontconfig format is
1369 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1373 FAMILY [PROPS...] [SIZE]
1375 This function tries to guess which format it is. */
1378 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1381 char *size_beg
= NULL
, *size_end
= NULL
;
1382 char *props_beg
= NULL
, *family_end
= NULL
;
1387 for (p
= name
; *p
; p
++)
1389 if (*p
== '\\' && p
[1])
1393 props_beg
= family_end
= p
;
1398 bool decimal
= 0, size_found
= 1;
1399 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1400 if (! c_isdigit (*q
))
1402 if (*q
!= '.' || decimal
)
1421 Lisp_Object extra_props
= Qnil
;
1423 /* A fontconfig name with size and/or property data. */
1424 if (family_end
> name
)
1427 family
= font_intern_prop (name
, family_end
- name
, 1);
1428 ASET (font
, FONT_FAMILY_INDEX
, family
);
1432 double point_size
= strtod (size_beg
, &size_end
);
1433 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1434 if (*size_end
== ':' && size_end
[1])
1435 props_beg
= size_end
;
1439 /* Now parse ":KEY=VAL" patterns. */
1442 for (p
= props_beg
; *p
; p
= q
)
1444 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1447 /* Must be an enumerated value. */
1451 val
= font_intern_prop (p
, q
- p
, 1);
1453 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1454 && memcmp (p, STR, strlen (STR)) == 0)
1456 if (PROP_MATCH ("light")
1457 || PROP_MATCH ("medium")
1458 || PROP_MATCH ("demibold")
1459 || PROP_MATCH ("bold")
1460 || PROP_MATCH ("black"))
1461 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1462 else if (PROP_MATCH ("roman")
1463 || PROP_MATCH ("italic")
1464 || PROP_MATCH ("oblique"))
1465 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1466 else if (PROP_MATCH ("charcell"))
1467 ASET (font
, FONT_SPACING_INDEX
,
1468 make_number (FONT_SPACING_CHARCELL
));
1469 else if (PROP_MATCH ("mono"))
1470 ASET (font
, FONT_SPACING_INDEX
,
1471 make_number (FONT_SPACING_MONO
));
1472 else if (PROP_MATCH ("proportional"))
1473 ASET (font
, FONT_SPACING_INDEX
,
1474 make_number (FONT_SPACING_PROPORTIONAL
));
1483 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1484 prop
= FONT_SIZE_INDEX
;
1487 key
= font_intern_prop (p
, q
- p
, 1);
1488 prop
= get_font_prop_index (key
);
1492 for (q
= p
; *q
&& *q
!= ':'; q
++);
1493 val
= font_intern_prop (p
, q
- p
, 0);
1495 if (prop
>= FONT_FOUNDRY_INDEX
1496 && prop
< FONT_EXTRA_INDEX
)
1497 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1500 extra_props
= nconc2 (extra_props
,
1501 list1 (Fcons (key
, val
)));
1508 if (! NILP (extra_props
))
1510 struct font_driver_list
*driver_list
= font_driver_list
;
1511 for ( ; driver_list
; driver_list
= driver_list
->next
)
1512 if (driver_list
->driver
->filter_properties
)
1513 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1519 /* Either a fontconfig-style name with no size and property
1520 data, or a GTK-style name. */
1521 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1522 Lisp_Object width
= Qnil
, size
= Qnil
;
1526 /* Scan backwards from the end, looking for a size. */
1527 for (p
= name
+ len
- 1; p
>= name
; p
--)
1528 if (!c_isdigit (*p
))
1531 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1532 /* Found a font size. */
1533 size
= make_float (strtod (p
+ 1, NULL
));
1537 /* Now P points to the termination of the string, sans size.
1538 Scan backwards, looking for font properties. */
1539 for (; p
> name
; p
= q
)
1541 for (q
= p
- 1; q
>= name
; q
--)
1543 if (q
> name
&& *(q
-1) == '\\')
1544 --q
; /* Skip quoting backslashes. */
1550 word_len
= p
- word_start
;
1552 #define PROP_MATCH(STR) \
1553 (word_len == strlen (STR) \
1554 && memcmp (word_start, STR, strlen (STR)) == 0)
1555 #define PROP_SAVE(VAR, STR) \
1556 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1558 if (PROP_MATCH ("Ultra-Light"))
1559 PROP_SAVE (weight
, "ultra-light");
1560 else if (PROP_MATCH ("Light"))
1561 PROP_SAVE (weight
, "light");
1562 else if (PROP_MATCH ("Book"))
1563 PROP_SAVE (weight
, "book");
1564 else if (PROP_MATCH ("Medium"))
1565 PROP_SAVE (weight
, "medium");
1566 else if (PROP_MATCH ("Semi-Bold"))
1567 PROP_SAVE (weight
, "semi-bold");
1568 else if (PROP_MATCH ("Bold"))
1569 PROP_SAVE (weight
, "bold");
1570 else if (PROP_MATCH ("Italic"))
1571 PROP_SAVE (slant
, "italic");
1572 else if (PROP_MATCH ("Oblique"))
1573 PROP_SAVE (slant
, "oblique");
1574 else if (PROP_MATCH ("Semi-Condensed"))
1575 PROP_SAVE (width
, "semi-condensed");
1576 else if (PROP_MATCH ("Condensed"))
1577 PROP_SAVE (width
, "condensed");
1578 /* An unknown word must be part of the font name. */
1589 ASET (font
, FONT_FAMILY_INDEX
,
1590 font_intern_prop (name
, family_end
- name
, 1));
1592 ASET (font
, FONT_SIZE_INDEX
, size
);
1594 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1596 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1598 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1604 #if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
1606 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1607 NAME (NBYTES length), and return the name length. If
1608 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
1609 Return a negative value on error. */
1612 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1614 Lisp_Object family
, foundry
;
1620 Lisp_Object styles
[3];
1621 const char *style_names
[3] = { "weight", "slant", "width" };
1623 family
= AREF (font
, FONT_FAMILY_INDEX
);
1624 if (! NILP (family
))
1626 if (SYMBOLP (family
))
1627 family
= SYMBOL_NAME (family
);
1632 val
= AREF (font
, FONT_SIZE_INDEX
);
1635 if (XINT (val
) != 0)
1636 pixel_size
= XINT (val
);
1641 eassert (FLOATP (val
));
1643 point_size
= (int) XFLOAT_DATA (val
);
1646 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1647 if (! NILP (foundry
))
1649 if (SYMBOLP (foundry
))
1650 foundry
= SYMBOL_NAME (foundry
);
1655 for (i
= 0; i
< 3; i
++)
1656 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1659 lim
= name
+ nbytes
;
1660 if (! NILP (family
))
1662 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1663 if (! (0 <= len
&& len
< lim
- p
))
1669 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1670 if (! (0 <= len
&& len
< lim
- p
))
1674 else if (pixel_size
> 0)
1676 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1677 if (! (0 <= len
&& len
< lim
- p
))
1681 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1683 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1684 SSDATA (SYMBOL_NAME (AREF (font
,
1685 FONT_FOUNDRY_INDEX
))));
1686 if (! (0 <= len
&& len
< lim
- p
))
1690 for (i
= 0; i
< 3; i
++)
1691 if (! NILP (styles
[i
]))
1693 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1694 SSDATA (SYMBOL_NAME (styles
[i
])));
1695 if (! (0 <= len
&& len
< lim
- p
))
1700 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1702 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1703 XINT (AREF (font
, FONT_DPI_INDEX
)));
1704 if (! (0 <= len
&& len
< lim
- p
))
1709 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1711 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1712 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1713 if (! (0 <= len
&& len
< lim
- p
))
1718 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1720 int len
= snprintf (p
, lim
- p
,
1721 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1723 : ":scalable=false"));
1724 if (! (0 <= len
&& len
< lim
- p
))
1734 /* Parse NAME (null terminated) and store information in FONT
1735 (font-spec or font-entity). If NAME is successfully parsed, return
1736 0. Otherwise return -1. */
1739 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1741 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1742 return font_parse_xlfd (name
, namelen
, font
);
1743 return font_parse_fcname (name
, namelen
, font
);
1747 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1748 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1752 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1758 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1760 CHECK_STRING (family
);
1761 len
= SBYTES (family
);
1762 p0
= SSDATA (family
);
1763 p1
= strchr (p0
, '-');
1766 if ((*p0
!= '*' && p1
- p0
> 0)
1767 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1768 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1771 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1774 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1776 if (! NILP (registry
))
1778 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1779 CHECK_STRING (registry
);
1780 len
= SBYTES (registry
);
1781 p0
= SSDATA (registry
);
1782 p1
= strchr (p0
, '-');
1785 if (SDATA (registry
)[len
- 1] == '*')
1786 registry
= concat2 (registry
, build_string ("-*"));
1788 registry
= concat2 (registry
, build_string ("*-*"));
1790 registry
= Fdowncase (registry
);
1791 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1796 /* This part (through the next ^L) is still experimental and not
1797 tested much. We may drastically change codes. */
1803 #define LGSTRING_HEADER_SIZE 6
1804 #define LGSTRING_GLYPH_SIZE 8
1807 check_gstring (Lisp_Object gstring
)
1813 CHECK_VECTOR (gstring
);
1814 val
= AREF (gstring
, 0);
1816 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1818 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1819 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1820 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1821 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1822 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1823 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1824 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1825 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1826 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1827 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1828 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1830 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1832 val
= LGSTRING_GLYPH (gstring
, i
);
1834 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1836 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1838 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1839 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1840 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1841 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1842 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1843 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1844 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1845 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1847 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1849 if (ASIZE (val
) < 3)
1851 for (j
= 0; j
< 3; j
++)
1852 CHECK_NUMBER (AREF (val
, j
));
1857 error ("Invalid glyph-string format");
1862 check_otf_features (Lisp_Object otf_features
)
1866 CHECK_CONS (otf_features
);
1867 CHECK_SYMBOL (XCAR (otf_features
));
1868 otf_features
= XCDR (otf_features
);
1869 CHECK_CONS (otf_features
);
1870 CHECK_SYMBOL (XCAR (otf_features
));
1871 otf_features
= XCDR (otf_features
);
1872 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1874 CHECK_SYMBOL (XCAR (val
));
1875 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1876 error ("Invalid OTF GSUB feature: %s",
1877 SDATA (SYMBOL_NAME (XCAR (val
))));
1879 otf_features
= XCDR (otf_features
);
1880 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1882 CHECK_SYMBOL (XCAR (val
));
1883 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1884 error ("Invalid OTF GPOS feature: %s",
1885 SDATA (SYMBOL_NAME (XCAR (val
))));
1892 Lisp_Object otf_list
;
1895 otf_tag_symbol (OTF_Tag tag
)
1899 OTF_tag_name (tag
, name
);
1900 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1904 otf_open (Lisp_Object file
)
1906 Lisp_Object val
= Fassoc (file
, otf_list
);
1910 otf
= XSAVE_POINTER (XCDR (val
), 0);
1913 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1914 val
= make_save_ptr (otf
);
1915 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1921 /* Return a list describing which scripts/languages FONT supports by
1922 which GSUB/GPOS features of OpenType tables. See the comment of
1923 (struct font_driver).otf_capability. */
1926 font_otf_capability (struct font
*font
)
1929 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1932 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1935 for (i
= 0; i
< 2; i
++)
1937 OTF_GSUB_GPOS
*gsub_gpos
;
1938 Lisp_Object script_list
= Qnil
;
1941 if (OTF_get_features (otf
, i
== 0) < 0)
1943 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1944 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1946 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1947 Lisp_Object langsys_list
= Qnil
;
1948 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1951 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1953 OTF_LangSys
*langsys
;
1954 Lisp_Object feature_list
= Qnil
;
1955 Lisp_Object langsys_tag
;
1958 if (k
== script
->LangSysCount
)
1960 langsys
= &script
->DefaultLangSys
;
1965 langsys
= script
->LangSys
+ k
;
1967 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1969 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1971 OTF_Feature
*feature
1972 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1973 Lisp_Object feature_tag
1974 = otf_tag_symbol (feature
->FeatureTag
);
1976 feature_list
= Fcons (feature_tag
, feature_list
);
1978 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1981 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1986 XSETCAR (capability
, script_list
);
1988 XSETCDR (capability
, script_list
);
1994 /* Parse OTF features in SPEC and write a proper features spec string
1995 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1996 assured that the sufficient memory has already allocated for
2000 generate_otf_features (Lisp_Object spec
, char *features
)
2008 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2014 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2019 else if (! asterisk
)
2021 val
= SYMBOL_NAME (val
);
2022 p
+= esprintf (p
, "%s", SDATA (val
));
2026 val
= SYMBOL_NAME (val
);
2027 p
+= esprintf (p
, "~%s", SDATA (val
));
2031 error ("OTF spec too long");
2035 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
2037 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2039 return Fcons (make_number (len
),
2040 make_unibyte_string (device_table
->DeltaValue
, len
));
2044 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2046 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2048 if (value_format
& OTF_XPlacement
)
2049 ASET (val
, 0, make_number (value_record
->XPlacement
));
2050 if (value_format
& OTF_YPlacement
)
2051 ASET (val
, 1, make_number (value_record
->YPlacement
));
2052 if (value_format
& OTF_XAdvance
)
2053 ASET (val
, 2, make_number (value_record
->XAdvance
));
2054 if (value_format
& OTF_YAdvance
)
2055 ASET (val
, 3, make_number (value_record
->YAdvance
));
2056 if (value_format
& OTF_XPlaDevice
)
2057 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2058 if (value_format
& OTF_YPlaDevice
)
2059 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2060 if (value_format
& OTF_XAdvDevice
)
2061 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2062 if (value_format
& OTF_YAdvDevice
)
2063 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2068 font_otf_Anchor (OTF_Anchor
*anchor
)
2072 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2073 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2074 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2075 if (anchor
->AnchorFormat
== 2)
2076 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2079 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2080 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2084 #endif /* HAVE_LIBOTF */
2091 font_rescale_ratio (Lisp_Object font_entity
)
2093 Lisp_Object tail
, elt
;
2094 Lisp_Object name
= Qnil
;
2096 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2099 if (FLOATP (XCDR (elt
)))
2101 if (STRINGP (XCAR (elt
)))
2104 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2105 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2106 return XFLOAT_DATA (XCDR (elt
));
2108 else if (FONT_SPEC_P (XCAR (elt
)))
2110 if (font_match_p (XCAR (elt
), font_entity
))
2111 return XFLOAT_DATA (XCDR (elt
));
2118 /* We sort fonts by scoring each of them against a specified
2119 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2120 the value is, the closer the font is to the font-spec.
2122 The lowest 2 bits of the score are used for driver type. The font
2123 available by the most preferred font driver is 0.
2125 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2126 WEIGHT, SLANT, WIDTH, and SIZE. */
2128 /* How many bits to shift to store the difference value of each font
2129 property in a score. Note that floats for FONT_TYPE_INDEX and
2130 FONT_REGISTRY_INDEX are not used. */
2131 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2133 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2134 The return value indicates how different ENTITY is compared with
2138 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2143 /* Score three style numeric fields. Maximum difference is 127. */
2144 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2145 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2147 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2148 - (XINT (spec_prop
[i
]) >> 8));
2149 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2152 /* Score the size. Maximum difference is 127. */
2153 i
= FONT_SIZE_INDEX
;
2154 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2155 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2157 /* We use the higher 6-bit for the actual size difference. The
2158 lowest bit is set if the DPI is different. */
2160 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2161 EMACS_INT entity_size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
2163 if (CONSP (Vface_font_rescale_alist
))
2164 pixel_size
*= font_rescale_ratio (entity
);
2165 if (pixel_size
* 2 < entity_size
|| entity_size
* 2 < pixel_size
)
2166 /* This size is wrong by more than a factor 2: reject it! */
2168 diff
= eabs (pixel_size
- entity_size
) << 1;
2169 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2170 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2172 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2173 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2175 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2182 /* Concatenate all elements of LIST into one vector. LIST is a list
2183 of font-entity vectors. */
2186 font_vconcat_entity_vectors (Lisp_Object list
)
2188 int nargs
= XINT (Flength (list
));
2189 Lisp_Object
*args
= alloca (word_size
* nargs
);
2192 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2193 args
[i
] = XCAR (list
);
2194 return Fvconcat (nargs
, args
);
2198 /* The structure for elements being sorted by qsort. */
2199 struct font_sort_data
2202 int font_driver_preference
;
2207 /* The comparison function for qsort. */
2210 font_compare (const void *d1
, const void *d2
)
2212 const struct font_sort_data
*data1
= d1
;
2213 const struct font_sort_data
*data2
= d2
;
2215 if (data1
->score
< data2
->score
)
2217 else if (data1
->score
> data2
->score
)
2219 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2223 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2224 If PREFER specifies a point-size, calculate the corresponding
2225 pixel-size from QCdpi property of PREFER or from the Y-resolution
2226 of FRAME before sorting.
2228 If BEST-ONLY is nonzero, return the best matching entity (that
2229 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2230 if BEST-ONLY is negative). Otherwise, return the sorted result as
2231 a single vector of font-entities.
2233 This function does no optimization for the case that the total
2234 number of elements is 1. The caller should avoid calling this in
2238 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2239 struct frame
*f
, int best_only
)
2241 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2243 struct font_sort_data
*data
;
2244 unsigned best_score
;
2245 Lisp_Object best_entity
;
2246 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2249 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2250 prefer_prop
[i
] = AREF (prefer
, i
);
2251 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2252 prefer_prop
[FONT_SIZE_INDEX
]
2253 = make_number (font_pixel_size (f
, prefer
));
2255 if (NILP (XCDR (list
)))
2257 /* What we have to take care of is this single vector. */
2259 maxlen
= ASIZE (vec
);
2263 /* We don't have to perform sort, so there's no need of creating
2264 a single vector. But, we must find the length of the longest
2267 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2268 if (maxlen
< ASIZE (XCAR (tail
)))
2269 maxlen
= ASIZE (XCAR (tail
));
2273 /* We have to create a single vector to sort it. */
2274 vec
= font_vconcat_entity_vectors (list
);
2275 maxlen
= ASIZE (vec
);
2278 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2279 best_score
= 0xFFFFFFFF;
2282 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2284 int font_driver_preference
= 0;
2285 Lisp_Object current_font_driver
;
2291 /* We are sure that the length of VEC > 0. */
2292 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2293 /* Score the elements. */
2294 for (i
= 0; i
< len
; i
++)
2296 data
[i
].entity
= AREF (vec
, i
);
2298 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2300 ? font_score (data
[i
].entity
, prefer_prop
)
2302 if (best_only
&& best_score
> data
[i
].score
)
2304 best_score
= data
[i
].score
;
2305 best_entity
= data
[i
].entity
;
2306 if (best_score
== 0)
2309 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2311 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2312 font_driver_preference
++;
2314 data
[i
].font_driver_preference
= font_driver_preference
;
2317 /* Sort if necessary. */
2320 qsort (data
, len
, sizeof *data
, font_compare
);
2321 for (i
= 0; i
< len
; i
++)
2322 ASET (vec
, i
, data
[i
].entity
);
2331 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2336 /* API of Font Service Layer. */
2338 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2339 sort_shift_bits. Finternal_set_font_selection_order calls this
2340 function with font_sort_order after setting up it. */
2343 font_update_sort_order (int *order
)
2347 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2349 int xlfd_idx
= order
[i
];
2351 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2352 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2353 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2354 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2355 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2356 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2358 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2363 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2364 Lisp_Object features
, Lisp_Object table
)
2369 table
= assq_no_quit (script
, table
);
2372 table
= XCDR (table
);
2373 if (! NILP (langsys
))
2375 table
= assq_no_quit (langsys
, table
);
2381 val
= assq_no_quit (Qnil
, table
);
2383 table
= XCAR (table
);
2387 table
= XCDR (table
);
2388 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2390 if (NILP (XCAR (features
)))
2395 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2401 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2404 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2406 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2408 script
= XCAR (spec
);
2412 langsys
= XCAR (spec
);
2423 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2424 XCAR (otf_capability
)))
2426 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2427 XCDR (otf_capability
)))
2434 /* Check if FONT (font-entity or font-object) matches with the font
2435 specification SPEC. */
2438 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2440 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2441 Lisp_Object extra
, font_extra
;
2444 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2445 if (! NILP (AREF (spec
, i
))
2446 && ! NILP (AREF (font
, i
))
2447 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2449 props
= XFONT_SPEC (spec
)->props
;
2450 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2452 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2453 prop
[i
] = AREF (spec
, i
);
2454 prop
[FONT_SIZE_INDEX
]
2455 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2459 if (font_score (font
, props
) > 0)
2461 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2462 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2463 for (; CONSP (extra
); extra
= XCDR (extra
))
2465 Lisp_Object key
= XCAR (XCAR (extra
));
2466 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2468 if (EQ (key
, QClang
))
2470 val2
= assq_no_quit (key
, font_extra
);
2479 if (NILP (Fmemq (val
, val2
)))
2484 ? NILP (Fmemq (val
, XCDR (val2
)))
2488 else if (EQ (key
, QCscript
))
2490 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2496 /* All characters in the list must be supported. */
2497 for (; CONSP (val2
); val2
= XCDR (val2
))
2499 if (! CHARACTERP (XCAR (val2
)))
2501 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2502 == FONT_INVALID_CODE
)
2506 else if (VECTORP (val2
))
2508 /* At most one character in the vector must be supported. */
2509 for (i
= 0; i
< ASIZE (val2
); i
++)
2511 if (! CHARACTERP (AREF (val2
, i
)))
2513 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2514 != FONT_INVALID_CODE
)
2517 if (i
== ASIZE (val2
))
2522 else if (EQ (key
, QCotf
))
2526 if (! FONT_OBJECT_P (font
))
2528 fontp
= XFONT_OBJECT (font
);
2529 if (! fontp
->driver
->otf_capability
)
2531 val2
= fontp
->driver
->otf_capability (fontp
);
2532 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2543 Each font backend has the callback function get_cache, and it
2544 returns a cons cell of which cdr part can be freely used for
2545 caching fonts. The cons cell may be shared by multiple frames
2546 and/or multiple font drivers. So, we arrange the cdr part as this:
2548 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2550 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2551 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2552 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2554 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2555 static void font_finish_cache (struct frame
*, struct font_driver
*);
2556 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2557 static void font_clear_cache (struct frame
*, Lisp_Object
,
2558 struct font_driver
*);
2561 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2563 Lisp_Object cache
, val
;
2565 cache
= driver
->get_cache (f
);
2567 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2571 val
= list2 (driver
->type
, make_number (1));
2572 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2576 val
= XCDR (XCAR (val
));
2577 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2583 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2585 Lisp_Object cache
, val
, tmp
;
2588 cache
= driver
->get_cache (f
);
2590 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2591 cache
= val
, val
= XCDR (val
);
2592 eassert (! NILP (val
));
2593 tmp
= XCDR (XCAR (val
));
2594 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2595 if (XINT (XCAR (tmp
)) == 0)
2597 font_clear_cache (f
, XCAR (val
), driver
);
2598 XSETCDR (cache
, XCDR (val
));
2604 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2606 Lisp_Object val
= driver
->get_cache (f
);
2607 Lisp_Object type
= driver
->type
;
2609 eassert (CONSP (val
));
2610 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2611 eassert (CONSP (val
));
2612 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2613 val
= XCDR (XCAR (val
));
2619 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2621 Lisp_Object tail
, elt
;
2625 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2626 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2629 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2630 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2633 eassert (VECTORP (elt
));
2634 for (i
= 0; i
< ASIZE (elt
); i
++)
2636 entity
= AREF (elt
, i
);
2638 if (FONT_ENTITY_P (entity
)
2639 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2641 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2643 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2645 Lisp_Object val
= XCAR (objlist
);
2646 struct font
*font
= XFONT_OBJECT (val
);
2648 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2650 eassert (font
&& driver
== font
->driver
);
2651 driver
->close (font
);
2654 if (driver
->free_entity
)
2655 driver
->free_entity (entity
);
2660 XSETCDR (cache
, Qnil
);
2664 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2666 /* Check each font-entity in VEC, and return a list of font-entities
2667 that satisfy these conditions:
2668 (1) matches with SPEC and SIZE if SPEC is not nil, and
2669 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2673 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2675 Lisp_Object entity
, val
;
2676 enum font_property_index prop
;
2679 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2681 entity
= AREF (vec
, i
);
2682 if (! NILP (Vface_ignored_fonts
))
2686 Lisp_Object tail
, regexp
;
2688 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2691 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2693 regexp
= XCAR (tail
);
2694 if (STRINGP (regexp
)
2695 && fast_c_string_match_ignore_case (regexp
, name
,
2705 val
= Fcons (entity
, val
);
2708 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2709 if (INTEGERP (AREF (spec
, prop
))
2710 && ((XINT (AREF (spec
, prop
)) >> 8)
2711 != (XINT (AREF (entity
, prop
)) >> 8)))
2712 prop
= FONT_SPEC_MAX
;
2713 if (prop
< FONT_SPEC_MAX
2715 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2717 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2719 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2720 prop
= FONT_SPEC_MAX
;
2722 if (prop
< FONT_SPEC_MAX
2723 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2724 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2725 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2726 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2727 prop
= FONT_SPEC_MAX
;
2728 if (prop
< FONT_SPEC_MAX
2729 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2730 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2731 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2732 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2733 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2734 prop
= FONT_SPEC_MAX
;
2735 if (prop
< FONT_SPEC_MAX
)
2736 val
= Fcons (entity
, val
);
2738 return (Fvconcat (1, &val
));
2742 /* Return a list of vectors of font-entities matching with SPEC on
2743 FRAME. Each elements in the list is a vector of entities from the
2744 same font-driver. */
2747 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2749 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2750 Lisp_Object ftype
, val
;
2751 Lisp_Object list
= Qnil
;
2753 bool need_filtering
= 0;
2756 eassert (FONT_SPEC_P (spec
));
2758 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2759 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2760 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2761 size
= font_pixel_size (f
, spec
);
2765 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2766 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2767 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2768 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2769 if (i
!= FONT_SPACING_INDEX
)
2771 ASET (scratch_font_spec
, i
, Qnil
);
2772 if (! NILP (AREF (spec
, i
)))
2775 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2776 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2778 for (; driver_list
; driver_list
= driver_list
->next
)
2780 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2782 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2784 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2785 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2790 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2793 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2795 val
= Fvconcat (1, &val
);
2796 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2797 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2800 if (VECTORP (val
) && ASIZE (val
) > 0
2802 || ! NILP (Vface_ignored_fonts
)))
2803 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2804 if (VECTORP (val
) && ASIZE (val
) > 0)
2805 list
= Fcons (val
, list
);
2808 list
= Fnreverse (list
);
2809 FONT_ADD_LOG ("list", spec
, list
);
2814 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2815 nil, is an array of face's attributes, which specifies preferred
2816 font-related attributes. */
2819 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2821 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2822 Lisp_Object ftype
, size
, entity
;
2823 Lisp_Object work
= copy_font_spec (spec
);
2825 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2826 size
= AREF (spec
, FONT_SIZE_INDEX
);
2829 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2830 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2831 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2832 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2835 for (; driver_list
; driver_list
= driver_list
->next
)
2837 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2839 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2841 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2842 entity
= assoc_no_quit (work
, XCDR (cache
));
2844 entity
= AREF (XCDR (entity
), 0);
2847 entity
= driver_list
->driver
->match (f
, work
);
2850 Lisp_Object copy
= copy_font_spec (work
);
2851 Lisp_Object match
= Fvector (1, &entity
);
2853 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2854 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2857 if (! NILP (entity
))
2860 FONT_ADD_LOG ("match", work
, entity
);
2865 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2866 opened font object. */
2869 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2871 struct font_driver_list
*driver_list
;
2872 Lisp_Object objlist
, size
, val
, font_object
;
2874 int min_width
, height
, psize
;
2876 eassert (FONT_ENTITY_P (entity
));
2877 size
= AREF (entity
, FONT_SIZE_INDEX
);
2878 if (XINT (size
) != 0)
2879 pixel_size
= XINT (size
);
2881 val
= AREF (entity
, FONT_TYPE_INDEX
);
2882 for (driver_list
= f
->font_driver_list
;
2883 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2884 driver_list
= driver_list
->next
);
2888 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2889 objlist
= XCDR (objlist
))
2891 Lisp_Object fn
= XCAR (objlist
);
2892 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2893 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2895 if (driver_list
->driver
->cached_font_ok
== NULL
2896 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2901 /* We always open a font of manageable size; i.e non-zero average
2902 width and height. */
2903 for (psize
= pixel_size
; ; psize
++)
2905 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2906 if (NILP (font_object
))
2908 font
= XFONT_OBJECT (font_object
);
2909 if (font
->average_width
> 0 && font
->height
> 0)
2912 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2913 FONT_ADD_LOG ("open", entity
, font_object
);
2914 ASET (entity
, FONT_OBJLIST_INDEX
,
2915 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2917 font
= XFONT_OBJECT (font_object
);
2918 min_width
= (font
->min_width
? font
->min_width
2919 : font
->average_width
? font
->average_width
2920 : font
->space_width
? font
->space_width
2922 height
= (font
->height
? font
->height
: 1);
2923 #ifdef HAVE_WINDOW_SYSTEM
2924 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2925 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2927 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2928 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2929 f
->fonts_changed
= 1;
2933 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2934 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2935 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2936 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2944 /* Close FONT_OBJECT that is opened on frame F. */
2947 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2949 struct font
*font
= XFONT_OBJECT (font_object
);
2951 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2952 /* Already closed. */
2954 FONT_ADD_LOG ("close", font_object
, Qnil
);
2955 font
->driver
->close (font
);
2956 #ifdef HAVE_WINDOW_SYSTEM
2957 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2958 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2963 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2964 FONT is a font-entity and it must be opened to check. */
2967 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2971 if (FONT_ENTITY_P (font
))
2973 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2974 struct font_driver_list
*driver_list
;
2976 for (driver_list
= f
->font_driver_list
;
2977 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2978 driver_list
= driver_list
->next
);
2981 if (! driver_list
->driver
->has_char
)
2983 return driver_list
->driver
->has_char (font
, c
);
2986 eassert (FONT_OBJECT_P (font
));
2987 fontp
= XFONT_OBJECT (font
);
2988 if (fontp
->driver
->has_char
)
2990 int result
= fontp
->driver
->has_char (font
, c
);
2995 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2999 /* Return the glyph ID of FONT_OBJECT for character C. */
3002 font_encode_char (Lisp_Object font_object
, int c
)
3006 eassert (FONT_OBJECT_P (font_object
));
3007 font
= XFONT_OBJECT (font_object
);
3008 return font
->driver
->encode_char (font
, c
);
3012 /* Return the name of FONT_OBJECT. */
3015 font_get_name (Lisp_Object font_object
)
3017 eassert (FONT_OBJECT_P (font_object
));
3018 return AREF (font_object
, FONT_NAME_INDEX
);
3022 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3023 could not be parsed by font_parse_name, return Qnil. */
3026 font_spec_from_name (Lisp_Object font_name
)
3028 Lisp_Object spec
= Ffont_spec (0, NULL
);
3030 CHECK_STRING (font_name
);
3031 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
3033 font_put_extra (spec
, QCname
, font_name
);
3034 font_put_extra (spec
, QCuser_spec
, font_name
);
3040 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3042 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3047 if (! NILP (Ffont_get (font
, QCname
)))
3049 font
= copy_font_spec (font
);
3050 font_put_extra (font
, QCname
, Qnil
);
3053 if (NILP (AREF (font
, prop
))
3054 && prop
!= FONT_FAMILY_INDEX
3055 && prop
!= FONT_FOUNDRY_INDEX
3056 && prop
!= FONT_WIDTH_INDEX
3057 && prop
!= FONT_SIZE_INDEX
)
3059 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3060 font
= copy_font_spec (font
);
3061 ASET (font
, prop
, Qnil
);
3062 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3064 if (prop
== FONT_FAMILY_INDEX
)
3066 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3067 /* If we are setting the font family, we must also clear
3068 FONT_WIDTH_INDEX to avoid rejecting families that lack
3069 support for some widths. */
3070 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3072 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3073 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3074 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3075 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3076 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3077 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3079 else if (prop
== FONT_SIZE_INDEX
)
3081 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3082 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3083 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3085 else if (prop
== FONT_WIDTH_INDEX
)
3086 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3087 attrs
[LFACE_FONT_INDEX
] = font
;
3090 /* Select a font from ENTITIES (list of font-entity vectors) that
3091 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3094 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3095 Lisp_Object
*attrs
, int pixel_size
, int c
)
3097 Lisp_Object font_entity
;
3101 if (NILP (XCDR (entities
))
3102 && ASIZE (XCAR (entities
)) == 1)
3104 font_entity
= AREF (XCAR (entities
), 0);
3105 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3110 /* Sort fonts by properties specified in ATTRS. */
3111 prefer
= scratch_font_prefer
;
3113 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3114 ASET (prefer
, i
, Qnil
);
3115 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3117 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3119 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3120 ASET (prefer
, i
, AREF (face_font
, i
));
3122 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3123 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3124 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3125 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3126 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3127 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3128 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3130 return font_sort_entities (entities
, prefer
, f
, c
);
3133 /* Return a font-entity that satisfies SPEC and is the best match for
3134 face's font related attributes in ATTRS. C, if not negative, is a
3135 character that the entity must support. */
3138 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3141 Lisp_Object entities
, val
;
3142 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3147 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3148 if (NILP (registry
[0]))
3150 registry
[0] = DEFAULT_ENCODING
;
3151 registry
[1] = Qascii_0
;
3152 registry
[2] = zero_vector
;
3155 registry
[1] = zero_vector
;
3157 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3159 struct charset
*encoding
, *repertory
;
3161 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3162 &encoding
, &repertory
) < 0)
3165 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3167 else if (c
> encoding
->max_char
)
3171 work
= copy_font_spec (spec
);
3172 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3173 pixel_size
= font_pixel_size (f
, spec
);
3174 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3176 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3178 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3182 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3183 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3184 if (! NILP (foundry
[0]))
3185 foundry
[1] = zero_vector
;
3186 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3188 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3189 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3191 foundry
[2] = zero_vector
;
3194 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3196 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3197 if (! NILP (adstyle
[0]))
3198 adstyle
[1] = zero_vector
;
3199 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3201 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3203 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3205 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3207 adstyle
[2] = zero_vector
;
3210 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3213 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3216 val
= AREF (work
, FONT_FAMILY_INDEX
);
3217 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3219 val
= attrs
[LFACE_FAMILY_INDEX
];
3220 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3224 family
= alloca ((sizeof family
[0]) * 2);
3226 family
[1] = zero_vector
; /* terminator. */
3231 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3233 if (! NILP (alters
))
3235 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3236 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3237 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3238 family
[i
] = XCAR (alters
);
3239 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3241 family
[i
] = zero_vector
;
3245 family
= alloca ((sizeof family
[0]) * 3);
3248 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3250 family
[i
] = zero_vector
;
3254 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3256 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3257 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3259 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3260 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3262 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3263 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3265 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3266 entities
= font_list_entities (f
, work
);
3267 if (! NILP (entities
))
3269 val
= font_select_entity (f
, entities
,
3270 attrs
, pixel_size
, c
);
3288 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3292 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3293 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3294 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3297 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3298 size
= font_pixel_size (f
, spec
);
3302 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3303 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3306 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3307 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3308 eassert (INTEGERP (height
));
3313 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3317 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3318 size
= (NUMBERP (ffsize
)
3319 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3323 size
*= font_rescale_ratio (entity
);
3326 return font_open_entity (f
, entity
, size
);
3330 /* Find a font that satisfies SPEC and is the best match for
3331 face's attributes in ATTRS on FRAME, and return the opened
3335 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3337 Lisp_Object entity
, name
;
3339 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3342 /* No font is listed for SPEC, but each font-backend may have
3343 different criteria about "font matching". So, try it. */
3344 entity
= font_matching_entity (f
, attrs
, spec
);
3348 /* Don't lose the original name that was put in initially. We need
3349 it to re-apply the font when font parameters (like hinting or dpi) have
3351 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3354 name
= Ffont_get (spec
, QCuser_spec
);
3355 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3361 /* Make FACE on frame F ready to use the font opened for FACE. */
3364 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3366 if (face
->font
->driver
->prepare_face
)
3367 face
->font
->driver
->prepare_face (f
, face
);
3371 /* Make FACE on frame F stop using the font opened for FACE. */
3374 font_done_for_face (struct frame
*f
, struct face
*face
)
3376 if (face
->font
->driver
->done_face
)
3377 face
->font
->driver
->done_face (f
, face
);
3381 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3382 font is found, return Qnil. */
3385 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3387 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3389 /* We set up the default font-related attributes of a face to prefer
3391 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3392 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3393 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3395 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3397 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3399 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3401 return font_load_for_lface (f
, attrs
, spec
);
3405 /* Open a font that matches NAME on frame F. If no proper font is
3406 found, return Qnil. */
3409 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3411 Lisp_Object args
[2];
3412 Lisp_Object spec
, ret
;
3416 spec
= Ffont_spec (2, args
);
3417 ret
= font_open_by_spec (f
, spec
);
3418 /* Do not lose name originally put in. */
3420 font_put_extra (ret
, QCuser_spec
, args
[1]);
3426 /* Register font-driver DRIVER. This function is used in two ways.
3428 The first is with frame F non-NULL. In this case, make DRIVER
3429 available (but not yet activated) on F. All frame creators
3430 (e.g. Fx_create_frame) must call this function at least once with
3431 an available font-driver.
3433 The second is with frame F NULL. In this case, DRIVER is globally
3434 registered in the variable `font_driver_list'. All font-driver
3435 implementations must call this function in its syms_of_XXXX
3436 (e.g. syms_of_xfont). */
3439 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3441 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3442 struct font_driver_list
*prev
, *list
;
3444 #ifdef HAVE_WINDOW_SYSTEM
3445 if (f
&& ! driver
->draw
)
3446 error ("Unusable font driver for a frame: %s",
3447 SDATA (SYMBOL_NAME (driver
->type
)));
3448 #endif /* HAVE_WINDOW_SYSTEM */
3450 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3451 if (EQ (list
->driver
->type
, driver
->type
))
3452 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3454 list
= xmalloc (sizeof *list
);
3456 list
->driver
= driver
;
3461 f
->font_driver_list
= list
;
3463 font_driver_list
= list
;
3469 free_font_driver_list (struct frame
*f
)
3471 struct font_driver_list
*list
, *next
;
3473 for (list
= f
->font_driver_list
; list
; list
= next
)
3478 f
->font_driver_list
= NULL
;
3482 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3483 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3484 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3486 A caller must free all realized faces if any in advance. The
3487 return value is a list of font backends actually made used on
3491 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3493 Lisp_Object active_drivers
= Qnil
;
3494 struct font_driver_list
*list
;
3496 /* At first, turn off non-requested drivers, and turn on requested
3498 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3500 struct font_driver
*driver
= list
->driver
;
3501 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3506 if (driver
->end_for_frame
)
3507 driver
->end_for_frame (f
);
3508 font_finish_cache (f
, driver
);
3513 if (! driver
->start_for_frame
3514 || driver
->start_for_frame (f
) == 0)
3516 font_prepare_cache (f
, driver
);
3523 if (NILP (new_drivers
))
3526 if (! EQ (new_drivers
, Qt
))
3528 /* Re-order the driver list according to new_drivers. */
3529 struct font_driver_list
**list_table
, **next
;
3533 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3534 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3536 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3537 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3540 list_table
[i
++] = list
;
3542 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3544 list_table
[i
++] = list
;
3545 list_table
[i
] = NULL
;
3547 next
= &f
->font_driver_list
;
3548 for (i
= 0; list_table
[i
]; i
++)
3550 *next
= list_table
[i
];
3551 next
= &(*next
)->next
;
3555 if (! f
->font_driver_list
->on
)
3556 { /* None of the drivers is enabled: enable them all.
3557 Happens if you set the list of drivers to (xft x) in your .emacs
3558 and then use it under w32 or ns. */
3559 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3561 struct font_driver
*driver
= list
->driver
;
3562 eassert (! list
->on
);
3563 if (! driver
->start_for_frame
3564 || driver
->start_for_frame (f
) == 0)
3566 font_prepare_cache (f
, driver
);
3573 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3575 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3576 return active_drivers
;
3579 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
3582 fset_font_data (struct frame
*f
, Lisp_Object val
)
3588 font_put_frame_data (struct frame
*f
, Lisp_Object driver
, void *data
)
3590 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3593 fset_font_data (f
, Fdelq (val
, f
->font_data
));
3597 fset_font_data (f
, Fcons (Fcons (driver
, make_save_ptr (data
)),
3600 XSETCDR (val
, make_save_ptr (data
));
3605 font_get_frame_data (struct frame
*f
, Lisp_Object driver
)
3607 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3609 return NILP (val
) ? NULL
: XSAVE_POINTER (XCDR (val
), 0);
3612 #endif /* HAVE_XFT || HAVE_FREETYPE */
3614 /* Sets attributes on a font. Any properties that appear in ALIST and
3615 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3616 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3617 arrays of strings. This function is intended for use by the font
3618 drivers to implement their specific font_filter_properties. */
3620 font_filter_properties (Lisp_Object font
,
3622 const char *const boolean_properties
[],
3623 const char *const non_boolean_properties
[])
3628 /* Set boolean values to Qt or Qnil. */
3629 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3630 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3632 Lisp_Object key
= XCAR (XCAR (it
));
3633 Lisp_Object val
= XCDR (XCAR (it
));
3634 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3636 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3638 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3639 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3642 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3643 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3644 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3645 || strcmp ("Off", str
) == 0)
3650 Ffont_put (font
, key
, val
);
3654 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3655 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3657 Lisp_Object key
= XCAR (XCAR (it
));
3658 Lisp_Object val
= XCDR (XCAR (it
));
3659 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3660 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3661 Ffont_put (font
, key
, val
);
3666 /* Return the font used to draw character C by FACE at buffer position
3667 POS in window W. If STRING is non-nil, it is a string containing C
3668 at index POS. If C is negative, get C from the current buffer or
3672 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3677 Lisp_Object font_object
;
3679 multibyte
= (NILP (string
)
3680 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3681 : STRING_MULTIBYTE (string
));
3688 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3690 c
= FETCH_CHAR (pos_byte
);
3693 c
= FETCH_BYTE (pos
);
3699 multibyte
= STRING_MULTIBYTE (string
);
3702 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3704 str
= SDATA (string
) + pos_byte
;
3705 c
= STRING_CHAR (str
);
3708 c
= SDATA (string
)[pos
];
3712 f
= XFRAME (w
->frame
);
3713 if (! FRAME_WINDOW_P (f
))
3720 if (STRINGP (string
))
3721 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3722 DEFAULT_FACE_ID
, 0);
3724 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3726 face
= FACE_FROM_ID (f
, face_id
);
3730 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3731 face
= FACE_FROM_ID (f
, face_id
);
3736 XSETFONT (font_object
, face
->font
);
3741 #ifdef HAVE_WINDOW_SYSTEM
3743 /* Check how many characters after character/byte position POS/POS_BYTE
3744 (at most to *LIMIT) can be displayed by the same font in the window W.
3745 FACE, if non-NULL, is the face selected for the character at POS.
3746 If STRING is not nil, it is the string to check instead of the current
3747 buffer. In that case, FACE must be not NULL.
3749 The return value is the font-object for the character at POS.
3750 *LIMIT is set to the position where that font can't be used.
3752 It is assured that the current buffer (or STRING) is multibyte. */
3755 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3756 struct window
*w
, struct face
*face
, Lisp_Object string
)
3760 Lisp_Object font_object
= Qnil
;
3768 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3770 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3776 while (pos
< *limit
)
3778 Lisp_Object category
;
3781 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3783 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3784 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3785 if (INTEGERP (category
)
3786 && (XINT (category
) == UNICODE_CATEGORY_Cf
3787 || CHAR_VARIATION_SELECTOR_P (c
)))
3789 if (NILP (font_object
))
3791 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3792 if (NILP (font_object
))
3796 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3806 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3807 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3808 Return nil otherwise.
3809 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3810 which kind of font it is. It must be one of `font-spec', `font-entity',
3812 (Lisp_Object object
, Lisp_Object extra_type
)
3814 if (NILP (extra_type
))
3815 return (FONTP (object
) ? Qt
: Qnil
);
3816 if (EQ (extra_type
, Qfont_spec
))
3817 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3818 if (EQ (extra_type
, Qfont_entity
))
3819 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3820 if (EQ (extra_type
, Qfont_object
))
3821 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3822 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3825 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3826 doc
: /* Return a newly created font-spec with arguments as properties.
3828 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3829 valid font property name listed below:
3831 `:family', `:weight', `:slant', `:width'
3833 They are the same as face attributes of the same name. See
3834 `set-face-attribute'.
3838 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3842 VALUE must be a string or a symbol specifying the additional
3843 typographic style information of a font, e.g. ``sans''.
3847 VALUE must be a string or a symbol specifying the charset registry and
3848 encoding of a font, e.g. ``iso8859-1''.
3852 VALUE must be a non-negative integer or a floating point number
3853 specifying the font size. It specifies the font size in pixels (if
3854 VALUE is an integer), or in points (if VALUE is a float).
3858 VALUE must be a string of XLFD-style or fontconfig-style font name.
3862 VALUE must be a symbol representing a script that the font must
3863 support. It may be a symbol representing a subgroup of a script
3864 listed in the variable `script-representative-chars'.
3868 VALUE must be a symbol of two-letter ISO-639 language names,
3873 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3874 required OpenType features.
3876 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3877 LANGSYS-TAG: OpenType language system tag symbol,
3878 or nil for the default language system.
3879 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3880 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3882 GSUB and GPOS may contain `nil' element. In such a case, the font
3883 must not have any of the remaining elements.
3885 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3886 be an OpenType font whose GPOS table of `thai' script's default
3887 language system must contain `mark' feature.
3889 usage: (font-spec ARGS...) */)
3890 (ptrdiff_t nargs
, Lisp_Object
*args
)
3892 Lisp_Object spec
= font_make_spec ();
3895 for (i
= 0; i
< nargs
; i
+= 2)
3897 Lisp_Object key
= args
[i
], val
;
3901 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3904 if (EQ (key
, QCname
))
3907 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3908 error ("Invalid font name: %s", SSDATA (val
));
3909 font_put_extra (spec
, key
, val
);
3913 int idx
= get_font_prop_index (key
);
3917 val
= font_prop_validate (idx
, Qnil
, val
);
3918 if (idx
< FONT_EXTRA_INDEX
)
3919 ASET (spec
, idx
, val
);
3921 font_put_extra (spec
, key
, val
);
3924 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3930 /* Return a copy of FONT as a font-spec. */
3932 copy_font_spec (Lisp_Object font
)
3934 Lisp_Object new_spec
, tail
, prev
, extra
;
3938 new_spec
= font_make_spec ();
3939 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3940 ASET (new_spec
, i
, AREF (font
, i
));
3941 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3942 /* We must remove :font-entity property. */
3943 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3944 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3947 extra
= XCDR (extra
);
3949 XSETCDR (prev
, XCDR (tail
));
3952 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3956 /* Merge font-specs FROM and TO, and return a new font-spec.
3957 Every specified property in FROM overrides the corresponding
3960 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3962 Lisp_Object extra
, tail
;
3967 to
= copy_font_spec (to
);
3968 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3969 ASET (to
, i
, AREF (from
, i
));
3970 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3971 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3972 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3974 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3977 XSETCDR (slot
, XCDR (XCAR (tail
)));
3979 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3981 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3985 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3986 doc
: /* Return the value of FONT's property KEY.
3987 FONT is a font-spec, a font-entity, or a font-object.
3988 KEY is any symbol, but these are reserved for specific meanings:
3989 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3990 :size, :name, :script, :otf
3991 See the documentation of `font-spec' for their meanings.
3992 In addition, if FONT is a font-entity or a font-object, values of
3993 :script and :otf are different from those of a font-spec as below:
3995 The value of :script may be a list of scripts that are supported by the font.
3997 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3998 representing the OpenType features supported by the font by this form:
3999 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4000 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
4002 (Lisp_Object font
, Lisp_Object key
)
4010 idx
= get_font_prop_index (key
);
4011 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4012 return font_style_symbolic (font
, idx
, 0);
4013 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4014 return AREF (font
, idx
);
4015 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4016 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4018 struct font
*fontp
= XFONT_OBJECT (font
);
4020 if (fontp
->driver
->otf_capability
)
4021 val
= fontp
->driver
->otf_capability (fontp
);
4023 val
= Fcons (Qnil
, Qnil
);
4030 #ifdef HAVE_WINDOW_SYSTEM
4032 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4033 doc
: /* Return a plist of face attributes generated by FONT.
4034 FONT is a font name, a font-spec, a font-entity, or a font-object.
4035 The return value is a list of the form
4037 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4039 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4040 compatible with `set-face-attribute'. Some of these key-attribute pairs
4041 may be omitted from the list if they are not specified by FONT.
4043 The optional argument FRAME specifies the frame that the face attributes
4044 are to be displayed on. If omitted, the selected frame is used. */)
4045 (Lisp_Object font
, Lisp_Object frame
)
4047 struct frame
*f
= decode_live_frame (frame
);
4048 Lisp_Object plist
[10];
4054 int fontset
= fs_query_fontset (font
, 0);
4055 Lisp_Object name
= font
;
4057 font
= fontset_ascii (fontset
);
4058 font
= font_spec_from_name (name
);
4060 signal_error ("Invalid font name", name
);
4062 else if (! FONTP (font
))
4063 signal_error ("Invalid font object", font
);
4065 val
= AREF (font
, FONT_FAMILY_INDEX
);
4068 plist
[n
++] = QCfamily
;
4069 plist
[n
++] = SYMBOL_NAME (val
);
4072 val
= AREF (font
, FONT_SIZE_INDEX
);
4075 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4076 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4077 plist
[n
++] = QCheight
;
4078 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4080 else if (FLOATP (val
))
4082 plist
[n
++] = QCheight
;
4083 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4086 val
= FONT_WEIGHT_FOR_FACE (font
);
4089 plist
[n
++] = QCweight
;
4093 val
= FONT_SLANT_FOR_FACE (font
);
4096 plist
[n
++] = QCslant
;
4100 val
= FONT_WIDTH_FOR_FACE (font
);
4103 plist
[n
++] = QCwidth
;
4107 return Flist (n
, plist
);
4112 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4113 doc
: /* Set one property of FONT: give property KEY value VAL.
4114 FONT is a font-spec, a font-entity, or a font-object.
4116 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4117 accepted by the function `font-spec' (which see), VAL must be what
4118 allowed in `font-spec'.
4120 If FONT is a font-entity or a font-object, KEY must not be the one
4121 accepted by `font-spec'. */)
4122 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4126 idx
= get_font_prop_index (prop
);
4127 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4129 CHECK_FONT_SPEC (font
);
4130 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4134 if (EQ (prop
, QCname
)
4135 || EQ (prop
, QCscript
)
4136 || EQ (prop
, QClang
)
4137 || EQ (prop
, QCotf
))
4138 CHECK_FONT_SPEC (font
);
4141 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4146 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4147 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4148 Optional 2nd argument FRAME specifies the target frame.
4149 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4150 Optional 4th argument PREFER, if non-nil, is a font-spec to
4151 control the order of the returned list. Fonts are sorted by
4152 how close they are to PREFER. */)
4153 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4155 struct frame
*f
= decode_live_frame (frame
);
4156 Lisp_Object vec
, list
;
4159 CHECK_FONT_SPEC (font_spec
);
4167 if (! NILP (prefer
))
4168 CHECK_FONT_SPEC (prefer
);
4170 list
= font_list_entities (f
, font_spec
);
4173 if (NILP (XCDR (list
))
4174 && ASIZE (XCAR (list
)) == 1)
4175 return list1 (AREF (XCAR (list
), 0));
4177 if (! NILP (prefer
))
4178 vec
= font_sort_entities (list
, prefer
, f
, 0);
4180 vec
= font_vconcat_entity_vectors (list
);
4181 if (n
== 0 || n
>= ASIZE (vec
))
4183 Lisp_Object args
[2];
4187 list
= Fappend (2, args
);
4191 for (list
= Qnil
, n
--; n
>= 0; n
--)
4192 list
= Fcons (AREF (vec
, n
), list
);
4197 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4198 doc
: /* List available font families on the current frame.
4199 If FRAME is omitted or nil, the selected frame is used. */)
4202 struct frame
*f
= decode_live_frame (frame
);
4203 struct font_driver_list
*driver_list
;
4204 Lisp_Object list
= Qnil
;
4206 for (driver_list
= f
->font_driver_list
; driver_list
;
4207 driver_list
= driver_list
->next
)
4208 if (driver_list
->driver
->list_family
)
4210 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4211 Lisp_Object tail
= list
;
4213 for (; CONSP (val
); val
= XCDR (val
))
4214 if (NILP (Fmemq (XCAR (val
), tail
))
4215 && SYMBOLP (XCAR (val
)))
4216 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4221 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4222 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4223 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4224 (Lisp_Object font_spec
, Lisp_Object frame
)
4226 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4233 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4234 doc
: /* Return XLFD name of FONT.
4235 FONT is a font-spec, font-entity, or font-object.
4236 If the name is too long for XLFD (maximum 255 chars), return nil.
4237 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4238 the consecutive wildcards are folded into one. */)
4239 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4242 int namelen
, pixel_size
= 0;
4246 if (FONT_OBJECT_P (font
))
4248 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4250 if (STRINGP (font_name
)
4251 && SDATA (font_name
)[0] == '-')
4253 if (NILP (fold_wildcards
))
4255 strcpy (name
, SSDATA (font_name
));
4256 namelen
= SBYTES (font_name
);
4259 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4261 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4265 if (! NILP (fold_wildcards
))
4267 char *p0
= name
, *p1
;
4269 while ((p1
= strstr (p0
, "-*-*")))
4271 strcpy (p1
, p1
+ 2);
4277 return make_string (name
, namelen
);
4281 clear_font_cache (struct frame
*f
)
4283 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4285 for (; driver_list
; driver_list
= driver_list
->next
)
4286 if (driver_list
->on
)
4288 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4292 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4294 eassert (! NILP (val
));
4295 tmp
= XCDR (XCAR (val
));
4296 if (XINT (XCAR (tmp
)) == 0)
4298 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4299 XSETCDR (cache
, XCDR (val
));
4304 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4305 doc
: /* Clear font cache of each frame. */)
4308 Lisp_Object list
, frame
;
4310 FOR_EACH_FRAME (list
, frame
)
4311 clear_font_cache (XFRAME (frame
));
4318 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4320 struct font
*font
= XFONT_OBJECT (font_object
);
4321 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4322 struct font_metrics metrics
;
4324 LGLYPH_SET_CODE (glyph
, code
);
4325 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4326 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4327 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4328 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4329 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4330 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4334 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4335 doc
: /* Shape the glyph-string GSTRING.
4336 Shaping means substituting glyphs and/or adjusting positions of glyphs
4337 to get the correct visual image of character sequences set in the
4338 header of the glyph-string.
4340 If the shaping was successful, the value is GSTRING itself or a newly
4341 created glyph-string. Otherwise, the value is nil.
4343 See the documentation of `composition-get-gstring' for the format of
4345 (Lisp_Object gstring
)
4348 Lisp_Object font_object
, n
, glyph
;
4349 ptrdiff_t i
, from
, to
;
4351 if (! composition_gstring_p (gstring
))
4352 signal_error ("Invalid glyph-string: ", gstring
);
4353 if (! NILP (LGSTRING_ID (gstring
)))
4355 font_object
= LGSTRING_FONT (gstring
);
4356 CHECK_FONT_OBJECT (font_object
);
4357 font
= XFONT_OBJECT (font_object
);
4358 if (! font
->driver
->shape
)
4361 /* Try at most three times with larger gstring each time. */
4362 for (i
= 0; i
< 3; i
++)
4364 n
= font
->driver
->shape (gstring
);
4367 gstring
= larger_vector (gstring
,
4368 LGSTRING_GLYPH_LEN (gstring
), -1);
4370 if (i
== 3 || XINT (n
) == 0)
4372 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4373 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4375 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4376 GLYPHS covers all characters (except for the last few ones) in
4377 GSTRING. More formally, provided that NCHARS is the number of
4378 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4379 and TO_IDX of each glyph must satisfy these conditions:
4381 GLYPHS[0].FROM_IDX == 0
4382 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4383 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4384 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4385 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4387 ;; Be sure to cover all characters.
4388 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4389 glyph
= LGSTRING_GLYPH (gstring
, 0);
4390 from
= LGLYPH_FROM (glyph
);
4391 to
= LGLYPH_TO (glyph
);
4392 if (from
!= 0 || to
< from
)
4394 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4396 glyph
= LGSTRING_GLYPH (gstring
, i
);
4399 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4400 && (LGLYPH_FROM (glyph
) == from
4401 ? LGLYPH_TO (glyph
) == to
4402 : LGLYPH_FROM (glyph
) == to
+ 1)))
4404 from
= LGLYPH_FROM (glyph
);
4405 to
= LGLYPH_TO (glyph
);
4407 return composition_gstring_put_cache (gstring
, XINT (n
));
4413 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4415 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4416 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4418 VARIATION-SELECTOR is a character code of variation selection
4419 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4420 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4421 (Lisp_Object font_object
, Lisp_Object character
)
4423 unsigned variations
[256];
4428 CHECK_FONT_OBJECT (font_object
);
4429 CHECK_CHARACTER (character
);
4430 font
= XFONT_OBJECT (font_object
);
4431 if (! font
->driver
->get_variation_glyphs
)
4433 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4437 for (i
= 0; i
< 255; i
++)
4440 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4441 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4442 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4449 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4450 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4451 OTF-FEATURES specifies which features to apply in this format:
4452 (SCRIPT LANGSYS GSUB GPOS)
4454 SCRIPT is a symbol specifying a script tag of OpenType,
4455 LANGSYS is a symbol specifying a langsys tag of OpenType,
4456 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4458 If LANGSYS is nil, the default langsys is selected.
4460 The features are applied in the order they appear in the list. The
4461 symbol `*' means to apply all available features not present in this
4462 list, and the remaining features are ignored. For instance, (vatu
4463 pstf * haln) is to apply vatu and pstf in this order, then to apply
4464 all available features other than vatu, pstf, and haln.
4466 The features are applied to the glyphs in the range FROM and TO of
4467 the glyph-string GSTRING-IN.
4469 If some feature is actually applicable, the resulting glyphs are
4470 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4471 this case, the value is the number of produced glyphs.
4473 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4476 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4477 produced in GSTRING-OUT, and the value is nil.
4479 See the documentation of `composition-get-gstring' for the format of
4481 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4483 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4488 check_otf_features (otf_features
);
4489 CHECK_FONT_OBJECT (font_object
);
4490 font
= XFONT_OBJECT (font_object
);
4491 if (! font
->driver
->otf_drive
)
4492 error ("Font backend %s can't drive OpenType GSUB table",
4493 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4494 CHECK_CONS (otf_features
);
4495 CHECK_SYMBOL (XCAR (otf_features
));
4496 val
= XCDR (otf_features
);
4497 CHECK_SYMBOL (XCAR (val
));
4498 val
= XCDR (otf_features
);
4501 len
= check_gstring (gstring_in
);
4502 CHECK_VECTOR (gstring_out
);
4503 CHECK_NATNUM (from
);
4505 CHECK_NATNUM (index
);
4507 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4508 args_out_of_range_3 (from
, to
, make_number (len
));
4509 if (XINT (index
) >= ASIZE (gstring_out
))
4510 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4511 num
= font
->driver
->otf_drive (font
, otf_features
,
4512 gstring_in
, XINT (from
), XINT (to
),
4513 gstring_out
, XINT (index
), 0);
4516 return make_number (num
);
4519 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4521 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4522 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4524 (SCRIPT LANGSYS FEATURE ...)
4525 See the documentation of `font-drive-otf' for more detail.
4527 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4528 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4529 character code corresponding to the glyph or nil if there's no
4530 corresponding character. */)
4531 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4534 Lisp_Object gstring_in
, gstring_out
, g
;
4535 Lisp_Object alternates
;
4538 CHECK_FONT_GET_OBJECT (font_object
, font
);
4539 if (! font
->driver
->otf_drive
)
4540 error ("Font backend %s can't drive OpenType GSUB table",
4541 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4542 CHECK_CHARACTER (character
);
4543 CHECK_CONS (otf_features
);
4545 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4546 g
= LGSTRING_GLYPH (gstring_in
, 0);
4547 LGLYPH_SET_CHAR (g
, XINT (character
));
4548 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4549 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4550 gstring_out
, 0, 1)) < 0)
4551 gstring_out
= Ffont_make_gstring (font_object
,
4552 make_number (ASIZE (gstring_out
) * 2));
4554 for (i
= 0; i
< num
; i
++)
4556 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4557 int c
= LGLYPH_CHAR (g
);
4558 unsigned code
= LGLYPH_CODE (g
);
4560 alternates
= Fcons (Fcons (make_number (code
),
4561 c
> 0 ? make_number (c
) : Qnil
),
4564 return Fnreverse (alternates
);
4570 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4571 doc
: /* Open FONT-ENTITY. */)
4572 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4575 struct frame
*f
= decode_live_frame (frame
);
4577 CHECK_FONT_ENTITY (font_entity
);
4580 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4583 CHECK_NUMBER_OR_FLOAT (size
);
4585 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4587 isize
= XINT (size
);
4588 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4589 args_out_of_range (font_entity
, size
);
4593 return font_open_entity (f
, font_entity
, isize
);
4596 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4597 doc
: /* Close FONT-OBJECT. */)
4598 (Lisp_Object font_object
, Lisp_Object frame
)
4600 CHECK_FONT_OBJECT (font_object
);
4601 font_close_object (decode_live_frame (frame
), font_object
);
4605 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4606 doc
: /* Return information about FONT-OBJECT.
4607 The value is a vector:
4608 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4611 NAME is the font name, a string (or nil if the font backend doesn't
4614 FILENAME is the font file name, a string (or nil if the font backend
4615 doesn't provide a file name).
4617 PIXEL-SIZE is a pixel size by which the font is opened.
4619 SIZE is a maximum advance width of the font in pixels.
4621 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4624 CAPABILITY is a list whose first element is a symbol representing the
4625 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4626 remaining elements describe the details of the font capability.
4628 If the font is OpenType font, the form of the list is
4629 \(opentype GSUB GPOS)
4630 where GSUB shows which "GSUB" features the font supports, and GPOS
4631 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4632 lists of the format:
4633 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4635 If the font is not OpenType font, currently the length of the form is
4638 SCRIPT is a symbol representing OpenType script tag.
4640 LANGSYS is a symbol representing OpenType langsys tag, or nil
4641 representing the default langsys.
4643 FEATURE is a symbol representing OpenType feature tag.
4645 If the font is not OpenType font, CAPABILITY is nil. */)
4646 (Lisp_Object font_object
)
4651 CHECK_FONT_GET_OBJECT (font_object
, font
);
4653 val
= make_uninit_vector (9);
4654 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4655 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4656 ASET (val
, 2, make_number (font
->pixel_size
));
4657 ASET (val
, 3, make_number (font
->max_width
));
4658 ASET (val
, 4, make_number (font
->ascent
));
4659 ASET (val
, 5, make_number (font
->descent
));
4660 ASET (val
, 6, make_number (font
->space_width
));
4661 ASET (val
, 7, make_number (font
->average_width
));
4662 if (font
->driver
->otf_capability
)
4663 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4665 ASET (val
, 8, Qnil
);
4669 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4671 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4672 FROM and TO are positions (integers or markers) specifying a region
4673 of the current buffer.
4674 If the optional fourth arg OBJECT is not nil, it is a string or a
4675 vector containing the target characters.
4677 Each element is a vector containing information of a glyph in this format:
4678 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4680 FROM is an index numbers of a character the glyph corresponds to.
4681 TO is the same as FROM.
4682 C is the character of the glyph.
4683 CODE is the glyph-code of C in FONT-OBJECT.
4684 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4685 ADJUSTMENT is always nil.
4686 If FONT-OBJECT doesn't have a glyph for a character,
4687 the corresponding element is nil. */)
4688 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4693 Lisp_Object
*chars
, vec
;
4696 CHECK_FONT_GET_OBJECT (font_object
, font
);
4699 ptrdiff_t charpos
, bytepos
;
4701 validate_region (&from
, &to
);
4704 len
= XFASTINT (to
) - XFASTINT (from
);
4705 SAFE_ALLOCA_LISP (chars
, len
);
4706 charpos
= XFASTINT (from
);
4707 bytepos
= CHAR_TO_BYTE (charpos
);
4708 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4711 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4712 chars
[i
] = make_number (c
);
4715 else if (STRINGP (object
))
4717 const unsigned char *p
;
4719 CHECK_NUMBER (from
);
4721 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4722 || XINT (to
) > SCHARS (object
))
4723 args_out_of_range_3 (object
, from
, to
);
4726 len
= XFASTINT (to
) - XFASTINT (from
);
4727 SAFE_ALLOCA_LISP (chars
, len
);
4729 if (STRING_MULTIBYTE (object
))
4730 for (i
= 0; i
< len
; i
++)
4732 int c
= STRING_CHAR_ADVANCE (p
);
4733 chars
[i
] = make_number (c
);
4736 for (i
= 0; i
< len
; i
++)
4737 chars
[i
] = make_number (p
[i
]);
4741 CHECK_VECTOR (object
);
4742 CHECK_NUMBER (from
);
4744 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4745 || XINT (to
) > ASIZE (object
))
4746 args_out_of_range_3 (object
, from
, to
);
4749 len
= XFASTINT (to
) - XFASTINT (from
);
4750 for (i
= 0; i
< len
; i
++)
4752 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4753 CHECK_CHARACTER (elt
);
4755 chars
= aref_addr (object
, XFASTINT (from
));
4758 vec
= make_uninit_vector (len
);
4759 for (i
= 0; i
< len
; i
++)
4762 int c
= XFASTINT (chars
[i
]);
4764 struct font_metrics metrics
;
4766 code
= font
->driver
->encode_char (font
, c
);
4767 if (code
== FONT_INVALID_CODE
)
4769 ASET (vec
, i
, Qnil
);
4773 LGLYPH_SET_FROM (g
, i
);
4774 LGLYPH_SET_TO (g
, i
);
4775 LGLYPH_SET_CHAR (g
, c
);
4776 LGLYPH_SET_CODE (g
, code
);
4777 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4778 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4779 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4780 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4781 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4782 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4785 if (! VECTORP (object
))
4790 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4791 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4792 FONT is a font-spec, font-entity, or font-object. */)
4793 (Lisp_Object spec
, Lisp_Object font
)
4795 CHECK_FONT_SPEC (spec
);
4798 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4801 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4802 doc
: /* Return a font-object for displaying a character at POSITION.
4803 Optional second arg WINDOW, if non-nil, is a window displaying
4804 the current buffer. It defaults to the currently selected window.
4805 Optional third arg STRING, if non-nil, is a string containing the target
4806 character at index specified by POSITION. */)
4807 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4809 struct window
*w
= decode_live_window (window
);
4813 if (XBUFFER (w
->contents
) != current_buffer
)
4814 error ("Specified window is not displaying the current buffer");
4815 CHECK_NUMBER_COERCE_MARKER (position
);
4816 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4817 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4821 CHECK_NUMBER (position
);
4822 CHECK_STRING (string
);
4823 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4824 args_out_of_range (string
, position
);
4827 return font_at (-1, XINT (position
), NULL
, w
, string
);
4831 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4832 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4833 The value is a number of glyphs drawn.
4834 Type C-l to recover what previously shown. */)
4835 (Lisp_Object font_object
, Lisp_Object string
)
4837 Lisp_Object frame
= selected_frame
;
4838 struct frame
*f
= XFRAME (frame
);
4844 CHECK_FONT_GET_OBJECT (font_object
, font
);
4845 CHECK_STRING (string
);
4846 len
= SCHARS (string
);
4847 code
= alloca (sizeof (unsigned) * len
);
4848 for (i
= 0; i
< len
; i
++)
4850 Lisp_Object ch
= Faref (string
, make_number (i
));
4854 code
[i
] = font
->driver
->encode_char (font
, c
);
4855 if (code
[i
] == FONT_INVALID_CODE
)
4858 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4860 if (font
->driver
->prepare_face
)
4861 font
->driver
->prepare_face (f
, face
);
4862 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4863 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4864 if (font
->driver
->done_face
)
4865 font
->driver
->done_face (f
, face
);
4867 return make_number (len
);
4871 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4872 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4873 If FRAME is omitted or nil, use the selected frame. */)
4876 #ifdef HAVE_WINDOW_SYSTEM
4877 struct frame
*f
= decode_live_frame (frame
);
4879 if (FRAME_WINDOW_P (f
))
4880 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4886 #endif /* FONT_DEBUG */
4888 #ifdef HAVE_WINDOW_SYSTEM
4890 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4891 doc
: /* Return information about a font named NAME on frame FRAME.
4892 If FRAME is omitted or nil, use the selected frame.
4893 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4894 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4896 OPENED-NAME is the name used for opening the font,
4897 FULL-NAME is the full name of the font,
4898 SIZE is the pixelsize of the font,
4899 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4900 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4901 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4902 how to compose characters.
4903 If the named font is not yet loaded, return nil. */)
4904 (Lisp_Object name
, Lisp_Object frame
)
4909 Lisp_Object font_object
;
4912 CHECK_STRING (name
);
4913 f
= decode_window_system_frame (frame
);
4917 int fontset
= fs_query_fontset (name
, 0);
4920 name
= fontset_ascii (fontset
);
4921 font_object
= font_open_by_name (f
, name
);
4923 else if (FONT_OBJECT_P (name
))
4925 else if (FONT_ENTITY_P (name
))
4926 font_object
= font_open_entity (f
, name
, 0);
4929 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4930 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4932 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4934 if (NILP (font_object
))
4936 font
= XFONT_OBJECT (font_object
);
4938 info
= make_uninit_vector (7);
4939 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4940 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4941 ASET (info
, 2, make_number (font
->pixel_size
));
4942 ASET (info
, 3, make_number (font
->height
));
4943 ASET (info
, 4, make_number (font
->baseline_offset
));
4944 ASET (info
, 5, make_number (font
->relative_compose
));
4945 ASET (info
, 6, make_number (font
->default_ascent
));
4948 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4949 close it now. Perhaps, we should manage font-objects
4950 by `reference-count'. */
4951 font_close_object (f
, font_object
);
4958 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
4961 build_style_table (const struct table_entry
*entry
, int nelement
)
4964 Lisp_Object table
, elt
;
4966 table
= make_uninit_vector (nelement
);
4967 for (i
= 0; i
< nelement
; i
++)
4969 for (j
= 0; entry
[i
].names
[j
]; j
++);
4970 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4971 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4972 for (j
= 0; entry
[i
].names
[j
]; j
++)
4973 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4974 ASET (table
, i
, elt
);
4979 /* The deferred font-log data of the form [ACTION ARG RESULT].
4980 If ACTION is not nil, that is added to the log when font_add_log is
4981 called next time. At that time, ACTION is set back to nil. */
4982 static Lisp_Object Vfont_log_deferred
;
4984 /* Prepend the font-related logging data in Vfont_log if it is not
4985 `t'. ACTION describes a kind of font-related action (e.g. listing,
4986 opening), ARG is the argument for the action, and RESULT is the
4987 result of the action. */
4989 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4994 if (EQ (Vfont_log
, Qt
))
4996 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4998 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
5000 ASET (Vfont_log_deferred
, 0, Qnil
);
5001 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5002 AREF (Vfont_log_deferred
, 2));
5007 Lisp_Object tail
, elt
;
5008 Lisp_Object equalstr
= build_string ("=");
5010 val
= Ffont_xlfd_name (arg
, Qt
);
5011 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5015 if (EQ (XCAR (elt
), QCscript
)
5016 && SYMBOLP (XCDR (elt
)))
5017 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5018 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5019 else if (EQ (XCAR (elt
), QClang
)
5020 && SYMBOLP (XCDR (elt
)))
5021 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5022 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5023 else if (EQ (XCAR (elt
), QCotf
)
5024 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5025 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5027 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5033 && VECTORP (XCAR (result
))
5034 && ASIZE (XCAR (result
)) > 0
5035 && FONTP (AREF (XCAR (result
), 0)))
5036 result
= font_vconcat_entity_vectors (result
);
5039 val
= Ffont_xlfd_name (result
, Qt
);
5040 if (! FONT_SPEC_P (result
))
5041 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5042 build_string (":"), val
);
5045 else if (CONSP (result
))
5048 result
= Fcopy_sequence (result
);
5049 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5053 val
= Ffont_xlfd_name (val
, Qt
);
5054 XSETCAR (tail
, val
);
5057 else if (VECTORP (result
))
5059 result
= Fcopy_sequence (result
);
5060 for (i
= 0; i
< ASIZE (result
); i
++)
5062 val
= AREF (result
, i
);
5064 val
= Ffont_xlfd_name (val
, Qt
);
5065 ASET (result
, i
, val
);
5068 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5071 /* Record a font-related logging data to be added to Vfont_log when
5072 font_add_log is called next time. ACTION, ARG, RESULT are the same
5076 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5078 if (EQ (Vfont_log
, Qt
))
5080 ASET (Vfont_log_deferred
, 0, build_string (action
));
5081 ASET (Vfont_log_deferred
, 1, arg
);
5082 ASET (Vfont_log_deferred
, 2, result
);
5088 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5089 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5090 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5091 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5092 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5093 /* Note that the other elements in sort_shift_bits are not used. */
5095 staticpro (&font_charset_alist
);
5096 font_charset_alist
= Qnil
;
5098 DEFSYM (Qopentype
, "opentype");
5100 DEFSYM (Qascii_0
, "ascii-0");
5101 DEFSYM (Qiso8859_1
, "iso8859-1");
5102 DEFSYM (Qiso10646_1
, "iso10646-1");
5103 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5104 DEFSYM (Qunicode_sip
, "unicode-sip");
5108 DEFSYM (QCotf
, ":otf");
5109 DEFSYM (QClang
, ":lang");
5110 DEFSYM (QCscript
, ":script");
5111 DEFSYM (QCantialias
, ":antialias");
5113 DEFSYM (QCfoundry
, ":foundry");
5114 DEFSYM (QCadstyle
, ":adstyle");
5115 DEFSYM (QCregistry
, ":registry");
5116 DEFSYM (QCspacing
, ":spacing");
5117 DEFSYM (QCdpi
, ":dpi");
5118 DEFSYM (QCscalable
, ":scalable");
5119 DEFSYM (QCavgwidth
, ":avgwidth");
5120 DEFSYM (QCfont_entity
, ":font-entity");
5121 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5131 DEFSYM (QCuser_spec
, "user-spec");
5133 staticpro (&scratch_font_spec
);
5134 scratch_font_spec
= Ffont_spec (0, NULL
);
5135 staticpro (&scratch_font_prefer
);
5136 scratch_font_prefer
= Ffont_spec (0, NULL
);
5138 staticpro (&Vfont_log_deferred
);
5139 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5143 staticpro (&otf_list
);
5145 #endif /* HAVE_LIBOTF */
5149 defsubr (&Sfont_spec
);
5150 defsubr (&Sfont_get
);
5151 #ifdef HAVE_WINDOW_SYSTEM
5152 defsubr (&Sfont_face_attributes
);
5154 defsubr (&Sfont_put
);
5155 defsubr (&Slist_fonts
);
5156 defsubr (&Sfont_family_list
);
5157 defsubr (&Sfind_font
);
5158 defsubr (&Sfont_xlfd_name
);
5159 defsubr (&Sclear_font_cache
);
5160 defsubr (&Sfont_shape_gstring
);
5161 defsubr (&Sfont_variation_glyphs
);
5163 defsubr (&Sfont_drive_otf
);
5164 defsubr (&Sfont_otf_alternates
);
5168 defsubr (&Sopen_font
);
5169 defsubr (&Sclose_font
);
5170 defsubr (&Squery_font
);
5171 defsubr (&Sfont_get_glyphs
);
5172 defsubr (&Sfont_match_p
);
5173 defsubr (&Sfont_at
);
5175 defsubr (&Sdraw_string
);
5177 defsubr (&Sframe_font_cache
);
5178 #endif /* FONT_DEBUG */
5179 #ifdef HAVE_WINDOW_SYSTEM
5180 defsubr (&Sfont_info
);
5183 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5185 Alist of fontname patterns vs the corresponding encoding and repertory info.
5186 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5187 where ENCODING is a charset or a char-table,
5188 and REPERTORY is a charset, a char-table, or nil.
5190 If ENCODING and REPERTORY are the same, the element can have the form
5191 \(REGEXP . ENCODING).
5193 ENCODING is for converting a character to a glyph code of the font.
5194 If ENCODING is a charset, encoding a character by the charset gives
5195 the corresponding glyph code. If ENCODING is a char-table, looking up
5196 the table by a character gives the corresponding glyph code.
5198 REPERTORY specifies a repertory of characters supported by the font.
5199 If REPERTORY is a charset, all characters belonging to the charset are
5200 supported. If REPERTORY is a char-table, all characters who have a
5201 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5202 gets the repertory information by an opened font and ENCODING. */);
5203 Vfont_encoding_alist
= Qnil
;
5205 /* FIXME: These 3 vars are not quite what they appear: setq on them
5206 won't have any effect other than disconnect them from the style
5207 table used by the font display code. So we make them read-only,
5208 to avoid this confusing situation. */
5210 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5211 doc
: /* Vector of valid font weight values.
5212 Each element has the form:
5213 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5214 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5215 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5216 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5218 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5219 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5220 See `font-weight-table' for the format of the vector. */);
5221 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5222 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5224 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5225 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5226 See `font-weight-table' for the format of the vector. */);
5227 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5228 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5230 staticpro (&font_style_table
);
5231 font_style_table
= make_uninit_vector (3);
5232 ASET (font_style_table
, 0, Vfont_weight_table
);
5233 ASET (font_style_table
, 1, Vfont_slant_table
);
5234 ASET (font_style_table
, 2, Vfont_width_table
);
5236 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5237 *Logging list of font related actions and results.
5238 The value t means to suppress the logging.
5239 The initial value is set to nil if the environment variable
5240 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5243 #ifdef HAVE_WINDOW_SYSTEM
5244 #ifdef HAVE_FREETYPE
5246 #ifdef HAVE_X_WINDOWS
5251 #endif /* HAVE_XFT */
5252 #endif /* HAVE_X_WINDOWS */
5253 #else /* not HAVE_FREETYPE */
5254 #ifdef HAVE_X_WINDOWS
5256 #endif /* HAVE_X_WINDOWS */
5257 #endif /* not HAVE_FREETYPE */
5260 #endif /* HAVE_BDFFONT */
5263 #endif /* HAVE_NTGUI */
5264 #endif /* HAVE_WINDOW_SYSTEM */
5270 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;