1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2018 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 (at
13 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 <https://www.gnu.org/licenses/>. */
31 #include "character.h"
35 #include "dispextern.h"
37 #include "composite.h"
40 #include "termhooks.h"
42 #ifdef HAVE_WINDOW_SYSTEM
44 #endif /* HAVE_WINDOW_SYSTEM */
46 #define DEFAULT_ENCODING Qiso8859_1
48 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
49 static Lisp_Object font_style_table
;
51 /* Structure used for tables mapping weight, slant, and width numeric
52 values and their names. */
57 /* The first one is a valid name as a face attribute.
58 The second one (if any) is a typical name in XLFD field. */
62 /* Table of weight numeric values and their names. This table must be
63 sorted by numeric values in ascending order. */
65 static const struct table_entry weight_table
[] =
68 { 20, { "ultra-light", "ultralight" }},
69 { 40, { "extra-light", "extralight" }},
71 { 75, { "semi-light", "semilight", "demilight", "book" }},
72 { 100, { "normal", "medium", "regular", "unspecified" }},
73 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
75 { 205, { "extra-bold", "extrabold" }},
76 { 210, { "ultra-bold", "ultrabold", "black" }}
79 /* Table of slant numeric values and their names. This table must be
80 sorted by numeric values in ascending order. */
82 static const struct table_entry slant_table
[] =
84 { 0, { "reverse-oblique", "ro" }},
85 { 10, { "reverse-italic", "ri" }},
86 { 100, { "normal", "r", "unspecified" }},
87 { 200, { "italic" ,"i", "ot" }},
88 { 210, { "oblique", "o" }}
91 /* Table of width numeric values and their names. This table must be
92 sorted by numeric values in ascending order. */
94 static const struct table_entry width_table
[] =
96 { 50, { "ultra-condensed", "ultracondensed" }},
97 { 63, { "extra-condensed", "extracondensed" }},
98 { 75, { "condensed", "compressed", "narrow" }},
99 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
100 { 100, { "normal", "medium", "regular", "unspecified" }},
101 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
102 { 125, { "expanded" }},
103 { 150, { "extra-expanded", "extraexpanded" }},
104 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
107 /* Alist of font registry symbols and the corresponding charset
108 information. The information is retrieved from
109 Vfont_encoding_alist on demand.
111 Eash element has the form:
112 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
116 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
117 encodes a character code to a glyph code of a font, and
118 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
119 character is supported by a font.
121 The latter form means that the information for REGISTRY couldn't be
123 static Lisp_Object font_charset_alist
;
125 /* List of all font drivers. Each font-backend (XXXfont.c) calls
126 register_font_driver in syms_of_XXXfont to register its font-driver
128 static struct font_driver_list
*font_driver_list
;
130 #ifdef ENABLE_CHECKING
132 /* Used to catch bogus pointers in font objects. */
135 valid_font_driver (struct font_driver
const *drv
)
137 Lisp_Object tail
, frame
;
138 struct font_driver_list
*fdl
;
140 for (fdl
= font_driver_list
; fdl
; fdl
= fdl
->next
)
141 if (fdl
->driver
== drv
)
143 FOR_EACH_FRAME (tail
, frame
)
144 for (fdl
= XFRAME (frame
)->font_driver_list
; fdl
; fdl
= fdl
->next
)
145 if (fdl
->driver
== drv
)
150 #endif /* ENABLE_CHECKING */
152 /* Creators of font-related Lisp object. */
155 font_make_spec (void)
157 Lisp_Object font_spec
;
158 struct font_spec
*spec
159 = ((struct font_spec
*)
160 allocate_pseudovector (VECSIZE (struct font_spec
),
161 FONT_SPEC_MAX
, FONT_SPEC_MAX
, PVEC_FONT
));
162 XSETFONT (font_spec
, spec
);
167 font_make_entity (void)
169 Lisp_Object font_entity
;
170 struct font_entity
*entity
171 = ((struct font_entity
*)
172 allocate_pseudovector (VECSIZE (struct font_entity
),
173 FONT_ENTITY_MAX
, FONT_ENTITY_MAX
, PVEC_FONT
));
174 XSETFONT (font_entity
, entity
);
178 /* Create a font-object whose structure size is SIZE. If ENTITY is
179 not nil, copy properties from ENTITY to the font-object. If
180 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
182 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
184 Lisp_Object font_object
;
186 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
,
187 FONT_OBJECT_MAX
, PVEC_FONT
);
190 /* GC can happen before the driver is set up,
191 so avoid dangling pointer here (Bug#17771). */
193 XSETFONT (font_object
, font
);
197 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
198 font
->props
[i
] = AREF (entity
, i
);
199 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
200 font
->props
[FONT_EXTRA_INDEX
]
201 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
204 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
208 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
210 static int font_unparse_fcname (Lisp_Object
, int, char *, int);
212 /* Like above, but also set `type', `name' and `fullname' properties
216 font_build_object (int vectorsize
, Lisp_Object type
,
217 Lisp_Object entity
, double pixelsize
)
221 Lisp_Object font_object
= font_make_object (vectorsize
, entity
, pixelsize
);
223 ASET (font_object
, FONT_TYPE_INDEX
, type
);
224 len
= font_unparse_xlfd (entity
, pixelsize
, name
, sizeof name
);
226 ASET (font_object
, FONT_NAME_INDEX
, make_string (name
, len
));
227 len
= font_unparse_fcname (entity
, pixelsize
, name
, sizeof name
);
229 ASET (font_object
, FONT_FULLNAME_INDEX
, make_string (name
, len
));
231 ASET (font_object
, FONT_FULLNAME_INDEX
,
232 AREF (font_object
, FONT_NAME_INDEX
));
236 #endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */
238 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
239 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
240 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
242 static unsigned font_encode_char (Lisp_Object
, int);
244 /* Number of registered font drivers. */
245 static int num_font_drivers
;
248 /* Return a Lispy value of a font property value at STR and LEN bytes.
249 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
250 consist entirely of one or more digits, return a symbol interned
251 from STR. Otherwise, return an integer. */
254 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
256 ptrdiff_t i
, nbytes
, nchars
;
257 Lisp_Object tem
, name
, obarray
;
259 if (len
== 1 && *str
== '*')
261 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
263 for (i
= 1; i
< len
; i
++)
264 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
269 for (EMACS_INT n
= 0;
270 (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; )
273 return make_number (n
);
274 if (INT_MULTIPLY_WRAPV (n
, 10, &n
))
278 xsignal1 (Qoverflow_error
, make_string (str
, len
));
282 /* This code is similar to intern function from lread.c. */
283 obarray
= check_obarray (Vobarray
);
284 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
285 tem
= oblookup (obarray
, str
,
286 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
289 name
= make_specified_string (str
, nchars
, len
,
290 len
!= nchars
&& len
== nbytes
);
291 return intern_driver (name
, obarray
, tem
);
294 /* Return a pixel size of font-spec SPEC on frame F. */
297 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
299 #ifdef HAVE_WINDOW_SYSTEM
300 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
309 if (FRAME_WINDOW_P (f
))
311 eassert (FLOATP (size
));
312 point_size
= XFLOAT_DATA (size
);
313 val
= AREF (spec
, FONT_DPI_INDEX
);
317 dpi
= FRAME_RES_Y (f
);
318 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
326 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
327 font vector. If VAL is not valid (i.e. not registered in
328 font_style_table), return -1 if NOERROR is zero, and return a
329 proper index if NOERROR is nonzero. In that case, register VAL in
330 font_style_table if VAL is a symbol, and return the closest index if
331 VAL is an integer. */
334 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
337 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
340 CHECK_VECTOR (table
);
349 /* At first try exact match. */
350 for (i
= 0; i
< len
; i
++)
352 CHECK_VECTOR (AREF (table
, i
));
353 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
354 if (EQ (val
, AREF (AREF (table
, i
), j
)))
356 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
357 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
358 | (i
<< 4) | (j
- 1));
361 /* Try also with case-folding match. */
362 s
= SSDATA (SYMBOL_NAME (val
));
363 for (i
= 0; i
< len
; i
++)
364 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
366 elt
= AREF (AREF (table
, i
), j
);
367 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
369 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
370 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
371 | (i
<< 4) | (j
- 1));
377 elt
= Fmake_vector (make_number (2), make_number (100));
379 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
,
380 CALLN (Fvconcat
, table
, Fmake_vector (make_number (1), elt
)));
381 return (100 << 8) | (i
<< 4);
386 EMACS_INT numeric
= XINT (val
);
388 for (i
= 0, last_n
= -1; i
< len
; i
++)
392 CHECK_VECTOR (AREF (table
, i
));
393 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
394 n
= XINT (AREF (AREF (table
, i
), 0));
396 return (n
<< 8) | (i
<< 4);
401 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
402 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
408 return ((last_n
<< 8) | ((i
- 1) << 4));
413 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
416 Lisp_Object val
= AREF (font
, prop
);
417 Lisp_Object table
, elt
;
422 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
423 CHECK_VECTOR (table
);
424 i
= XINT (val
) & 0xFF;
425 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
426 elt
= AREF (table
, ((i
>> 4) & 0xF));
428 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
429 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
434 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
435 FONTNAME. ENCODING is a charset symbol that specifies the encoding
436 of the font. REPERTORY is a charset symbol or nil. */
439 find_font_encoding (Lisp_Object fontname
)
441 Lisp_Object tail
, elt
;
443 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
447 && STRINGP (XCAR (elt
))
448 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
449 && (SYMBOLP (XCDR (elt
))
450 ? CHARSETP (XCDR (elt
))
451 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
457 /* Return encoding charset and repertory charset for REGISTRY in
458 ENCODING and REPERTORY correspondingly. If correct information for
459 REGISTRY is available, return 0. Otherwise return -1. */
462 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
465 int encoding_id
, repertory_id
;
467 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
473 encoding_id
= XINT (XCAR (val
));
474 repertory_id
= XINT (XCDR (val
));
478 val
= find_font_encoding (SYMBOL_NAME (registry
));
479 if (SYMBOLP (val
) && CHARSETP (val
))
481 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
483 else if (CONSP (val
))
485 if (! CHARSETP (XCAR (val
)))
487 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
488 if (NILP (XCDR (val
)))
492 if (! CHARSETP (XCDR (val
)))
494 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
499 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
501 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
505 *encoding
= CHARSET_FROM_ID (encoding_id
);
507 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
512 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
517 /* Font property value validators. See the comment of
518 font_property_table for the meaning of the arguments. */
520 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
521 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
522 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
523 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
524 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
525 static int get_font_prop_index (Lisp_Object
);
528 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
531 val
= Fintern (val
, Qnil
);
534 else if (EQ (prop
, QCregistry
))
535 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
541 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
543 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
544 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
548 EMACS_INT n
= XINT (val
);
549 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
551 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
555 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
558 if ((n
& 0xF) + 1 >= ASIZE (elt
))
562 CHECK_NUMBER (AREF (elt
, 0));
563 if (XINT (AREF (elt
, 0)) != (n
>> 8))
568 else if (SYMBOLP (val
))
570 int n
= font_style_to_value (prop
, val
, 0);
572 val
= n
>= 0 ? make_number (n
) : Qerror
;
580 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
582 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
587 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
589 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
591 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
593 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
595 if (spacing
== 'c' || spacing
== 'C')
596 return make_number (FONT_SPACING_CHARCELL
);
597 if (spacing
== 'm' || spacing
== 'M')
598 return make_number (FONT_SPACING_MONO
);
599 if (spacing
== 'p' || spacing
== 'P')
600 return make_number (FONT_SPACING_PROPORTIONAL
);
601 if (spacing
== 'd' || spacing
== 'D')
602 return make_number (FONT_SPACING_DUAL
);
608 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
610 Lisp_Object tail
, tmp
;
613 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
614 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
615 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
618 if (! SYMBOLP (XCAR (val
)))
623 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
625 for (i
= 0; i
< 2; i
++)
632 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
633 if (! SYMBOLP (XCAR (tmp
)))
641 /* Structure of known font property keys and validator of the
645 /* Index of the key symbol. */
647 /* Function to validate PROP's value VAL, or NULL if any value is
648 ok. The value is VAL or its regularized value if VAL is valid,
649 and Qerror if not. */
650 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
651 } font_property_table
[] =
652 { { SYMBOL_INDEX (QCtype
), font_prop_validate_symbol
},
653 { SYMBOL_INDEX (QCfoundry
), font_prop_validate_symbol
},
654 { SYMBOL_INDEX (QCfamily
), font_prop_validate_symbol
},
655 { SYMBOL_INDEX (QCadstyle
), font_prop_validate_symbol
},
656 { SYMBOL_INDEX (QCregistry
), font_prop_validate_symbol
},
657 { SYMBOL_INDEX (QCweight
), font_prop_validate_style
},
658 { SYMBOL_INDEX (QCslant
), font_prop_validate_style
},
659 { SYMBOL_INDEX (QCwidth
), font_prop_validate_style
},
660 { SYMBOL_INDEX (QCsize
), font_prop_validate_non_neg
},
661 { SYMBOL_INDEX (QCdpi
), font_prop_validate_non_neg
},
662 { SYMBOL_INDEX (QCspacing
), font_prop_validate_spacing
},
663 { SYMBOL_INDEX (QCavgwidth
), font_prop_validate_non_neg
},
664 /* The order of the above entries must match with enum
665 font_property_index. */
666 { SYMBOL_INDEX (QClang
), font_prop_validate_symbol
},
667 { SYMBOL_INDEX (QCscript
), font_prop_validate_symbol
},
668 { SYMBOL_INDEX (QCotf
), font_prop_validate_otf
}
671 /* Return an index number of font property KEY or -1 if KEY is not an
672 already known property. */
675 get_font_prop_index (Lisp_Object key
)
679 for (i
= 0; i
< ARRAYELTS (font_property_table
); i
++)
680 if (EQ (key
, builtin_lisp_symbol (font_property_table
[i
].key
)))
685 /* Validate the font property. The property key is specified by the
686 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
687 signal an error. The value is VAL or the regularized one. */
690 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
692 Lisp_Object validated
;
697 prop
= builtin_lisp_symbol (font_property_table
[idx
].key
);
700 idx
= get_font_prop_index (prop
);
704 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
705 if (EQ (validated
, Qerror
))
706 signal_error ("invalid font property", Fcons (prop
, val
));
711 /* Store VAL as a value of extra font property PROP in FONT while
712 keeping the sorting order. Don't check the validity of VAL. */
715 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
717 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
718 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
722 Lisp_Object prev
= Qnil
;
725 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
726 prev
= extra
, extra
= XCDR (extra
);
729 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
731 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
737 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
742 /* Font name parser and unparser. */
744 static int parse_matrix (const char *);
745 static int font_expand_wildcards (Lisp_Object
*, int);
746 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
748 /* An enumerator for each field of an XLFD font name. */
749 enum xlfd_field_index
768 /* An enumerator for mask bit corresponding to each XLFD field. */
771 XLFD_FOUNDRY_MASK
= 0x0001,
772 XLFD_FAMILY_MASK
= 0x0002,
773 XLFD_WEIGHT_MASK
= 0x0004,
774 XLFD_SLANT_MASK
= 0x0008,
775 XLFD_SWIDTH_MASK
= 0x0010,
776 XLFD_ADSTYLE_MASK
= 0x0020,
777 XLFD_PIXEL_MASK
= 0x0040,
778 XLFD_POINT_MASK
= 0x0080,
779 XLFD_RESX_MASK
= 0x0100,
780 XLFD_RESY_MASK
= 0x0200,
781 XLFD_SPACING_MASK
= 0x0400,
782 XLFD_AVGWIDTH_MASK
= 0x0800,
783 XLFD_REGISTRY_MASK
= 0x1000,
784 XLFD_ENCODING_MASK
= 0x2000
788 /* Parse P pointing to the pixel/point size field of the form
789 `[A B C D]' which specifies a transformation matrix:
795 by which all glyphs of the font are transformed. The spec says
796 that scalar value N for the pixel/point size is equivalent to:
797 A = N * resx/resy, B = C = 0, D = N.
799 Return the scalar value N if the form is valid. Otherwise return
803 parse_matrix (const char *p
)
809 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
812 matrix
[i
] = - strtod (p
+ 1, &end
);
814 matrix
[i
] = strtod (p
, &end
);
817 return (i
== 4 ? (int) matrix
[3] : -1);
820 /* Expand a wildcard field in FIELD (the first N fields are filled) to
821 multiple fields to fill in all 14 XLFD fields while restricting a
822 field position by its contents. */
825 font_expand_wildcards (Lisp_Object
*field
, int n
)
828 Lisp_Object tmp
[XLFD_LAST_INDEX
];
829 /* Array of information about where this element can go. Nth
830 element is for Nth element of FIELD. */
832 /* Minimum possible field. */
834 /* Maximum possible field. */
836 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
838 } range
[XLFD_LAST_INDEX
];
840 int range_from
, range_to
;
843 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
844 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
845 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
846 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
847 | XLFD_AVGWIDTH_MASK)
848 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
850 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
851 field. The value is shifted to left one bit by one in the
853 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
854 range_mask
= (range_mask
<< 1) | 1;
856 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
857 position-based restriction for FIELD[I]. */
858 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
859 i
++, range_from
++, range_to
++, range_mask
<<= 1)
861 Lisp_Object val
= field
[i
];
867 range
[i
].from
= range_from
;
868 range
[i
].to
= range_to
;
869 range
[i
].mask
= range_mask
;
873 /* The triplet FROM, TO, and MASK is a value-based
874 restriction for FIELD[I]. */
880 EMACS_INT numeric
= XINT (val
);
883 from
= to
= XLFD_ENCODING_INDEX
,
884 mask
= XLFD_ENCODING_MASK
;
885 else if (numeric
== 0)
886 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
887 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
888 else if (numeric
<= 48)
889 from
= to
= XLFD_PIXEL_INDEX
,
890 mask
= XLFD_PIXEL_MASK
;
892 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
893 mask
= XLFD_LARGENUM_MASK
;
895 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
896 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
897 mask
= XLFD_NULL_MASK
;
899 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
902 Lisp_Object name
= SYMBOL_NAME (val
);
904 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
905 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
906 mask
= XLFD_REGENC_MASK
;
908 from
= to
= XLFD_ENCODING_INDEX
,
909 mask
= XLFD_ENCODING_MASK
;
911 else if (range_from
<= XLFD_WEIGHT_INDEX
912 && range_to
>= XLFD_WEIGHT_INDEX
913 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
914 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
915 else if (range_from
<= XLFD_SLANT_INDEX
916 && range_to
>= XLFD_SLANT_INDEX
917 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
918 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
919 else if (range_from
<= XLFD_SWIDTH_INDEX
920 && range_to
>= XLFD_SWIDTH_INDEX
921 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
922 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
925 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
926 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
928 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
929 mask
= XLFD_SYMBOL_MASK
;
932 /* Merge position-based and value-based restrictions. */
934 while (from
< range_from
)
935 mask
&= ~(1 << from
++);
936 while (from
< 14 && ! (mask
& (1 << from
)))
938 while (to
> range_to
)
939 mask
&= ~(1 << to
--);
940 while (to
>= 0 && ! (mask
& (1 << to
)))
944 range
[i
].from
= from
;
946 range
[i
].mask
= mask
;
948 if (from
> range_from
|| to
< range_to
)
950 /* The range is narrowed by value-based restrictions.
951 Reflect it to the other fields. */
953 /* Following fields should be after FROM. */
955 /* Preceding fields should be before TO. */
956 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
958 /* Check FROM for non-wildcard field. */
959 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
961 while (range
[j
].from
< from
)
962 range
[j
].mask
&= ~(1 << range
[j
].from
++);
963 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
965 range
[j
].from
= from
;
968 from
= range
[j
].from
;
969 if (range
[j
].to
> to
)
971 while (range
[j
].to
> to
)
972 range
[j
].mask
&= ~(1 << range
[j
].to
--);
973 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
986 /* Decide all fields from restrictions in RANGE. */
987 for (i
= j
= 0; i
< n
; i
++)
989 if (j
< range
[i
].from
)
991 if (i
== 0 || ! NILP (tmp
[i
- 1]))
992 /* None of TMP[X] corresponds to Jth field. */
994 memclear (field
+ j
, (range
[i
].from
- j
) * word_size
);
999 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1001 memclear (field
+ j
, (XLFD_LAST_INDEX
- j
) * word_size
);
1002 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1003 field
[XLFD_ENCODING_INDEX
]
1004 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1009 /* Parse NAME (null terminated) as XLFD and store information in FONT
1010 (font-spec or font-entity). Size property of FONT is set as
1012 specified XLFD fields FONT property
1013 --------------------- -------------
1014 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1015 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1016 POINT_SIZE POINT_SIZE/10 (Lisp float)
1018 If NAME is successfully parsed, return 0. Otherwise return -1.
1020 FONT is usually a font-spec, but when this function is called from
1021 X font backend driver, it is a font-entity. In that case, NAME is
1022 a fully specified XLFD. */
1025 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1028 char *f
[XLFD_LAST_INDEX
+ 1];
1032 if (len
> 255 || !len
)
1033 /* Maximum XLFD name length is 255. */
1035 /* Accept "*-.." as a fully specified XLFD. */
1036 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1037 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1040 for (p
= name
+ i
; *p
; p
++)
1044 if (i
== XLFD_LAST_INDEX
)
1049 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1050 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1052 if (i
== XLFD_LAST_INDEX
)
1054 /* Fully specified XLFD. */
1057 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1058 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1059 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1060 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1062 val
= INTERN_FIELD_SYM (i
);
1065 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1067 ASET (font
, j
, make_number (n
));
1070 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1071 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1072 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1074 ASET (font
, FONT_REGISTRY_INDEX
,
1075 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1076 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1078 p
= f
[XLFD_PIXEL_INDEX
];
1079 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1080 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1083 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1085 ASET (font
, FONT_SIZE_INDEX
, val
);
1086 else if (FONT_ENTITY_P (font
))
1090 double point_size
= -1;
1092 eassert (FONT_SPEC_P (font
));
1093 p
= f
[XLFD_POINT_INDEX
];
1095 point_size
= parse_matrix (p
);
1096 else if (c_isdigit (*p
))
1097 point_size
= atoi (p
), point_size
/= 10;
1098 if (point_size
>= 0)
1099 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1103 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1104 if (! NILP (val
) && ! INTEGERP (val
))
1106 ASET (font
, FONT_DPI_INDEX
, val
);
1107 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1110 val
= font_prop_validate_spacing (QCspacing
, val
);
1111 if (! INTEGERP (val
))
1113 ASET (font
, FONT_SPACING_INDEX
, val
);
1115 p
= f
[XLFD_AVGWIDTH_INDEX
];
1118 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1119 if (! NILP (val
) && ! INTEGERP (val
))
1121 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1125 bool wild_card_found
= 0;
1126 Lisp_Object prop
[XLFD_LAST_INDEX
];
1128 if (FONT_ENTITY_P (font
))
1130 for (j
= 0; j
< i
; j
++)
1134 if (f
[j
][1] && f
[j
][1] != '-')
1137 wild_card_found
= 1;
1140 prop
[j
] = INTERN_FIELD (j
);
1142 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1144 if (! wild_card_found
)
1146 if (font_expand_wildcards (prop
, i
) < 0)
1149 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1150 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1151 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1152 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1153 if (! NILP (prop
[i
]))
1155 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1157 ASET (font
, j
, make_number (n
));
1159 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1160 val
= prop
[XLFD_REGISTRY_INDEX
];
1163 val
= prop
[XLFD_ENCODING_INDEX
];
1166 AUTO_STRING (star_dash
, "*-");
1167 val
= concat2 (star_dash
, SYMBOL_NAME (val
));
1170 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1172 AUTO_STRING (dash_star
, "-*");
1173 val
= concat2 (SYMBOL_NAME (val
), dash_star
);
1177 AUTO_STRING (dash
, "-");
1178 val
= concat3 (SYMBOL_NAME (val
), dash
,
1179 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1182 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1184 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1185 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1186 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1188 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1190 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1193 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1194 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1195 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1197 val
= font_prop_validate_spacing (QCspacing
,
1198 prop
[XLFD_SPACING_INDEX
]);
1199 if (! INTEGERP (val
))
1201 ASET (font
, FONT_SPACING_INDEX
, val
);
1203 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1204 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1210 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1211 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1212 0, use PIXEL_SIZE instead. */
1215 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1218 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1222 eassert (FONTP (font
));
1224 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1227 if (i
== FONT_ADSTYLE_INDEX
)
1228 j
= XLFD_ADSTYLE_INDEX
;
1229 else if (i
== FONT_REGISTRY_INDEX
)
1230 j
= XLFD_REGISTRY_INDEX
;
1231 val
= AREF (font
, i
);
1234 if (j
== XLFD_REGISTRY_INDEX
)
1242 val
= SYMBOL_NAME (val
);
1243 if (j
== XLFD_REGISTRY_INDEX
1244 && ! strchr (SSDATA (val
), '-'))
1246 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1247 ptrdiff_t alloc
= SBYTES (val
) + 4;
1248 if (nbytes
<= alloc
)
1250 f
[j
] = p
= alloca (alloc
);
1251 sprintf (p
, "%s%s-*", SDATA (val
),
1252 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1255 f
[j
] = SSDATA (val
);
1259 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1262 val
= font_style_symbolic (font
, i
, 0);
1270 val
= SYMBOL_NAME (val
);
1271 alloc
= SBYTES (val
) + 1;
1272 if (nbytes
<= alloc
)
1274 f
[j
] = p
= alloca (alloc
);
1275 /* Copy the name while excluding '-', '?', ',', and '"'. */
1276 for (k
= l
= 0; k
< alloc
; k
++)
1279 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1285 val
= AREF (font
, FONT_SIZE_INDEX
);
1286 eassert (NUMBERP (val
) || NILP (val
));
1287 char font_size_index_buf
[sizeof "-*"
1288 + max (INT_STRLEN_BOUND (EMACS_INT
),
1289 1 + DBL_MAX_10_EXP
+ 1)];
1292 EMACS_INT v
= XINT (val
);
1297 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1298 sprintf (p
, "%"pI
"d-*", v
);
1301 f
[XLFD_PIXEL_INDEX
] = "*-*";
1303 else if (FLOATP (val
))
1305 double v
= XFLOAT_DATA (val
) * 10;
1306 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1307 sprintf (p
, "*-%.0f", v
);
1310 f
[XLFD_PIXEL_INDEX
] = "*-*";
1312 char dpi_index_buf
[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
)];
1313 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1315 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1316 f
[XLFD_RESX_INDEX
] = p
= dpi_index_buf
;
1317 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1320 f
[XLFD_RESX_INDEX
] = "*-*";
1322 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1324 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1326 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1327 : spacing
<= FONT_SPACING_DUAL
? "d"
1328 : spacing
<= FONT_SPACING_MONO
? "m"
1332 f
[XLFD_SPACING_INDEX
] = "*";
1334 char avgwidth_index_buf
[INT_BUFSIZE_BOUND (EMACS_INT
)];
1335 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1337 f
[XLFD_AVGWIDTH_INDEX
] = p
= avgwidth_index_buf
;
1338 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1341 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1343 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1344 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1345 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1346 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1347 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1348 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1349 f
[XLFD_REGISTRY_INDEX
]);
1350 return len
< nbytes
? len
: -1;
1353 /* Parse NAME (null terminated) and store information in FONT
1354 (font-spec or font-entity). NAME is supplied in either the
1355 Fontconfig or GTK font name format. If NAME is successfully
1356 parsed, return 0. Otherwise return -1.
1358 The fontconfig format is
1360 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1364 FAMILY [PROPS...] [SIZE]
1366 This function tries to guess which format it is. */
1369 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1372 char *size_beg
= NULL
, *size_end
= NULL
;
1373 char *props_beg
= NULL
, *family_end
= NULL
;
1378 for (p
= name
; *p
; p
++)
1380 if (*p
== '\\' && p
[1])
1384 props_beg
= family_end
= p
;
1389 bool decimal
= 0, size_found
= 1;
1390 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1391 if (! c_isdigit (*q
))
1393 if (*q
!= '.' || decimal
)
1412 Lisp_Object extra_props
= Qnil
;
1414 /* A fontconfig name with size and/or property data. */
1415 if (family_end
> name
)
1418 family
= font_intern_prop (name
, family_end
- name
, 1);
1419 ASET (font
, FONT_FAMILY_INDEX
, family
);
1423 double point_size
= strtod (size_beg
, &size_end
);
1424 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1425 if (*size_end
== ':' && size_end
[1])
1426 props_beg
= size_end
;
1430 /* Now parse ":KEY=VAL" patterns. */
1433 for (p
= props_beg
; *p
; p
= q
)
1435 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1438 /* Must be an enumerated value. */
1442 val
= font_intern_prop (p
, q
- p
, 1);
1444 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1445 && memcmp (p, STR, strlen (STR)) == 0)
1447 if (PROP_MATCH ("light")
1448 || PROP_MATCH ("medium")
1449 || PROP_MATCH ("demibold")
1450 || PROP_MATCH ("bold")
1451 || PROP_MATCH ("black"))
1452 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1453 else if (PROP_MATCH ("roman")
1454 || PROP_MATCH ("italic")
1455 || PROP_MATCH ("oblique"))
1456 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1457 else if (PROP_MATCH ("charcell"))
1458 ASET (font
, FONT_SPACING_INDEX
,
1459 make_number (FONT_SPACING_CHARCELL
));
1460 else if (PROP_MATCH ("mono"))
1461 ASET (font
, FONT_SPACING_INDEX
,
1462 make_number (FONT_SPACING_MONO
));
1463 else if (PROP_MATCH ("proportional"))
1464 ASET (font
, FONT_SPACING_INDEX
,
1465 make_number (FONT_SPACING_PROPORTIONAL
));
1474 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1475 prop
= FONT_SIZE_INDEX
;
1478 key
= font_intern_prop (p
, q
- p
, 1);
1479 prop
= get_font_prop_index (key
);
1483 for (q
= p
; *q
&& *q
!= ':'; q
++);
1484 val
= font_intern_prop (p
, q
- p
, 0);
1486 if (prop
>= FONT_FOUNDRY_INDEX
1487 && prop
< FONT_EXTRA_INDEX
)
1488 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1491 extra_props
= nconc2 (extra_props
,
1492 list1 (Fcons (key
, val
)));
1499 if (! NILP (extra_props
))
1501 struct font_driver_list
*driver_list
= font_driver_list
;
1502 for ( ; driver_list
; driver_list
= driver_list
->next
)
1503 if (driver_list
->driver
->filter_properties
)
1504 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1510 /* Either a fontconfig-style name with no size and property
1511 data, or a GTK-style name. */
1512 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1513 Lisp_Object width
= Qnil
, size
= Qnil
;
1517 /* Scan backwards from the end, looking for a size. */
1518 for (p
= name
+ len
- 1; p
>= name
; p
--)
1519 if (!c_isdigit (*p
))
1522 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1523 /* Found a font size. */
1524 size
= make_float (strtod (p
+ 1, NULL
));
1528 /* Now P points to the termination of the string, sans size.
1529 Scan backwards, looking for font properties. */
1530 for (; p
> name
; p
= q
)
1532 for (q
= p
- 1; q
>= name
; q
--)
1534 if (q
> name
&& *(q
-1) == '\\')
1535 --q
; /* Skip quoting backslashes. */
1541 word_len
= p
- word_start
;
1543 #define PROP_MATCH(STR) \
1544 (word_len == strlen (STR) \
1545 && memcmp (word_start, STR, strlen (STR)) == 0)
1546 #define PROP_SAVE(VAR, STR) \
1547 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1549 if (PROP_MATCH ("Ultra-Light"))
1550 PROP_SAVE (weight
, "ultra-light");
1551 else if (PROP_MATCH ("Light"))
1552 PROP_SAVE (weight
, "light");
1553 else if (PROP_MATCH ("Book"))
1554 PROP_SAVE (weight
, "book");
1555 else if (PROP_MATCH ("Medium"))
1556 PROP_SAVE (weight
, "medium");
1557 else if (PROP_MATCH ("Semi-Bold"))
1558 PROP_SAVE (weight
, "semi-bold");
1559 else if (PROP_MATCH ("Bold"))
1560 PROP_SAVE (weight
, "bold");
1561 else if (PROP_MATCH ("Italic"))
1562 PROP_SAVE (slant
, "italic");
1563 else if (PROP_MATCH ("Oblique"))
1564 PROP_SAVE (slant
, "oblique");
1565 else if (PROP_MATCH ("Semi-Condensed"))
1566 PROP_SAVE (width
, "semi-condensed");
1567 else if (PROP_MATCH ("Condensed"))
1568 PROP_SAVE (width
, "condensed");
1569 /* An unknown word must be part of the font name. */
1580 ASET (font
, FONT_FAMILY_INDEX
,
1581 font_intern_prop (name
, family_end
- name
, 1));
1583 ASET (font
, FONT_SIZE_INDEX
, size
);
1585 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1587 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1589 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1595 #if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
1597 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1598 NAME (NBYTES length), and return the name length. If
1599 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
1600 Return a negative value on error. */
1603 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1605 Lisp_Object family
, foundry
;
1611 Lisp_Object styles
[3];
1612 const char *style_names
[3] = { "weight", "slant", "width" };
1614 family
= AREF (font
, FONT_FAMILY_INDEX
);
1615 if (! NILP (family
))
1617 if (SYMBOLP (family
))
1618 family
= SYMBOL_NAME (family
);
1623 val
= AREF (font
, FONT_SIZE_INDEX
);
1626 if (XINT (val
) != 0)
1627 pixel_size
= XINT (val
);
1632 eassert (FLOATP (val
));
1634 point_size
= (int) XFLOAT_DATA (val
);
1637 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1638 if (! NILP (foundry
))
1640 if (SYMBOLP (foundry
))
1641 foundry
= SYMBOL_NAME (foundry
);
1646 for (i
= 0; i
< 3; i
++)
1647 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1650 lim
= name
+ nbytes
;
1651 if (! NILP (family
))
1653 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1654 if (! (0 <= len
&& len
< lim
- p
))
1660 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1661 if (! (0 <= len
&& len
< lim
- p
))
1665 else if (pixel_size
> 0)
1667 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1668 if (! (0 <= len
&& len
< lim
- p
))
1672 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1674 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1675 SSDATA (SYMBOL_NAME (AREF (font
,
1676 FONT_FOUNDRY_INDEX
))));
1677 if (! (0 <= len
&& len
< lim
- p
))
1681 for (i
= 0; i
< 3; i
++)
1682 if (! NILP (styles
[i
]))
1684 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1685 SSDATA (SYMBOL_NAME (styles
[i
])));
1686 if (! (0 <= len
&& len
< lim
- p
))
1691 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1693 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1694 XINT (AREF (font
, FONT_DPI_INDEX
)));
1695 if (! (0 <= len
&& len
< lim
- p
))
1700 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1702 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1703 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1704 if (! (0 <= len
&& len
< lim
- p
))
1709 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1711 int len
= snprintf (p
, lim
- p
,
1712 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1714 : ":scalable=false"));
1715 if (! (0 <= len
&& len
< lim
- p
))
1725 /* Parse NAME (null terminated) and store information in FONT
1726 (font-spec or font-entity). If NAME is successfully parsed, return
1727 0. Otherwise return -1. */
1730 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1732 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1733 return font_parse_xlfd (name
, namelen
, font
);
1734 return font_parse_fcname (name
, namelen
, font
);
1738 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1739 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1743 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1749 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1751 CHECK_STRING (family
);
1752 len
= SBYTES (family
);
1753 p0
= SSDATA (family
);
1754 p1
= strchr (p0
, '-');
1757 if ((*p0
!= '*' && p1
- p0
> 0)
1758 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1759 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1762 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1765 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1767 if (! NILP (registry
))
1769 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1770 CHECK_STRING (registry
);
1771 len
= SBYTES (registry
);
1772 p0
= SSDATA (registry
);
1773 p1
= strchr (p0
, '-');
1776 bool asterisk
= len
&& p0
[len
- 1] == '*';
1777 AUTO_STRING_WITH_LEN (extra
, &"*-*"[asterisk
], 3 - asterisk
);
1778 registry
= concat2 (registry
, extra
);
1780 registry
= Fdowncase (registry
);
1781 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1786 /* This part (through the next ^L) is still experimental and not
1787 tested much. We may drastically change codes. */
1793 #define LGSTRING_HEADER_SIZE 6
1794 #define LGSTRING_GLYPH_SIZE 8
1797 check_gstring (Lisp_Object gstring
)
1803 CHECK_VECTOR (gstring
);
1804 val
= AREF (gstring
, 0);
1806 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1808 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1809 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1810 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1811 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1812 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1813 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1814 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1815 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1816 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1817 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1818 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1820 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1822 val
= LGSTRING_GLYPH (gstring
, i
);
1824 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1826 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1828 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1829 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1830 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1831 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1832 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1833 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1834 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1835 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1837 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1839 if (ASIZE (val
) < 3)
1841 for (j
= 0; j
< 3; j
++)
1842 CHECK_NUMBER (AREF (val
, j
));
1847 error ("Invalid glyph-string format");
1852 check_otf_features (Lisp_Object otf_features
)
1856 CHECK_CONS (otf_features
);
1857 CHECK_SYMBOL (XCAR (otf_features
));
1858 otf_features
= XCDR (otf_features
);
1859 CHECK_CONS (otf_features
);
1860 CHECK_SYMBOL (XCAR (otf_features
));
1861 otf_features
= XCDR (otf_features
);
1862 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1864 CHECK_SYMBOL (XCAR (val
));
1865 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1866 error ("Invalid OTF GSUB feature: %s",
1867 SDATA (SYMBOL_NAME (XCAR (val
))));
1869 otf_features
= XCDR (otf_features
);
1870 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1872 CHECK_SYMBOL (XCAR (val
));
1873 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1874 error ("Invalid OTF GPOS feature: %s",
1875 SDATA (SYMBOL_NAME (XCAR (val
))));
1882 Lisp_Object otf_list
;
1885 otf_tag_symbol (OTF_Tag tag
)
1889 OTF_tag_name (tag
, name
);
1890 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1894 otf_open (Lisp_Object file
)
1896 Lisp_Object val
= Fassoc (file
, otf_list
, Qnil
);
1900 otf
= XSAVE_POINTER (XCDR (val
), 0);
1903 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1904 val
= make_save_ptr (otf
);
1905 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1911 /* Return a list describing which scripts/languages FONT supports by
1912 which GSUB/GPOS features of OpenType tables. See the comment of
1913 (struct font_driver).otf_capability. */
1916 font_otf_capability (struct font
*font
)
1919 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1922 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1925 for (i
= 0; i
< 2; i
++)
1927 OTF_GSUB_GPOS
*gsub_gpos
;
1928 Lisp_Object script_list
= Qnil
;
1931 if (OTF_get_features (otf
, i
== 0) < 0)
1933 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1934 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1936 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1937 Lisp_Object langsys_list
= Qnil
;
1938 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1941 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1943 OTF_LangSys
*langsys
;
1944 Lisp_Object feature_list
= Qnil
;
1945 Lisp_Object langsys_tag
;
1948 if (k
== script
->LangSysCount
)
1950 langsys
= &script
->DefaultLangSys
;
1955 langsys
= script
->LangSys
+ k
;
1957 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1959 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1961 OTF_Feature
*feature
1962 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1963 Lisp_Object feature_tag
1964 = otf_tag_symbol (feature
->FeatureTag
);
1966 feature_list
= Fcons (feature_tag
, feature_list
);
1968 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1971 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1976 XSETCAR (capability
, script_list
);
1978 XSETCDR (capability
, script_list
);
1984 /* Parse OTF features in SPEC and write a proper features spec string
1985 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1986 assured that the sufficient memory has already allocated for
1990 generate_otf_features (Lisp_Object spec
, char *features
)
1998 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2004 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2009 else if (! asterisk
)
2011 val
= SYMBOL_NAME (val
);
2012 p
+= esprintf (p
, "%s", SDATA (val
));
2016 val
= SYMBOL_NAME (val
);
2017 p
+= esprintf (p
, "~%s", SDATA (val
));
2021 error ("OTF spec too long");
2025 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
2027 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2029 return Fcons (make_number (len
),
2030 make_unibyte_string (device_table
->DeltaValue
, len
));
2034 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2036 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2038 if (value_format
& OTF_XPlacement
)
2039 ASET (val
, 0, make_number (value_record
->XPlacement
));
2040 if (value_format
& OTF_YPlacement
)
2041 ASET (val
, 1, make_number (value_record
->YPlacement
));
2042 if (value_format
& OTF_XAdvance
)
2043 ASET (val
, 2, make_number (value_record
->XAdvance
));
2044 if (value_format
& OTF_YAdvance
)
2045 ASET (val
, 3, make_number (value_record
->YAdvance
));
2046 if (value_format
& OTF_XPlaDevice
)
2047 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2048 if (value_format
& OTF_YPlaDevice
)
2049 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2050 if (value_format
& OTF_XAdvDevice
)
2051 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2052 if (value_format
& OTF_YAdvDevice
)
2053 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2058 font_otf_Anchor (OTF_Anchor
*anchor
)
2062 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2063 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2064 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2065 if (anchor
->AnchorFormat
== 2)
2066 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2069 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2070 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2074 #endif /* HAVE_LIBOTF */
2081 font_rescale_ratio (Lisp_Object font_entity
)
2083 Lisp_Object tail
, elt
;
2084 Lisp_Object name
= Qnil
;
2086 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2089 if (FLOATP (XCDR (elt
)))
2091 if (STRINGP (XCAR (elt
)))
2094 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2095 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2096 return XFLOAT_DATA (XCDR (elt
));
2098 else if (FONT_SPEC_P (XCAR (elt
)))
2100 if (font_match_p (XCAR (elt
), font_entity
))
2101 return XFLOAT_DATA (XCDR (elt
));
2108 /* We sort fonts by scoring each of them against a specified
2109 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2110 the value is, the closer the font is to the font-spec.
2112 The lowest 2 bits of the score are used for driver type. The font
2113 available by the most preferred font driver is 0.
2115 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2116 WEIGHT, SLANT, WIDTH, and SIZE. */
2118 /* How many bits to shift to store the difference value of each font
2119 property in a score. Note that floats for FONT_TYPE_INDEX and
2120 FONT_REGISTRY_INDEX are not used. */
2121 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2123 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2124 The return value indicates how different ENTITY is compared with
2128 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2133 /* Score three style numeric fields. Maximum difference is 127. */
2134 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2135 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2137 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2138 - (XINT (spec_prop
[i
]) >> 8));
2139 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2142 /* Score the size. Maximum difference is 127. */
2143 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2144 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2146 /* We use the higher 6-bit for the actual size difference. The
2147 lowest bit is set if the DPI is different. */
2149 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2150 EMACS_INT entity_size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
2152 if (CONSP (Vface_font_rescale_alist
))
2153 pixel_size
*= font_rescale_ratio (entity
);
2154 if (pixel_size
* 2 < entity_size
|| entity_size
* 2 < pixel_size
)
2155 /* This size is wrong by more than a factor 2: reject it! */
2157 diff
= eabs (pixel_size
- entity_size
) << 1;
2158 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2159 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2161 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2162 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2164 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2171 /* Concatenate all elements of LIST into one vector. LIST is a list
2172 of font-entity vectors. */
2175 font_vconcat_entity_vectors (Lisp_Object list
)
2177 EMACS_INT nargs
= XFASTINT (Flength (list
));
2180 SAFE_ALLOCA_LISP (args
, nargs
);
2183 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2184 args
[i
] = XCAR (list
);
2185 Lisp_Object result
= Fvconcat (nargs
, args
);
2191 /* The structure for elements being sorted by qsort. */
2192 struct font_sort_data
2195 int font_driver_preference
;
2200 /* The comparison function for qsort. */
2203 font_compare (const void *d1
, const void *d2
)
2205 const struct font_sort_data
*data1
= d1
;
2206 const struct font_sort_data
*data2
= d2
;
2208 if (data1
->score
< data2
->score
)
2210 else if (data1
->score
> data2
->score
)
2212 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2216 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2217 If PREFER specifies a point-size, calculate the corresponding
2218 pixel-size from QCdpi property of PREFER or from the Y-resolution
2219 of FRAME before sorting.
2221 If BEST-ONLY is nonzero, return the best matching entity (that
2222 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2223 if BEST-ONLY is negative). Otherwise, return the sorted result as
2224 a single vector of font-entities.
2226 This function does no optimization for the case that the total
2227 number of elements is 1. The caller should avoid calling this in
2231 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2232 struct frame
*f
, int best_only
)
2234 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2236 struct font_sort_data
*data
;
2237 unsigned best_score
;
2238 Lisp_Object best_entity
;
2240 Lisp_Object vec UNINIT
;
2243 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2244 prefer_prop
[i
] = AREF (prefer
, i
);
2245 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2246 prefer_prop
[FONT_SIZE_INDEX
]
2247 = make_number (font_pixel_size (f
, prefer
));
2249 if (NILP (XCDR (list
)))
2251 /* What we have to take care of is this single vector. */
2253 maxlen
= ASIZE (vec
);
2257 /* We don't have to perform sort, so there's no need of creating
2258 a single vector. But, we must find the length of the longest
2261 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2262 if (maxlen
< ASIZE (XCAR (tail
)))
2263 maxlen
= ASIZE (XCAR (tail
));
2267 /* We have to create a single vector to sort it. */
2268 vec
= font_vconcat_entity_vectors (list
);
2269 maxlen
= ASIZE (vec
);
2272 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2273 best_score
= 0xFFFFFFFF;
2276 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2278 int font_driver_preference
= 0;
2279 Lisp_Object current_font_driver
;
2285 /* We are sure that the length of VEC > 0. */
2286 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2287 /* Score the elements. */
2288 for (i
= 0; i
< len
; i
++)
2290 data
[i
].entity
= AREF (vec
, i
);
2292 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2294 ? font_score (data
[i
].entity
, prefer_prop
)
2296 if (best_only
&& best_score
> data
[i
].score
)
2298 best_score
= data
[i
].score
;
2299 best_entity
= data
[i
].entity
;
2300 if (best_score
== 0)
2303 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2305 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2306 font_driver_preference
++;
2308 data
[i
].font_driver_preference
= font_driver_preference
;
2311 /* Sort if necessary. */
2314 qsort (data
, len
, sizeof *data
, font_compare
);
2315 for (i
= 0; i
< len
; i
++)
2316 ASET (vec
, i
, data
[i
].entity
);
2325 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2330 /* API of Font Service Layer. */
2332 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2333 sort_shift_bits. Finternal_set_font_selection_order calls this
2334 function with font_sort_order after setting up it. */
2337 font_update_sort_order (int *order
)
2341 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2343 int xlfd_idx
= order
[i
];
2345 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2346 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2347 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2348 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2349 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2350 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2352 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2357 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2358 Lisp_Object features
, Lisp_Object table
)
2363 table
= assq_no_quit (script
, table
);
2366 table
= XCDR (table
);
2367 if (! NILP (langsys
))
2369 table
= assq_no_quit (langsys
, table
);
2375 val
= assq_no_quit (Qnil
, table
);
2377 table
= XCAR (table
);
2381 table
= XCDR (table
);
2382 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2384 if (NILP (XCAR (features
)))
2389 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2395 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2398 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2400 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2402 script
= XCAR (spec
);
2406 langsys
= XCAR (spec
);
2417 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2418 XCAR (otf_capability
)))
2420 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2421 XCDR (otf_capability
)))
2428 /* Check if FONT (font-entity or font-object) matches with the font
2429 specification SPEC. */
2432 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2434 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2435 Lisp_Object extra
, font_extra
;
2438 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2439 if (! NILP (AREF (spec
, i
))
2440 && ! NILP (AREF (font
, i
))
2441 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2443 props
= XFONT_SPEC (spec
)->props
;
2444 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2446 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2447 prop
[i
] = AREF (spec
, i
);
2448 prop
[FONT_SIZE_INDEX
]
2449 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2453 if (font_score (font
, props
) > 0)
2455 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2456 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2457 for (; CONSP (extra
); extra
= XCDR (extra
))
2459 Lisp_Object key
= XCAR (XCAR (extra
));
2460 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2462 if (EQ (key
, QClang
))
2464 val2
= assq_no_quit (key
, font_extra
);
2473 if (NILP (Fmemq (val
, val2
)))
2478 ? NILP (Fmemq (val
, XCDR (val2
)))
2482 else if (EQ (key
, QCscript
))
2484 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2490 /* All characters in the list must be supported. */
2491 for (; CONSP (val2
); val2
= XCDR (val2
))
2493 if (! CHARACTERP (XCAR (val2
)))
2495 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2496 == FONT_INVALID_CODE
)
2500 else if (VECTORP (val2
))
2502 /* At most one character in the vector must be supported. */
2503 for (i
= 0; i
< ASIZE (val2
); i
++)
2505 if (! CHARACTERP (AREF (val2
, i
)))
2507 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2508 != FONT_INVALID_CODE
)
2511 if (i
== ASIZE (val2
))
2516 else if (EQ (key
, QCotf
))
2520 if (! FONT_OBJECT_P (font
))
2522 fontp
= XFONT_OBJECT (font
);
2523 if (! fontp
->driver
->otf_capability
)
2525 val2
= fontp
->driver
->otf_capability (fontp
);
2526 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2537 Each font backend has the callback function get_cache, and it
2538 returns a cons cell of which cdr part can be freely used for
2539 caching fonts. The cons cell may be shared by multiple frames
2540 and/or multiple font drivers. So, we arrange the cdr part as this:
2542 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2544 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2545 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2546 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2548 static void font_clear_cache (struct frame
*, Lisp_Object
,
2549 struct font_driver
const *);
2552 font_prepare_cache (struct frame
*f
, struct font_driver
const *driver
)
2554 Lisp_Object cache
, val
;
2556 cache
= driver
->get_cache (f
);
2558 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2562 val
= list2 (driver
->type
, make_number (1));
2563 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2567 val
= XCDR (XCAR (val
));
2568 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2574 font_finish_cache (struct frame
*f
, struct font_driver
const *driver
)
2576 Lisp_Object cache
, val
, tmp
;
2579 cache
= driver
->get_cache (f
);
2581 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2582 cache
= val
, val
= XCDR (val
);
2583 eassert (! NILP (val
));
2584 tmp
= XCDR (XCAR (val
));
2585 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2586 if (XINT (XCAR (tmp
)) == 0)
2588 font_clear_cache (f
, XCAR (val
), driver
);
2589 XSETCDR (cache
, XCDR (val
));
2595 font_get_cache (struct frame
*f
, struct font_driver
const *driver
)
2597 Lisp_Object val
= driver
->get_cache (f
);
2598 Lisp_Object type
= driver
->type
;
2600 eassert (CONSP (val
));
2601 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2602 eassert (CONSP (val
));
2603 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2604 val
= XCDR (XCAR (val
));
2610 font_clear_cache (struct frame
*f
, Lisp_Object cache
,
2611 struct font_driver
const *driver
)
2613 Lisp_Object tail
, elt
;
2617 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2618 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2621 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2622 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2625 eassert (VECTORP (elt
));
2626 for (i
= 0; i
< ASIZE (elt
); i
++)
2628 entity
= AREF (elt
, i
);
2630 if (FONT_ENTITY_P (entity
)
2631 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2633 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2635 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2637 Lisp_Object val
= XCAR (objlist
);
2638 struct font
*font
= XFONT_OBJECT (val
);
2640 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2642 eassert (font
&& driver
== font
->driver
);
2643 driver
->close (font
);
2646 if (driver
->free_entity
)
2647 driver
->free_entity (entity
);
2652 XSETCDR (cache
, Qnil
);
2656 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2658 /* Check each font-entity in VEC, and return a list of font-entities
2659 that satisfy these conditions:
2660 (1) matches with SPEC and SIZE if SPEC is not nil, and
2661 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2665 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2667 Lisp_Object entity
, val
;
2668 enum font_property_index prop
;
2671 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2673 entity
= AREF (vec
, i
);
2674 if (! NILP (Vface_ignored_fonts
))
2678 Lisp_Object tail
, regexp
;
2680 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2683 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2685 regexp
= XCAR (tail
);
2686 if (STRINGP (regexp
)
2687 && fast_c_string_match_ignore_case (regexp
, name
,
2697 val
= Fcons (entity
, val
);
2700 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2701 if (INTEGERP (AREF (spec
, prop
))
2702 && ((XINT (AREF (spec
, prop
)) >> 8)
2703 != (XINT (AREF (entity
, prop
)) >> 8)))
2704 prop
= FONT_SPEC_MAX
;
2705 if (prop
< FONT_SPEC_MAX
2707 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2709 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2711 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2712 prop
= FONT_SPEC_MAX
;
2714 if (prop
< FONT_SPEC_MAX
2715 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2716 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2717 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2718 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2719 prop
= FONT_SPEC_MAX
;
2720 if (prop
< FONT_SPEC_MAX
2721 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2722 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2723 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2724 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2725 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2726 prop
= FONT_SPEC_MAX
;
2727 if (prop
< FONT_SPEC_MAX
)
2728 val
= Fcons (entity
, val
);
2730 return (Fvconcat (1, &val
));
2734 /* Return a list of vectors of font-entities matching with SPEC on
2735 FRAME. Each elements in the list is a vector of entities from the
2736 same font-driver. */
2739 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2741 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2742 Lisp_Object ftype
, val
;
2743 Lisp_Object list
= Qnil
;
2745 bool need_filtering
= 0;
2748 eassert (FONT_SPEC_P (spec
));
2750 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2751 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2752 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2753 size
= font_pixel_size (f
, spec
);
2757 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2758 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2759 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2760 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2761 if (i
!= FONT_SPACING_INDEX
)
2763 ASET (scratch_font_spec
, i
, Qnil
);
2764 if (! NILP (AREF (spec
, i
)))
2767 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2768 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2770 for (; driver_list
; driver_list
= driver_list
->next
)
2772 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2774 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2776 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2777 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2784 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2785 /* We put zero_vector in the font-cache to indicate that
2786 no fonts matching SPEC were found on the system.
2787 Failure to have this indication in the font cache can
2788 cause severe performance degradation in some rare
2789 cases, see bug#21028. */
2793 val
= Fvconcat (1, &val
);
2794 copy
= copy_font_spec (scratch_font_spec
);
2795 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2796 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2800 || ! NILP (Vface_ignored_fonts
)))
2801 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2802 if (ASIZE (val
) > 0)
2803 list
= Fcons (val
, list
);
2806 list
= Fnreverse (list
);
2807 FONT_ADD_LOG ("list", spec
, list
);
2812 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2813 nil, is an array of face's attributes, which specifies preferred
2814 font-related attributes. */
2817 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2819 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2820 Lisp_Object ftype
, size
, entity
;
2821 Lisp_Object work
= copy_font_spec (spec
);
2823 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2824 size
= AREF (spec
, FONT_SIZE_INDEX
);
2827 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2828 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2829 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2830 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2833 for (; driver_list
; driver_list
= driver_list
->next
)
2835 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2837 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2839 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2840 entity
= assoc_no_quit (work
, XCDR (cache
));
2842 entity
= AREF (XCDR (entity
), 0);
2845 entity
= driver_list
->driver
->match (f
, work
);
2848 Lisp_Object copy
= copy_font_spec (work
);
2849 Lisp_Object match
= Fvector (1, &entity
);
2851 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2852 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2855 if (! NILP (entity
))
2858 FONT_ADD_LOG ("match", work
, entity
);
2863 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2864 opened font object. */
2867 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2869 struct font_driver_list
*driver_list
;
2870 Lisp_Object objlist
, size
, val
, font_object
;
2874 eassert (FONT_ENTITY_P (entity
));
2875 size
= AREF (entity
, FONT_SIZE_INDEX
);
2876 if (XINT (size
) != 0)
2877 pixel_size
= XINT (size
);
2879 val
= AREF (entity
, FONT_TYPE_INDEX
);
2880 for (driver_list
= f
->font_driver_list
;
2881 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2882 driver_list
= driver_list
->next
);
2886 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2887 objlist
= XCDR (objlist
))
2889 Lisp_Object fn
= XCAR (objlist
);
2890 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2891 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2893 if (driver_list
->driver
->cached_font_ok
== NULL
2894 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2899 /* We always open a font of manageable size; i.e non-zero average
2900 width and height. */
2901 for (psize
= pixel_size
; ; psize
++)
2903 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2904 if (NILP (font_object
))
2906 font
= XFONT_OBJECT (font_object
);
2907 if (font
->average_width
> 0 && font
->height
> 0)
2909 /* Avoid an infinite loop. */
2910 if (psize
> pixel_size
+ 15)
2913 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2914 FONT_ADD_LOG ("open", entity
, font_object
);
2915 ASET (entity
, FONT_OBJLIST_INDEX
,
2916 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2918 font
= XFONT_OBJECT (font_object
);
2919 #ifdef HAVE_WINDOW_SYSTEM
2920 int min_width
= (font
->min_width
? font
->min_width
2921 : font
->average_width
? font
->average_width
2922 : font
->space_width
? font
->space_width
2926 int font_ascent
, font_descent
;
2927 get_font_ascent_descent (font
, &font_ascent
, &font_descent
);
2928 height
= font_ascent
+ font_descent
;
2931 #ifdef HAVE_WINDOW_SYSTEM
2932 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2933 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2935 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2936 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2937 f
->fonts_changed
= 1;
2941 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2942 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2943 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2944 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2952 /* Close FONT_OBJECT that is opened on frame F. */
2955 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2957 struct font
*font
= XFONT_OBJECT (font_object
);
2959 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2960 /* Already closed. */
2962 FONT_ADD_LOG ("close", font_object
, Qnil
);
2963 font
->driver
->close (font
);
2964 #ifdef HAVE_WINDOW_SYSTEM
2965 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2966 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2971 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2972 FONT is a font-entity and it must be opened to check. */
2975 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2979 if (FONT_ENTITY_P (font
))
2981 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2982 struct font_driver_list
*driver_list
;
2984 for (driver_list
= f
->font_driver_list
;
2985 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2986 driver_list
= driver_list
->next
);
2989 if (! driver_list
->driver
->has_char
)
2991 return driver_list
->driver
->has_char (font
, c
);
2994 eassert (FONT_OBJECT_P (font
));
2995 fontp
= XFONT_OBJECT (font
);
2996 if (fontp
->driver
->has_char
)
2998 int result
= fontp
->driver
->has_char (font
, c
);
3003 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3007 /* Return the glyph ID of FONT_OBJECT for character C. */
3010 font_encode_char (Lisp_Object font_object
, int c
)
3014 eassert (FONT_OBJECT_P (font_object
));
3015 font
= XFONT_OBJECT (font_object
);
3016 return font
->driver
->encode_char (font
, c
);
3020 /* Return the name of FONT_OBJECT. */
3023 font_get_name (Lisp_Object font_object
)
3025 eassert (FONT_OBJECT_P (font_object
));
3026 return AREF (font_object
, FONT_NAME_INDEX
);
3030 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3031 could not be parsed by font_parse_name, return Qnil. */
3034 font_spec_from_name (Lisp_Object font_name
)
3036 Lisp_Object spec
= Ffont_spec (0, NULL
);
3038 CHECK_STRING (font_name
);
3039 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
3041 font_put_extra (spec
, QCname
, font_name
);
3042 font_put_extra (spec
, QCuser_spec
, font_name
);
3048 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3050 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3055 if (! NILP (Ffont_get (font
, QCname
)))
3057 font
= copy_font_spec (font
);
3058 font_put_extra (font
, QCname
, Qnil
);
3061 if (NILP (AREF (font
, prop
))
3062 && prop
!= FONT_FAMILY_INDEX
3063 && prop
!= FONT_FOUNDRY_INDEX
3064 && prop
!= FONT_WIDTH_INDEX
3065 && prop
!= FONT_SIZE_INDEX
)
3067 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3068 font
= copy_font_spec (font
);
3069 ASET (font
, prop
, Qnil
);
3070 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3072 if (prop
== FONT_FAMILY_INDEX
)
3074 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3075 /* If we are setting the font family, we must also clear
3076 FONT_WIDTH_INDEX to avoid rejecting families that lack
3077 support for some widths. */
3078 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3080 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3081 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3082 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3083 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3084 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3085 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3087 else if (prop
== FONT_SIZE_INDEX
)
3089 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3090 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3091 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3093 else if (prop
== FONT_WIDTH_INDEX
)
3094 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3095 attrs
[LFACE_FONT_INDEX
] = font
;
3098 /* Select a font from ENTITIES (list of font-entity vectors) that
3099 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3102 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3103 Lisp_Object
*attrs
, int pixel_size
, int c
)
3105 Lisp_Object font_entity
;
3109 if (NILP (XCDR (entities
))
3110 && ASIZE (XCAR (entities
)) == 1)
3112 font_entity
= AREF (XCAR (entities
), 0);
3113 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3118 /* Sort fonts by properties specified in ATTRS. */
3119 prefer
= scratch_font_prefer
;
3121 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3122 ASET (prefer
, i
, Qnil
);
3123 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3125 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3127 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3128 ASET (prefer
, i
, AREF (face_font
, i
));
3130 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3131 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3132 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3133 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3134 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3135 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3136 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3138 return font_sort_entities (entities
, prefer
, f
, c
);
3141 /* Return a font-entity that satisfies SPEC and is the best match for
3142 face's font related attributes in ATTRS. C, if not negative, is a
3143 character that the entity must support. */
3146 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3149 Lisp_Object entities
, val
;
3150 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3155 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3156 if (NILP (registry
[0]))
3158 registry
[0] = DEFAULT_ENCODING
;
3159 registry
[1] = Qascii_0
;
3160 registry
[2] = zero_vector
;
3163 registry
[1] = zero_vector
;
3165 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3167 struct charset
*encoding
, *repertory
;
3169 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3170 &encoding
, &repertory
) < 0)
3173 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3175 else if (c
> encoding
->max_char
)
3179 work
= copy_font_spec (spec
);
3180 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3181 pixel_size
= font_pixel_size (f
, spec
);
3182 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3184 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3186 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3190 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3191 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3192 if (! NILP (foundry
[0]))
3193 foundry
[1] = zero_vector
;
3194 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3196 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3197 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3199 foundry
[2] = zero_vector
;
3202 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3204 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3205 if (! NILP (adstyle
[0]))
3206 adstyle
[1] = zero_vector
;
3207 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3209 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3211 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3213 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3215 adstyle
[2] = zero_vector
;
3218 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3221 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3224 val
= AREF (work
, FONT_FAMILY_INDEX
);
3225 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3227 val
= attrs
[LFACE_FAMILY_INDEX
];
3228 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3230 Lisp_Object familybuf
[3];
3235 family
[1] = zero_vector
; /* terminator. */
3240 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3242 if (! NILP (alters
))
3244 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3245 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3246 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3247 family
[i
] = XCAR (alters
);
3248 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3250 family
[i
] = zero_vector
;
3257 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3259 family
[i
] = zero_vector
;
3263 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3265 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3266 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3268 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3269 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3271 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3272 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3274 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3275 entities
= font_list_entities (f
, work
);
3276 if (! NILP (entities
))
3278 val
= font_select_entity (f
, entities
,
3279 attrs
, pixel_size
, c
);
3297 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3301 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3302 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3303 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3306 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3307 size
= font_pixel_size (f
, spec
);
3311 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3312 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3315 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3316 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3317 eassert (INTEGERP (height
));
3322 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3326 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3327 size
= (NUMBERP (ffsize
)
3328 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3332 size
*= font_rescale_ratio (entity
);
3335 return font_open_entity (f
, entity
, size
);
3339 /* Find a font that satisfies SPEC and is the best match for
3340 face's attributes in ATTRS on FRAME, and return the opened
3344 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3346 Lisp_Object entity
, name
;
3348 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3351 /* No font is listed for SPEC, but each font-backend may have
3352 different criteria about "font matching". So, try it. */
3353 entity
= font_matching_entity (f
, attrs
, spec
);
3354 /* Perhaps the user asked for a font "Foobar-123", and we
3355 interpreted "-123" as the size, whereas it really is part of
3356 the name. So we reset the size to nil and the family name to
3357 the entire "Foobar-123" thing, and try again with that. */
3360 name
= Ffont_get (spec
, QCuser_spec
);
3363 char *p
= SSDATA (name
), *q
= strrchr (p
, '-');
3365 if (q
!= NULL
&& c_isdigit (q
[1]))
3368 double font_size
= strtod (q
+ 1, &tail
);
3370 if (font_size
> 0 && tail
!= q
+ 1)
3372 Lisp_Object lsize
= Ffont_get (spec
, QCsize
);
3374 if ((FLOATP (lsize
) && XFLOAT_DATA (lsize
) == font_size
)
3375 || (INTEGERP (lsize
) && XINT (lsize
) == font_size
))
3377 ASET (spec
, FONT_FAMILY_INDEX
,
3378 font_intern_prop (p
, tail
- p
, 1));
3379 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
3380 entity
= font_matching_entity (f
, attrs
, spec
);
3389 /* Don't lose the original name that was put in initially. We need
3390 it to re-apply the font when font parameters (like hinting or dpi) have
3392 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3395 name
= Ffont_get (spec
, QCuser_spec
);
3396 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3402 /* Make FACE on frame F ready to use the font opened for FACE. */
3405 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3407 if (face
->font
->driver
->prepare_face
)
3408 face
->font
->driver
->prepare_face (f
, face
);
3412 /* Make FACE on frame F stop using the font opened for FACE. */
3415 font_done_for_face (struct frame
*f
, struct face
*face
)
3417 if (face
->font
->driver
->done_face
)
3418 face
->font
->driver
->done_face (f
, face
);
3422 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3423 font is found, return Qnil. */
3426 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3428 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3430 /* We set up the default font-related attributes of a face to prefer
3432 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3433 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3434 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3436 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3438 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3440 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3442 return font_load_for_lface (f
, attrs
, spec
);
3446 /* Open a font that matches NAME on frame F. If no proper font is
3447 found, return Qnil. */
3450 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3452 Lisp_Object spec
= CALLN (Ffont_spec
, QCname
, name
);
3453 Lisp_Object ret
= font_open_by_spec (f
, spec
);
3454 /* Do not lose name originally put in. */
3456 font_put_extra (ret
, QCuser_spec
, name
);
3462 /* Register font-driver DRIVER. This function is used in two ways.
3464 The first is with frame F non-NULL. In this case, make DRIVER
3465 available (but not yet activated) on F. All frame creators
3466 (e.g. Fx_create_frame) must call this function at least once with
3467 an available font-driver.
3469 The second is with frame F NULL. In this case, DRIVER is globally
3470 registered in the variable `font_driver_list'. All font-driver
3471 implementations must call this function in its syms_of_XXXX
3472 (e.g. syms_of_xfont). */
3475 register_font_driver (struct font_driver
const *driver
, struct frame
*f
)
3477 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3478 struct font_driver_list
*prev
, *list
;
3480 #ifdef HAVE_WINDOW_SYSTEM
3481 if (f
&& ! driver
->draw
)
3482 error ("Unusable font driver for a frame: %s",
3483 SDATA (SYMBOL_NAME (driver
->type
)));
3484 #endif /* HAVE_WINDOW_SYSTEM */
3486 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3487 if (EQ (list
->driver
->type
, driver
->type
))
3488 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3490 list
= xmalloc (sizeof *list
);
3492 list
->driver
= driver
;
3497 f
->font_driver_list
= list
;
3499 font_driver_list
= list
;
3505 free_font_driver_list (struct frame
*f
)
3507 struct font_driver_list
*list
, *next
;
3509 for (list
= f
->font_driver_list
; list
; list
= next
)
3514 f
->font_driver_list
= NULL
;
3518 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3519 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3520 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3522 A caller must free all realized faces if any in advance. The
3523 return value is a list of font backends actually made used on
3527 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3529 Lisp_Object active_drivers
= Qnil
;
3530 struct font_driver_list
*list
;
3532 /* At first, turn off non-requested drivers, and turn on requested
3534 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3536 struct font_driver
const *driver
= list
->driver
;
3537 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3542 if (driver
->end_for_frame
)
3543 driver
->end_for_frame (f
);
3544 font_finish_cache (f
, driver
);
3549 if (! driver
->start_for_frame
3550 || driver
->start_for_frame (f
) == 0)
3552 font_prepare_cache (f
, driver
);
3559 if (NILP (new_drivers
))
3562 if (! EQ (new_drivers
, Qt
))
3564 /* Re-order the driver list according to new_drivers. */
3565 struct font_driver_list
**list_table
, **next
;
3570 SAFE_NALLOCA (list_table
, 1, num_font_drivers
+ 1);
3571 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3573 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3574 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3577 list_table
[i
++] = list
;
3579 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3581 list_table
[i
++] = list
;
3582 list_table
[i
] = NULL
;
3584 next
= &f
->font_driver_list
;
3585 for (i
= 0; list_table
[i
]; i
++)
3587 *next
= list_table
[i
];
3588 next
= &(*next
)->next
;
3593 if (! f
->font_driver_list
->on
)
3594 { /* None of the drivers is enabled: enable them all.
3595 Happens if you set the list of drivers to (xft x) in your .emacs
3596 and then use it under w32 or ns. */
3597 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3599 struct font_driver
const *driver
= list
->driver
;
3600 eassert (! list
->on
);
3601 if (! driver
->start_for_frame
3602 || driver
->start_for_frame (f
) == 0)
3604 font_prepare_cache (f
, driver
);
3611 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3613 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3614 return active_drivers
;
3617 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
3620 fset_font_data (struct frame
*f
, Lisp_Object val
)
3626 font_put_frame_data (struct frame
*f
, Lisp_Object driver
, void *data
)
3628 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3631 fset_font_data (f
, Fdelq (val
, f
->font_data
));
3635 fset_font_data (f
, Fcons (Fcons (driver
, make_save_ptr (data
)),
3638 XSETCDR (val
, make_save_ptr (data
));
3643 font_get_frame_data (struct frame
*f
, Lisp_Object driver
)
3645 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3647 return NILP (val
) ? NULL
: XSAVE_POINTER (XCDR (val
), 0);
3650 #endif /* HAVE_XFT || HAVE_FREETYPE */
3652 /* Sets attributes on a font. Any properties that appear in ALIST and
3653 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3654 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3655 arrays of strings. This function is intended for use by the font
3656 drivers to implement their specific font_filter_properties. */
3658 font_filter_properties (Lisp_Object font
,
3660 const char *const boolean_properties
[],
3661 const char *const non_boolean_properties
[])
3666 /* Set boolean values to Qt or Qnil. */
3667 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3668 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3670 Lisp_Object key
= XCAR (XCAR (it
));
3671 Lisp_Object val
= XCDR (XCAR (it
));
3672 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3674 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3676 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3677 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3680 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3681 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3682 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3683 || strcmp ("Off", str
) == 0)
3688 Ffont_put (font
, key
, val
);
3692 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3693 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3695 Lisp_Object key
= XCAR (XCAR (it
));
3696 Lisp_Object val
= XCDR (XCAR (it
));
3697 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3698 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3699 Ffont_put (font
, key
, val
);
3704 /* Return the font used to draw character C by FACE at buffer position
3705 POS in window W. If STRING is non-nil, it is a string containing C
3706 at index POS. If C is negative, get C from the current buffer or
3710 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3715 Lisp_Object font_object
;
3717 multibyte
= (NILP (string
)
3718 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3719 : STRING_MULTIBYTE (string
));
3726 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3728 c
= FETCH_CHAR (pos_byte
);
3731 c
= FETCH_BYTE (pos
);
3737 multibyte
= STRING_MULTIBYTE (string
);
3740 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3742 str
= SDATA (string
) + pos_byte
;
3743 c
= STRING_CHAR (str
);
3746 c
= SDATA (string
)[pos
];
3750 f
= XFRAME (w
->frame
);
3751 if (! FRAME_WINDOW_P (f
))
3758 if (STRINGP (string
))
3759 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3760 DEFAULT_FACE_ID
, false);
3762 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3763 pos
+ 100, false, -1);
3764 face
= FACE_FROM_ID (f
, face_id
);
3768 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3769 face
= FACE_FROM_ID (f
, face_id
);
3774 XSETFONT (font_object
, face
->font
);
3779 #ifdef HAVE_WINDOW_SYSTEM
3781 /* Check how many characters after character/byte position POS/POS_BYTE
3782 (at most to *LIMIT) can be displayed by the same font in the window W.
3783 FACE, if non-NULL, is the face selected for the character at POS.
3784 If STRING is not nil, it is the string to check instead of the current
3785 buffer. In that case, FACE must be not NULL.
3787 The return value is the font-object for the character at POS.
3788 *LIMIT is set to the position where that font can't be used.
3790 It is assured that the current buffer (or STRING) is multibyte. */
3793 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3794 struct window
*w
, struct face
*face
, Lisp_Object string
)
3798 Lisp_Object font_object
= Qnil
;
3802 struct frame
*f
= XFRAME (w
->frame
);
3806 face_id
= face_at_buffer_position (w
, pos
, &ignore
, *limit
,
3811 NILP (Vface_remapping_alist
)
3813 : lookup_basic_face (f
, DEFAULT_FACE_ID
);
3815 face_id
= face_at_string_position (w
, string
, pos
, 0, &ignore
,
3818 face
= FACE_FROM_ID (f
, face_id
);
3821 while (pos
< *limit
)
3823 Lisp_Object category
;
3826 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3828 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3829 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3830 if (INTEGERP (category
)
3831 && (XINT (category
) == UNICODE_CATEGORY_Cf
3832 || CHAR_VARIATION_SELECTOR_P (c
)))
3834 if (NILP (font_object
))
3836 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3837 if (NILP (font_object
))
3841 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3851 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3852 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3853 Return nil otherwise.
3854 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3855 which kind of font it is. It must be one of `font-spec', `font-entity',
3857 (Lisp_Object object
, Lisp_Object extra_type
)
3859 if (NILP (extra_type
))
3860 return (FONTP (object
) ? Qt
: Qnil
);
3861 if (EQ (extra_type
, Qfont_spec
))
3862 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3863 if (EQ (extra_type
, Qfont_entity
))
3864 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3865 if (EQ (extra_type
, Qfont_object
))
3866 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3867 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3870 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3871 doc
: /* Return a newly created font-spec with arguments as properties.
3873 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3874 valid font property name listed below:
3876 `:family', `:weight', `:slant', `:width'
3878 They are the same as face attributes of the same name. See
3879 `set-face-attribute'.
3883 VALUE must be a string or a symbol specifying the font foundry, e.g. `misc'.
3887 VALUE must be a string or a symbol specifying the additional
3888 typographic style information of a font, e.g. `sans'.
3892 VALUE must be a string or a symbol specifying the charset registry and
3893 encoding of a font, e.g. `iso8859-1'.
3897 VALUE must be a non-negative integer or a floating point number
3898 specifying the font size. It specifies the font size in pixels (if
3899 VALUE is an integer), or in points (if VALUE is a float).
3903 VALUE must be a string of XLFD-style or fontconfig-style font name.
3907 VALUE must be a symbol representing a script that the font must
3908 support. It may be a symbol representing a subgroup of a script
3909 listed in the variable `script-representative-chars'.
3913 VALUE must be a symbol whose name is a two-letter ISO-639 language
3914 name, e.g. `ja'. The value is matched against the "Additional Style"
3915 field of the XLFD spec of a font, if it's non-empty, on X, and
3916 against the codepages supported by the font on w32.
3920 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3921 required OpenType features.
3923 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3924 LANGSYS-TAG: OpenType language system tag symbol,
3925 or nil for the default language system.
3926 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3927 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3929 GSUB and GPOS may contain nil elements. In such a case, the font
3930 must not have any of the remaining elements.
3932 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3933 be an OpenType font whose GPOS table of `thai' script's default
3934 language system must contain `mark' feature.
3936 usage: (font-spec ARGS...) */)
3937 (ptrdiff_t nargs
, Lisp_Object
*args
)
3939 Lisp_Object spec
= font_make_spec ();
3942 for (i
= 0; i
< nargs
; i
+= 2)
3944 Lisp_Object key
= args
[i
], val
;
3948 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3951 if (EQ (key
, QCname
))
3954 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3955 error ("Invalid font name: %s", SSDATA (val
));
3956 font_put_extra (spec
, key
, val
);
3960 int idx
= get_font_prop_index (key
);
3964 val
= font_prop_validate (idx
, Qnil
, val
);
3965 if (idx
< FONT_EXTRA_INDEX
)
3966 ASET (spec
, idx
, val
);
3968 font_put_extra (spec
, key
, val
);
3971 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3977 /* Return a copy of FONT as a font-spec. For the sake of speed, this code
3978 relies on an internal stuff exposed from alloc.c and should be handled
3982 copy_font_spec (Lisp_Object font
)
3984 enum { font_spec_size
= VECSIZE (struct font_spec
) };
3985 Lisp_Object new_spec
, tail
, *pcdr
;
3986 struct font_spec
*spec
;
3990 /* Make an uninitialized font-spec object. */
3991 spec
= (struct font_spec
*) allocate_vector (font_spec_size
);
3992 XSETPVECTYPESIZE (spec
, PVEC_FONT
, FONT_SPEC_MAX
,
3993 font_spec_size
- FONT_SPEC_MAX
);
3995 spec
->props
[FONT_TYPE_INDEX
] = spec
->props
[FONT_EXTRA_INDEX
] = Qnil
;
3997 /* Copy basic properties FONT_FOUNDRY_INDEX..FONT_AVGWIDTH_INDEX. */
3998 memcpy (spec
->props
+ 1, XVECTOR (font
)->contents
+ 1,
3999 (FONT_EXTRA_INDEX
- 1) * word_size
);
4001 /* Copy an alist of extra information but discard :font-entity property. */
4002 pcdr
= spec
->props
+ FONT_EXTRA_INDEX
;
4003 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4004 if (!EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4006 *pcdr
= Fcons (Fcons (XCAR (XCAR (tail
)), CDR (XCAR (tail
))), Qnil
);
4007 pcdr
= xcdr_addr (*pcdr
);
4010 XSETFONT (new_spec
, spec
);
4014 /* Merge font-specs FROM and TO, and return a new font-spec.
4015 Every specified property in FROM overrides the corresponding
4018 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
4020 Lisp_Object extra
, tail
;
4025 to
= copy_font_spec (to
);
4026 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4027 ASET (to
, i
, AREF (from
, i
));
4028 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4029 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4030 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4032 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4035 XSETCDR (slot
, XCDR (XCAR (tail
)));
4037 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4039 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4043 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4044 doc
: /* Return the value of FONT's property KEY.
4045 FONT is a font-spec, a font-entity, or a font-object.
4046 KEY is any symbol, but these are reserved for specific meanings:
4047 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4048 :size, :name, :script, :otf
4049 See the documentation of `font-spec' for their meanings.
4050 In addition, if FONT is a font-entity or a font-object, values of
4051 :script and :otf are different from those of a font-spec as below:
4053 The value of :script may be a list of scripts that are supported by the font.
4055 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
4056 representing the OpenType features supported by the font by this form:
4057 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4058 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
4061 In addition to the keys listed abobe, the following keys are reserved
4062 for the specific meanings as below:
4064 The value of :combining-capability is non-nil if the font-backend of
4065 FONT supports rendering of combining characters for non-OTF fonts. */)
4066 (Lisp_Object font
, Lisp_Object key
)
4074 idx
= get_font_prop_index (key
);
4075 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4076 return font_style_symbolic (font
, idx
, 0);
4077 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4078 return AREF (font
, idx
);
4079 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4080 if (NILP (val
) && FONT_OBJECT_P (font
))
4082 struct font
*fontp
= XFONT_OBJECT (font
);
4084 if (EQ (key
, QCotf
))
4086 if (fontp
->driver
->otf_capability
)
4087 val
= fontp
->driver
->otf_capability (fontp
);
4089 val
= Fcons (Qnil
, Qnil
);
4091 else if (EQ (key
, QCcombining_capability
))
4093 if (fontp
->driver
->combining_capability
)
4094 val
= fontp
->driver
->combining_capability (fontp
);
4102 #ifdef HAVE_WINDOW_SYSTEM
4104 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4105 doc
: /* Return a plist of face attributes generated by FONT.
4106 FONT is a font name, a font-spec, a font-entity, or a font-object.
4107 The return value is a list of the form
4109 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4111 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4112 compatible with `set-face-attribute'. Some of these key-attribute pairs
4113 may be omitted from the list if they are not specified by FONT.
4115 The optional argument FRAME specifies the frame that the face attributes
4116 are to be displayed on. If omitted, the selected frame is used. */)
4117 (Lisp_Object font
, Lisp_Object frame
)
4119 struct frame
*f
= decode_live_frame (frame
);
4120 Lisp_Object plist
[10];
4126 int fontset
= fs_query_fontset (font
, 0);
4127 Lisp_Object name
= font
;
4129 font
= fontset_ascii (fontset
);
4130 font
= font_spec_from_name (name
);
4132 signal_error ("Invalid font name", name
);
4134 else if (! FONTP (font
))
4135 signal_error ("Invalid font object", font
);
4137 val
= AREF (font
, FONT_FAMILY_INDEX
);
4140 plist
[n
++] = QCfamily
;
4141 plist
[n
++] = SYMBOL_NAME (val
);
4144 val
= AREF (font
, FONT_SIZE_INDEX
);
4147 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4148 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4149 plist
[n
++] = QCheight
;
4150 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4152 else if (FLOATP (val
))
4154 plist
[n
++] = QCheight
;
4155 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4158 val
= FONT_WEIGHT_FOR_FACE (font
);
4161 plist
[n
++] = QCweight
;
4165 val
= FONT_SLANT_FOR_FACE (font
);
4168 plist
[n
++] = QCslant
;
4172 val
= FONT_WIDTH_FOR_FACE (font
);
4175 plist
[n
++] = QCwidth
;
4179 return Flist (n
, plist
);
4184 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4185 doc
: /* Set one property of FONT: give property KEY value VAL.
4186 FONT is a font-spec, a font-entity, or a font-object.
4188 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4189 accepted by the function `font-spec' (which see), VAL must be what
4190 allowed in `font-spec'.
4192 If FONT is a font-entity or a font-object, KEY must not be the one
4193 accepted by `font-spec'. */)
4194 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4198 idx
= get_font_prop_index (prop
);
4199 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4201 CHECK_FONT_SPEC (font
);
4202 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4206 if (EQ (prop
, QCname
)
4207 || EQ (prop
, QCscript
)
4208 || EQ (prop
, QClang
)
4209 || EQ (prop
, QCotf
))
4210 CHECK_FONT_SPEC (font
);
4213 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4218 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4219 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4220 Optional 2nd argument FRAME specifies the target frame.
4221 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4222 Optional 4th argument PREFER, if non-nil, is a font-spec to
4223 control the order of the returned list. Fonts are sorted by
4224 how close they are to PREFER. */)
4225 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4227 struct frame
*f
= decode_live_frame (frame
);
4228 Lisp_Object vec
, list
;
4231 CHECK_FONT_SPEC (font_spec
);
4239 if (! NILP (prefer
))
4240 CHECK_FONT_SPEC (prefer
);
4242 list
= font_list_entities (f
, font_spec
);
4245 if (NILP (XCDR (list
))
4246 && ASIZE (XCAR (list
)) == 1)
4247 return list1 (AREF (XCAR (list
), 0));
4249 if (! NILP (prefer
))
4250 vec
= font_sort_entities (list
, prefer
, f
, 0);
4252 vec
= font_vconcat_entity_vectors (list
);
4253 if (n
== 0 || n
>= ASIZE (vec
))
4254 list
= CALLN (Fappend
, vec
, Qnil
);
4257 for (list
= Qnil
, n
--; n
>= 0; n
--)
4258 list
= Fcons (AREF (vec
, n
), list
);
4263 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4264 doc
: /* List available font families on the current frame.
4265 If FRAME is omitted or nil, the selected frame is used. */)
4268 struct frame
*f
= decode_live_frame (frame
);
4269 struct font_driver_list
*driver_list
;
4270 Lisp_Object list
= Qnil
;
4272 for (driver_list
= f
->font_driver_list
; driver_list
;
4273 driver_list
= driver_list
->next
)
4274 if (driver_list
->driver
->list_family
)
4276 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4277 Lisp_Object tail
= list
;
4279 for (; CONSP (val
); val
= XCDR (val
))
4280 if (NILP (Fmemq (XCAR (val
), tail
))
4281 && SYMBOLP (XCAR (val
)))
4282 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4287 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4288 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4289 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4290 (Lisp_Object font_spec
, Lisp_Object frame
)
4292 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4299 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4300 doc
: /* Return XLFD name of FONT.
4301 FONT is a font-spec, font-entity, or font-object.
4302 If the name is too long for XLFD (maximum 255 chars), return nil.
4303 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4304 the consecutive wildcards are folded into one. */)
4305 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4308 int namelen
, pixel_size
= 0;
4312 if (FONT_OBJECT_P (font
))
4314 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4316 if (STRINGP (font_name
)
4317 && SDATA (font_name
)[0] == '-')
4319 if (NILP (fold_wildcards
))
4321 lispstpcpy (name
, font_name
);
4322 namelen
= SBYTES (font_name
);
4325 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4327 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4331 if (! NILP (fold_wildcards
))
4333 char *p0
= name
, *p1
;
4335 while ((p1
= strstr (p0
, "-*-*")))
4337 strcpy (p1
, p1
+ 2);
4343 return make_string (name
, namelen
);
4347 clear_font_cache (struct frame
*f
)
4349 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4351 for (; driver_list
; driver_list
= driver_list
->next
)
4352 if (driver_list
->on
)
4354 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4358 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4360 eassert (! NILP (val
));
4361 tmp
= XCDR (XCAR (val
));
4362 if (XINT (XCAR (tmp
)) == 0)
4364 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4365 XSETCDR (cache
, XCDR (val
));
4370 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4371 doc
: /* Clear font cache of each frame. */)
4374 Lisp_Object list
, frame
;
4376 FOR_EACH_FRAME (list
, frame
)
4377 clear_font_cache (XFRAME (frame
));
4384 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4386 struct font
*font
= XFONT_OBJECT (font_object
);
4387 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4388 struct font_metrics metrics
;
4390 LGLYPH_SET_CODE (glyph
, code
);
4391 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4392 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4393 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4394 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4395 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4396 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4400 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4401 doc
: /* Shape the glyph-string GSTRING.
4402 Shaping means substituting glyphs and/or adjusting positions of glyphs
4403 to get the correct visual image of character sequences set in the
4404 header of the glyph-string.
4406 If the shaping was successful, the value is GSTRING itself or a newly
4407 created glyph-string. Otherwise, the value is nil.
4409 See the documentation of `composition-get-gstring' for the format of
4411 (Lisp_Object gstring
)
4414 Lisp_Object font_object
, n
, glyph
;
4415 ptrdiff_t i
, from
, to
;
4417 if (! composition_gstring_p (gstring
))
4418 signal_error ("Invalid glyph-string: ", gstring
);
4419 if (! NILP (LGSTRING_ID (gstring
)))
4421 font_object
= LGSTRING_FONT (gstring
);
4422 CHECK_FONT_OBJECT (font_object
);
4423 font
= XFONT_OBJECT (font_object
);
4424 if (! font
->driver
->shape
)
4427 /* Try at most three times with larger gstring each time. */
4428 for (i
= 0; i
< 3; i
++)
4430 n
= font
->driver
->shape (gstring
);
4433 gstring
= larger_vector (gstring
,
4434 LGSTRING_GLYPH_LEN (gstring
), -1);
4436 if (i
== 3 || XINT (n
) == 0)
4438 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4439 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4441 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4442 GLYPHS covers all characters (except for the last few ones) in
4443 GSTRING. More formally, provided that NCHARS is the number of
4444 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4445 and TO_IDX of each glyph must satisfy these conditions:
4447 GLYPHS[0].FROM_IDX == 0
4448 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4449 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4450 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4451 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4453 ;; Be sure to cover all characters.
4454 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4455 glyph
= LGSTRING_GLYPH (gstring
, 0);
4456 from
= LGLYPH_FROM (glyph
);
4457 to
= LGLYPH_TO (glyph
);
4458 if (from
!= 0 || to
< from
)
4460 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4462 glyph
= LGSTRING_GLYPH (gstring
, i
);
4465 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4466 && (LGLYPH_FROM (glyph
) == from
4467 ? LGLYPH_TO (glyph
) == to
4468 : LGLYPH_FROM (glyph
) == to
+ 1)))
4470 from
= LGLYPH_FROM (glyph
);
4471 to
= LGLYPH_TO (glyph
);
4473 return composition_gstring_put_cache (gstring
, XINT (n
));
4479 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4481 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4482 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4484 VARIATION-SELECTOR is a character code of variation selection
4485 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4486 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4487 (Lisp_Object font_object
, Lisp_Object character
)
4489 unsigned variations
[256];
4494 CHECK_FONT_OBJECT (font_object
);
4495 CHECK_CHARACTER (character
);
4496 font
= XFONT_OBJECT (font_object
);
4497 if (! font
->driver
->get_variation_glyphs
)
4499 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4503 for (i
= 0; i
< 255; i
++)
4506 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4507 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4508 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4513 /* Return a description of the font at POSITION in the current buffer.
4514 If the 2nd optional arg CH is non-nil, it is a character to check
4515 the font instead of the character at POSITION.
4517 For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
4518 FONT-OBJECT is the font for the character at POSITION in the current
4519 buffer. This is computed from all the text properties and overlays
4520 that apply to POSITION. POSITION may be nil, in which case,
4521 FONT-SPEC is the font for displaying the character CH with the
4522 default face. GLYPH-CODE is the glyph code in the font to use for
4525 For a text terminal, return a nonnegative integer glyph code for
4526 the character, or a negative integer if the character is not
4527 displayable. Terminal glyph codes are system-dependent integers
4528 that represent displayable characters: for example, on a Linux x86
4529 console they represent VGA code points.
4531 It returns nil in the following cases:
4533 (1) The window system doesn't have a font for the character (thus
4534 it is displayed by an empty box).
4536 (2) The character code is invalid.
4538 (3) If POSITION is not nil, and the current buffer is not displayed
4541 (4) For a text terminal, the terminal does not report glyph codes.
4543 In addition, the returned font name may not take into account of
4544 such redisplay engine hooks as what used in jit-lock-mode if
4545 POSITION is currently not visible. */
4548 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 2, 0,
4549 doc
: /* For internal use only. */)
4550 (Lisp_Object position
, Lisp_Object ch
)
4552 ptrdiff_t pos
, pos_byte
, dummy
;
4557 if (NILP (position
))
4559 CHECK_CHARACTER (ch
);
4561 f
= XFRAME (selected_frame
);
4562 face_id
= lookup_basic_face (f
, DEFAULT_FACE_ID
);
4570 CHECK_NUMBER_COERCE_MARKER (position
);
4571 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4572 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4573 pos
= XINT (position
);
4574 pos_byte
= CHAR_TO_BYTE (pos
);
4576 c
= FETCH_CHAR (pos_byte
);
4582 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
4585 w
= XWINDOW (window
);
4586 f
= XFRAME (w
->frame
);
4587 face_id
= face_at_buffer_position (w
, pos
, &dummy
,
4588 pos
+ 100, false, -1);
4590 if (! CHAR_VALID_P (c
))
4593 if (! FRAME_WINDOW_P (f
))
4594 return terminal_glyph_code (FRAME_TERMINAL (f
), c
);
4596 /* We need the basic faces to be valid below, so recompute them if
4597 some code just happened to clear the face cache. */
4598 if (FRAME_FACE_CACHE (f
)->used
== 0)
4599 recompute_basic_faces (f
);
4601 face_id
= FACE_FOR_CHAR (f
, FACE_FROM_ID (f
, face_id
), c
, pos
, Qnil
);
4602 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4605 unsigned code
= face
->font
->driver
->encode_char (face
->font
, c
);
4606 if (code
== FONT_INVALID_CODE
)
4608 Lisp_Object font_object
;
4609 XSETFONT (font_object
, face
->font
);
4610 return Fcons (font_object
, INTEGER_TO_CONS (code
));
4615 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4616 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4617 OTF-FEATURES specifies which features to apply in this format:
4618 (SCRIPT LANGSYS GSUB GPOS)
4620 SCRIPT is a symbol specifying a script tag of OpenType,
4621 LANGSYS is a symbol specifying a langsys tag of OpenType,
4622 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4624 If LANGSYS is nil, the default langsys is selected.
4626 The features are applied in the order they appear in the list. The
4627 symbol `*' means to apply all available features not present in this
4628 list, and the remaining features are ignored. For instance, (vatu
4629 pstf * haln) is to apply vatu and pstf in this order, then to apply
4630 all available features other than vatu, pstf, and haln.
4632 The features are applied to the glyphs in the range FROM and TO of
4633 the glyph-string GSTRING-IN.
4635 If some feature is actually applicable, the resulting glyphs are
4636 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4637 this case, the value is the number of produced glyphs.
4639 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4642 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4643 produced in GSTRING-OUT, and the value is nil.
4645 See the documentation of `composition-get-gstring' for the format of
4647 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4649 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4654 check_otf_features (otf_features
);
4655 CHECK_FONT_OBJECT (font_object
);
4656 font
= XFONT_OBJECT (font_object
);
4657 if (! font
->driver
->otf_drive
)
4658 error ("Font backend %s can't drive OpenType GSUB table",
4659 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4660 CHECK_CONS (otf_features
);
4661 CHECK_SYMBOL (XCAR (otf_features
));
4662 val
= XCDR (otf_features
);
4663 CHECK_SYMBOL (XCAR (val
));
4664 val
= XCDR (otf_features
);
4667 len
= check_gstring (gstring_in
);
4668 CHECK_VECTOR (gstring_out
);
4669 CHECK_NATNUM (from
);
4671 CHECK_NATNUM (index
);
4673 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4674 args_out_of_range_3 (from
, to
, make_number (len
));
4675 if (XINT (index
) >= ASIZE (gstring_out
))
4676 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4677 num
= font
->driver
->otf_drive (font
, otf_features
,
4678 gstring_in
, XINT (from
), XINT (to
),
4679 gstring_out
, XINT (index
), 0);
4682 return make_number (num
);
4685 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4687 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4688 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4690 (SCRIPT LANGSYS FEATURE ...)
4691 See the documentation of `font-drive-otf' for more detail.
4693 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4694 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4695 character code corresponding to the glyph or nil if there's no
4696 corresponding character. */)
4697 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4699 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4700 Lisp_Object gstring_in
, gstring_out
, g
;
4701 Lisp_Object alternates
;
4704 if (! font
->driver
->otf_drive
)
4705 error ("Font backend %s can't drive OpenType GSUB table",
4706 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4707 CHECK_CHARACTER (character
);
4708 CHECK_CONS (otf_features
);
4710 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4711 g
= LGSTRING_GLYPH (gstring_in
, 0);
4712 LGLYPH_SET_CHAR (g
, XINT (character
));
4713 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4714 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4715 gstring_out
, 0, 1)) < 0)
4716 gstring_out
= Ffont_make_gstring (font_object
,
4717 make_number (ASIZE (gstring_out
) * 2));
4719 for (i
= 0; i
< num
; i
++)
4721 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4722 int c
= LGLYPH_CHAR (g
);
4723 unsigned code
= LGLYPH_CODE (g
);
4725 alternates
= Fcons (Fcons (make_number (code
),
4726 c
> 0 ? make_number (c
) : Qnil
),
4729 return Fnreverse (alternates
);
4735 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4736 doc
: /* Open FONT-ENTITY. */)
4737 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4740 struct frame
*f
= decode_live_frame (frame
);
4742 CHECK_FONT_ENTITY (font_entity
);
4745 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4748 CHECK_NUMBER_OR_FLOAT (size
);
4750 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4752 isize
= XINT (size
);
4753 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4754 args_out_of_range (font_entity
, size
);
4758 return font_open_entity (f
, font_entity
, isize
);
4761 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4762 doc
: /* Close FONT-OBJECT. */)
4763 (Lisp_Object font_object
, Lisp_Object frame
)
4765 CHECK_FONT_OBJECT (font_object
);
4766 font_close_object (decode_live_frame (frame
), font_object
);
4770 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4771 doc
: /* Return information about FONT-OBJECT.
4772 The value is a vector:
4773 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4776 NAME is the font name, a string (or nil if the font backend doesn't
4779 FILENAME is the font file name, a string (or nil if the font backend
4780 doesn't provide a file name).
4782 PIXEL-SIZE is a pixel size by which the font is opened.
4784 SIZE is a maximum advance width of the font in pixels.
4786 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4789 CAPABILITY is a list whose first element is a symbol representing the
4790 font format (x, opentype, truetype, type1, pcf, or bdf) and the
4791 remaining elements describe the details of the font capability.
4793 If the font is OpenType font, the form of the list is
4794 (opentype GSUB GPOS)
4795 where GSUB shows which "GSUB" features the font supports, and GPOS
4796 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4797 lists of the format:
4798 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4800 If the font is not OpenType font, currently the length of the form is
4803 SCRIPT is a symbol representing OpenType script tag.
4805 LANGSYS is a symbol representing OpenType langsys tag, or nil
4806 representing the default langsys.
4808 FEATURE is a symbol representing OpenType feature tag.
4810 If the font is not OpenType font, CAPABILITY is nil. */)
4811 (Lisp_Object font_object
)
4813 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4814 Lisp_Object val
= make_uninit_vector (9);
4816 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4817 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4818 ASET (val
, 2, make_number (font
->pixel_size
));
4819 ASET (val
, 3, make_number (font
->max_width
));
4820 ASET (val
, 4, make_number (font
->ascent
));
4821 ASET (val
, 5, make_number (font
->descent
));
4822 ASET (val
, 6, make_number (font
->space_width
));
4823 ASET (val
, 7, make_number (font
->average_width
));
4824 if (font
->driver
->otf_capability
)
4825 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4827 ASET (val
, 8, Qnil
);
4831 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4833 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4834 FROM and TO are positions (integers or markers) specifying a region
4835 of the current buffer, and can be in either order. If the optional
4836 fourth arg OBJECT is not nil, it is a string or a vector containing
4837 the target characters between indices FROM and TO, which are treated
4840 Each element is a vector containing information of a glyph in this format:
4841 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4843 FROM is an index numbers of a character the glyph corresponds to.
4844 TO is the same as FROM.
4845 C is the character of the glyph.
4846 CODE is the glyph-code of C in FONT-OBJECT.
4847 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4848 ADJUSTMENT is always nil.
4849 If FONT-OBJECT doesn't have a glyph for a character,
4850 the corresponding element is nil. */)
4851 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4854 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4856 Lisp_Object
*chars
, vec
;
4861 ptrdiff_t charpos
, bytepos
;
4863 validate_region (&from
, &to
);
4866 len
= XFASTINT (to
) - XFASTINT (from
);
4867 SAFE_ALLOCA_LISP (chars
, len
);
4868 charpos
= XFASTINT (from
);
4869 bytepos
= CHAR_TO_BYTE (charpos
);
4870 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4873 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4874 chars
[i
] = make_number (c
);
4877 else if (STRINGP (object
))
4879 const unsigned char *p
;
4880 ptrdiff_t ifrom
, ito
;
4882 validate_subarray (object
, from
, to
, SCHARS (object
), &ifrom
, &ito
);
4886 SAFE_ALLOCA_LISP (chars
, len
);
4888 if (STRING_MULTIBYTE (object
))
4892 /* Skip IFROM characters from the beginning. */
4893 for (i
= 0; i
< ifrom
; i
++)
4894 c
= STRING_CHAR_ADVANCE (p
);
4896 /* Now fetch an interesting characters. */
4897 for (i
= 0; i
< len
; i
++)
4899 c
= STRING_CHAR_ADVANCE (p
);
4900 chars
[i
] = make_number (c
);
4904 for (i
= 0; i
< len
; i
++)
4905 chars
[i
] = make_number (p
[ifrom
+ i
]);
4907 else if (VECTORP (object
))
4909 ptrdiff_t ifrom
, ito
;
4911 validate_subarray (object
, from
, to
, ASIZE (object
), &ifrom
, &ito
);
4915 for (i
= 0; i
< len
; i
++)
4917 Lisp_Object elt
= AREF (object
, ifrom
+ i
);
4918 CHECK_CHARACTER (elt
);
4920 chars
= aref_addr (object
, ifrom
);
4923 wrong_type_argument (Qarrayp
, object
);
4925 vec
= make_uninit_vector (len
);
4926 for (i
= 0; i
< len
; i
++)
4929 int c
= XFASTINT (chars
[i
]);
4931 struct font_metrics metrics
;
4933 code
= font
->driver
->encode_char (font
, c
);
4934 if (code
== FONT_INVALID_CODE
)
4936 ASET (vec
, i
, Qnil
);
4940 LGLYPH_SET_FROM (g
, i
);
4941 LGLYPH_SET_TO (g
, i
);
4942 LGLYPH_SET_CHAR (g
, c
);
4943 LGLYPH_SET_CODE (g
, code
);
4944 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4945 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4946 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4947 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4948 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4949 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4952 if (! VECTORP (object
))
4957 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4958 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4959 FONT is a font-spec, font-entity, or font-object. */)
4960 (Lisp_Object spec
, Lisp_Object font
)
4962 CHECK_FONT_SPEC (spec
);
4965 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4968 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4969 doc
: /* Return a font-object for displaying a character at POSITION.
4970 Optional second arg WINDOW, if non-nil, is a window displaying
4971 the current buffer. It defaults to the currently selected window.
4972 Optional third arg STRING, if non-nil, is a string containing the target
4973 character at index specified by POSITION. */)
4974 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4976 struct window
*w
= decode_live_window (window
);
4980 if (XBUFFER (w
->contents
) != current_buffer
)
4981 error ("Specified window is not displaying the current buffer");
4982 CHECK_NUMBER_COERCE_MARKER (position
);
4983 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4984 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4988 CHECK_NUMBER (position
);
4989 CHECK_STRING (string
);
4990 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4991 args_out_of_range (string
, position
);
4994 return font_at (-1, XINT (position
), NULL
, w
, string
);
4998 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4999 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
5000 The value is a number of glyphs drawn.
5001 Type C-l to recover what previously shown. */)
5002 (Lisp_Object font_object
, Lisp_Object string
)
5004 Lisp_Object frame
= selected_frame
;
5005 struct frame
*f
= XFRAME (frame
);
5011 CHECK_FONT_GET_OBJECT (font_object
, font
);
5012 CHECK_STRING (string
);
5013 len
= SCHARS (string
);
5014 code
= alloca (sizeof (unsigned) * len
);
5015 for (i
= 0; i
< len
; i
++)
5017 Lisp_Object ch
= Faref (string
, make_number (i
));
5021 code
[i
] = font
->driver
->encode_char (font
, c
);
5022 if (code
[i
] == FONT_INVALID_CODE
)
5025 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5027 if (font
->driver
->prepare_face
)
5028 font
->driver
->prepare_face (f
, face
);
5029 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
5030 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
5031 if (font
->driver
->done_face
)
5032 font
->driver
->done_face (f
, face
);
5034 return make_number (len
);
5038 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
5039 doc
: /* Return FRAME's font cache. Mainly used for debugging.
5040 If FRAME is omitted or nil, use the selected frame. */)
5043 #ifdef HAVE_WINDOW_SYSTEM
5044 struct frame
*f
= decode_live_frame (frame
);
5046 if (FRAME_WINDOW_P (f
))
5047 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
5053 #endif /* FONT_DEBUG */
5055 #ifdef HAVE_WINDOW_SYSTEM
5057 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
5058 doc
: /* Return information about a font named NAME on frame FRAME.
5059 If FRAME is omitted or nil, use the selected frame.
5061 The returned value is a vector of 14 elements:
5062 [ OPENED-NAME FULL-NAME SIZE HEIGHT BASELINE-OFFSET RELATIVE-COMPOSE
5063 DEFAULT-ASCENT MAX-WIDTH ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
5064 FILENAME CAPABILITY ]
5066 OPENED-NAME is the name used for opening the font,
5067 FULL-NAME is the full name of the font,
5068 SIZE is the pixelsize of the font,
5069 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
5070 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
5071 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
5072 how to compose characters,
5073 MAX-WIDTH is the maximum advance width of the font,
5074 ASCENT, DESCENT, SPACE-WIDTH, and AVERAGE-WIDTH are metrics of
5076 FILENAME is the font file name, a string (or nil if the font backend
5077 doesn't provide a file name).
5078 CAPABILITY is a list whose first element is a symbol representing the
5079 font format, one of `x', `opentype', `truetype', `type1', `pcf', or `bdf'.
5080 The remaining elements describe the details of the font capabilities,
5083 If the font is OpenType font, the form of the list is
5084 (opentype GSUB GPOS)
5085 where GSUB shows which "GSUB" features the font supports, and GPOS
5086 shows which "GPOS" features the font supports. Both GSUB and GPOS are
5088 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
5091 SCRIPT is a symbol representing OpenType script tag.
5092 LANGSYS is a symbol representing OpenType langsys tag, or nil
5093 representing the default langsys.
5094 FEATURE is a symbol representing OpenType feature tag.
5096 If the font is not an OpenType font, there are no elements
5097 in CAPABILITY except the font format symbol.
5099 If the named font is not yet loaded, return nil. */)
5100 (Lisp_Object name
, Lisp_Object frame
)
5105 Lisp_Object font_object
;
5108 CHECK_STRING (name
);
5109 f
= decode_window_system_frame (frame
);
5113 int fontset
= fs_query_fontset (name
, 0);
5116 name
= fontset_ascii (fontset
);
5117 font_object
= font_open_by_name (f
, name
);
5119 else if (FONT_OBJECT_P (name
))
5121 else if (FONT_ENTITY_P (name
))
5122 font_object
= font_open_entity (f
, name
, 0);
5125 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5126 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5128 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5130 if (NILP (font_object
))
5132 font
= XFONT_OBJECT (font_object
);
5134 info
= make_uninit_vector (14);
5135 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
5136 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
5137 ASET (info
, 2, make_number (font
->pixel_size
));
5138 ASET (info
, 3, make_number (font
->height
));
5139 ASET (info
, 4, make_number (font
->baseline_offset
));
5140 ASET (info
, 5, make_number (font
->relative_compose
));
5141 ASET (info
, 6, make_number (font
->default_ascent
));
5142 ASET (info
, 7, make_number (font
->max_width
));
5143 ASET (info
, 8, make_number (font
->ascent
));
5144 ASET (info
, 9, make_number (font
->descent
));
5145 ASET (info
, 10, make_number (font
->space_width
));
5146 ASET (info
, 11, make_number (font
->average_width
));
5147 ASET (info
, 12, AREF (font_object
, FONT_FILE_INDEX
));
5148 if (font
->driver
->otf_capability
)
5149 ASET (info
, 13, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
5151 ASET (info
, 13, Qnil
);
5154 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5155 close it now. Perhaps, we should manage font-objects
5156 by `reference-count'. */
5157 font_close_object (f
, font_object
);
5164 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
5167 build_style_table (const struct table_entry
*entry
, int nelement
)
5170 Lisp_Object table
, elt
;
5172 table
= make_uninit_vector (nelement
);
5173 for (i
= 0; i
< nelement
; i
++)
5175 for (j
= 0; entry
[i
].names
[j
]; j
++);
5176 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5177 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5178 for (j
= 0; entry
[i
].names
[j
]; j
++)
5179 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5180 ASET (table
, i
, elt
);
5185 /* The deferred font-log data of the form [ACTION ARG RESULT].
5186 If ACTION is not nil, that is added to the log when font_add_log is
5187 called next time. At that time, ACTION is set back to nil. */
5188 static Lisp_Object Vfont_log_deferred
;
5190 /* Prepend the font-related logging data in Vfont_log if it is not
5191 t. ACTION describes a kind of font-related action (e.g. listing,
5192 opening), ARG is the argument for the action, and RESULT is the
5193 result of the action. */
5195 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5200 if (EQ (Vfont_log
, Qt
))
5202 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5204 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
5206 ASET (Vfont_log_deferred
, 0, Qnil
);
5207 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5208 AREF (Vfont_log_deferred
, 2));
5213 Lisp_Object tail
, elt
;
5214 AUTO_STRING (equal
, "=");
5216 val
= Ffont_xlfd_name (arg
, Qt
);
5217 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5221 if (EQ (XCAR (elt
), QCscript
)
5222 && SYMBOLP (XCDR (elt
)))
5223 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5224 concat2 (equal
, SYMBOL_NAME (XCDR (elt
))));
5225 else if (EQ (XCAR (elt
), QClang
)
5226 && SYMBOLP (XCDR (elt
)))
5227 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5228 concat2 (equal
, SYMBOL_NAME (XCDR (elt
))));
5229 else if (EQ (XCAR (elt
), QCotf
)
5230 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5231 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5232 concat2 (equal
, SYMBOL_NAME (XCAR (XCDR (elt
)))));
5238 && VECTORP (XCAR (result
))
5239 && ASIZE (XCAR (result
)) > 0
5240 && FONTP (AREF (XCAR (result
), 0)))
5241 result
= font_vconcat_entity_vectors (result
);
5244 val
= Ffont_xlfd_name (result
, Qt
);
5245 if (! FONT_SPEC_P (result
))
5247 AUTO_STRING (colon
, ":");
5248 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5253 else if (CONSP (result
))
5256 result
= Fcopy_sequence (result
);
5257 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5261 val
= Ffont_xlfd_name (val
, Qt
);
5262 XSETCAR (tail
, val
);
5265 else if (VECTORP (result
))
5267 result
= Fcopy_sequence (result
);
5268 for (i
= 0; i
< ASIZE (result
); i
++)
5270 val
= AREF (result
, i
);
5272 val
= Ffont_xlfd_name (val
, Qt
);
5273 ASET (result
, i
, val
);
5276 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5279 /* Record a font-related logging data to be added to Vfont_log when
5280 font_add_log is called next time. ACTION, ARG, RESULT are the same
5284 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5286 if (EQ (Vfont_log
, Qt
))
5288 ASET (Vfont_log_deferred
, 0, build_string (action
));
5289 ASET (Vfont_log_deferred
, 1, arg
);
5290 ASET (Vfont_log_deferred
, 2, result
);
5294 font_drop_xrender_surfaces (struct frame
*f
)
5296 struct font_driver_list
*list
;
5298 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
5299 if (list
->on
&& list
->driver
->drop_xrender_surfaces
)
5300 list
->driver
->drop_xrender_surfaces (f
);
5306 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5307 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5308 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5309 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5310 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5311 /* Note that the other elements in sort_shift_bits are not used. */
5313 staticpro (&font_charset_alist
);
5314 font_charset_alist
= Qnil
;
5316 DEFSYM (Qopentype
, "opentype");
5318 /* Important character set symbols. */
5319 DEFSYM (Qascii_0
, "ascii-0");
5320 DEFSYM (Qiso8859_1
, "iso8859-1");
5321 DEFSYM (Qiso10646_1
, "iso10646-1");
5322 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5324 /* Symbols representing keys of font extra info. */
5325 DEFSYM (QCotf
, ":otf");
5326 DEFSYM (QClang
, ":lang");
5327 DEFSYM (QCscript
, ":script");
5328 DEFSYM (QCantialias
, ":antialias");
5329 DEFSYM (QCfoundry
, ":foundry");
5330 DEFSYM (QCadstyle
, ":adstyle");
5331 DEFSYM (QCregistry
, ":registry");
5332 DEFSYM (QCspacing
, ":spacing");
5333 DEFSYM (QCdpi
, ":dpi");
5334 DEFSYM (QCscalable
, ":scalable");
5335 DEFSYM (QCavgwidth
, ":avgwidth");
5336 DEFSYM (QCfont_entity
, ":font-entity");
5337 DEFSYM (QCcombining_capability
, ":combining-capability");
5339 /* Symbols representing values of font spacing property. */
5345 /* Special ADSTYLE properties to avoid fonts used for Latin
5346 characters; used in xfont.c and ftfont.c. */
5350 DEFSYM (QCuser_spec
, ":user-spec");
5352 staticpro (&scratch_font_spec
);
5353 scratch_font_spec
= Ffont_spec (0, NULL
);
5354 staticpro (&scratch_font_prefer
);
5355 scratch_font_prefer
= Ffont_spec (0, NULL
);
5357 staticpro (&Vfont_log_deferred
);
5358 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5362 staticpro (&otf_list
);
5364 #endif /* HAVE_LIBOTF */
5368 defsubr (&Sfont_spec
);
5369 defsubr (&Sfont_get
);
5370 #ifdef HAVE_WINDOW_SYSTEM
5371 defsubr (&Sfont_face_attributes
);
5373 defsubr (&Sfont_put
);
5374 defsubr (&Slist_fonts
);
5375 defsubr (&Sfont_family_list
);
5376 defsubr (&Sfind_font
);
5377 defsubr (&Sfont_xlfd_name
);
5378 defsubr (&Sclear_font_cache
);
5379 defsubr (&Sfont_shape_gstring
);
5380 defsubr (&Sfont_variation_glyphs
);
5381 defsubr (&Sinternal_char_font
);
5383 defsubr (&Sfont_drive_otf
);
5384 defsubr (&Sfont_otf_alternates
);
5388 defsubr (&Sopen_font
);
5389 defsubr (&Sclose_font
);
5390 defsubr (&Squery_font
);
5391 defsubr (&Sfont_get_glyphs
);
5392 defsubr (&Sfont_match_p
);
5393 defsubr (&Sfont_at
);
5395 defsubr (&Sdraw_string
);
5397 defsubr (&Sframe_font_cache
);
5398 #endif /* FONT_DEBUG */
5399 #ifdef HAVE_WINDOW_SYSTEM
5400 defsubr (&Sfont_info
);
5403 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5405 Alist of fontname patterns vs the corresponding encoding and repertory info.
5406 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5407 where ENCODING is a charset or a char-table,
5408 and REPERTORY is a charset, a char-table, or nil.
5410 If ENCODING and REPERTORY are the same, the element can have the form
5411 \(REGEXP . ENCODING).
5413 ENCODING is for converting a character to a glyph code of the font.
5414 If ENCODING is a charset, encoding a character by the charset gives
5415 the corresponding glyph code. If ENCODING is a char-table, looking up
5416 the table by a character gives the corresponding glyph code.
5418 REPERTORY specifies a repertory of characters supported by the font.
5419 If REPERTORY is a charset, all characters belonging to the charset are
5420 supported. If REPERTORY is a char-table, all characters who have a
5421 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5422 gets the repertory information by an opened font and ENCODING. */);
5423 Vfont_encoding_alist
= Qnil
;
5425 /* FIXME: These 3 vars are not quite what they appear: setq on them
5426 won't have any effect other than disconnect them from the style
5427 table used by the font display code. So we make them read-only,
5428 to avoid this confusing situation. */
5430 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5431 doc
: /* Vector of valid font weight values.
5432 Each element has the form:
5433 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5434 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols.
5435 This variable cannot be set; trying to do so will signal an error. */);
5436 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5437 make_symbol_constant (intern_c_string ("font-weight-table"));
5439 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5440 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5441 See `font-weight-table' for the format of the vector.
5442 This variable cannot be set; trying to do so will signal an error. */);
5443 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5444 make_symbol_constant (intern_c_string ("font-slant-table"));
5446 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5447 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5448 See `font-weight-table' for the format of the vector.
5449 This variable cannot be set; trying to do so will signal an error. */);
5450 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5451 make_symbol_constant (intern_c_string ("font-width-table"));
5453 staticpro (&font_style_table
);
5454 font_style_table
= make_uninit_vector (3);
5455 ASET (font_style_table
, 0, Vfont_weight_table
);
5456 ASET (font_style_table
, 1, Vfont_slant_table
);
5457 ASET (font_style_table
, 2, Vfont_width_table
);
5459 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5460 A list that logs font-related actions and results, for debugging.
5461 The default value is t, which means to suppress logging.
5462 Set it to nil to enable logging. If the environment variable
5463 EMACS_FONT_LOG is set at startup, it defaults to nil. */);
5466 DEFVAR_BOOL ("inhibit-compacting-font-caches", inhibit_compacting_font_caches
,
5468 If non-nil, don't compact font caches during GC.
5469 Some large fonts cause lots of consing and trigger GC. If they
5470 are removed from the font caches, they will need to be opened
5471 again during redisplay, which slows down redisplay. If you
5472 see font-related delays in displaying some special characters,
5473 and cannot switch to a smaller font for those characters, set
5474 this variable non-nil.
5475 Disabling compaction of font caches might enlarge the Emacs memory
5476 footprint in sessions that use lots of different fonts. */);
5477 inhibit_compacting_font_caches
= 0;
5479 DEFVAR_BOOL ("xft-ignore-color-fonts",
5480 Vxft_ignore_color_fonts
,
5482 Non-nil means don't query fontconfig for color fonts, since they often
5483 cause Xft crashes. Only has an effect in Xft builds. */);
5484 Vxft_ignore_color_fonts
= 1;
5486 #ifdef HAVE_WINDOW_SYSTEM
5487 #ifdef HAVE_FREETYPE
5489 #ifdef HAVE_X_WINDOWS
5491 syms_of_ftcrfont ();
5497 #endif /* HAVE_XFT */
5498 #endif /* not USE_CAIRO */
5499 #endif /* HAVE_X_WINDOWS */
5500 #else /* not HAVE_FREETYPE */
5501 #ifdef HAVE_X_WINDOWS
5503 #endif /* HAVE_X_WINDOWS */
5504 #endif /* not HAVE_FREETYPE */
5507 #endif /* HAVE_BDFFONT */
5510 #endif /* HAVE_NTGUI */
5511 #endif /* HAVE_WINDOW_SYSTEM */
5517 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;