1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2014 Free Software Foundation, Inc.
4 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
30 #include "character.h"
34 #include "dispextern.h"
36 #include "composite.h"
40 #ifdef HAVE_WINDOW_SYSTEM
42 #endif /* HAVE_WINDOW_SYSTEM */
45 # define MAX(a, b) ((a) > (b) ? (a) : (b))
48 Lisp_Object Qopentype
;
50 /* Important character set strings. */
51 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
53 #define DEFAULT_ENCODING Qiso8859_1
55 /* Unicode category `Cf'. */
56 static Lisp_Object QCf
;
58 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
59 static Lisp_Object font_style_table
;
61 /* Structure used for tables mapping weight, slant, and width numeric
62 values and their names. */
67 /* The first one is a valid name as a face attribute.
68 The second one (if any) is a typical name in XLFD field. */
72 /* Table of weight numeric values and their names. This table must be
73 sorted by numeric values in ascending order. */
75 static const struct table_entry weight_table
[] =
78 { 20, { "ultra-light", "ultralight" }},
79 { 40, { "extra-light", "extralight" }},
81 { 75, { "semi-light", "semilight", "demilight", "book" }},
82 { 100, { "normal", "medium", "regular", "unspecified" }},
83 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
85 { 205, { "extra-bold", "extrabold" }},
86 { 210, { "ultra-bold", "ultrabold", "black" }}
89 /* Table of slant numeric values and their names. This table must be
90 sorted by numeric values in ascending order. */
92 static const struct table_entry slant_table
[] =
94 { 0, { "reverse-oblique", "ro" }},
95 { 10, { "reverse-italic", "ri" }},
96 { 100, { "normal", "r", "unspecified" }},
97 { 200, { "italic" ,"i", "ot" }},
98 { 210, { "oblique", "o" }}
101 /* Table of width numeric values and their names. This table must be
102 sorted by numeric values in ascending order. */
104 static const struct table_entry width_table
[] =
106 { 50, { "ultra-condensed", "ultracondensed" }},
107 { 63, { "extra-condensed", "extracondensed" }},
108 { 75, { "condensed", "compressed", "narrow" }},
109 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
110 { 100, { "normal", "medium", "regular", "unspecified" }},
111 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
112 { 125, { "expanded" }},
113 { 150, { "extra-expanded", "extraexpanded" }},
114 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
117 Lisp_Object QCfoundry
;
118 static Lisp_Object QCadstyle
, QCregistry
;
119 /* Symbols representing keys of font extra info. */
120 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
121 Lisp_Object QCantialias
, QCfont_entity
;
122 static Lisp_Object QCfc_unknown_spec
;
123 /* Symbols representing values of font spacing property. */
124 static Lisp_Object Qc
, Qm
, Qd
;
126 /* Special ADSTYLE properties to avoid fonts used for Latin
127 characters; used in xfont.c and ftfont.c. */
128 Lisp_Object Qja
, Qko
;
130 static Lisp_Object QCuser_spec
;
132 /* Alist of font registry symbols and the corresponding charset
133 information. The information is retrieved from
134 Vfont_encoding_alist on demand.
136 Eash element has the form:
137 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
141 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
142 encodes a character code to a glyph code of a font, and
143 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
144 character is supported by a font.
146 The latter form means that the information for REGISTRY couldn't be
148 static Lisp_Object font_charset_alist
;
150 /* List of all font drivers. Each font-backend (XXXfont.c) calls
151 register_font_driver in syms_of_XXXfont to register its font-driver
153 static struct font_driver_list
*font_driver_list
;
155 #ifdef ENABLE_CHECKING
157 /* Used to catch bogus pointers in font objects. */
160 valid_font_driver (struct font_driver
*drv
)
162 Lisp_Object tail
, frame
;
163 struct font_driver_list
*fdl
;
165 for (fdl
= font_driver_list
; fdl
; fdl
= fdl
->next
)
166 if (fdl
->driver
== drv
)
168 FOR_EACH_FRAME (tail
, frame
)
169 for (fdl
= XFRAME (frame
)->font_driver_list
; fdl
; fdl
= fdl
->next
)
170 if (fdl
->driver
== drv
)
175 #endif /* ENABLE_CHECKING */
177 /* Creators of font-related Lisp object. */
180 font_make_spec (void)
182 Lisp_Object font_spec
;
183 struct font_spec
*spec
184 = ((struct font_spec
*)
185 allocate_pseudovector (VECSIZE (struct font_spec
),
186 FONT_SPEC_MAX
, PVEC_FONT
));
187 XSETFONT (font_spec
, spec
);
192 font_make_entity (void)
194 Lisp_Object font_entity
;
195 struct font_entity
*entity
196 = ((struct font_entity
*)
197 allocate_pseudovector (VECSIZE (struct font_entity
),
198 FONT_ENTITY_MAX
, PVEC_FONT
));
199 XSETFONT (font_entity
, entity
);
203 /* Create a font-object whose structure size is SIZE. If ENTITY is
204 not nil, copy properties from ENTITY to the font-object. If
205 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
207 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
209 Lisp_Object font_object
;
211 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
214 /* GC can happen before the driver is set up,
215 so avoid dangling pointer here (Bug#17771). */
217 XSETFONT (font_object
, font
);
221 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
222 font
->props
[i
] = AREF (entity
, i
);
223 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
224 font
->props
[FONT_EXTRA_INDEX
]
225 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
228 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
232 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
234 static int font_unparse_fcname (Lisp_Object
, int, char *, int);
236 /* Like above, but also set `type', `name' and `fullname' properties
240 font_build_object (int vectorsize
, Lisp_Object type
,
241 Lisp_Object entity
, double pixelsize
)
245 Lisp_Object font_object
= font_make_object (vectorsize
, entity
, pixelsize
);
247 ASET (font_object
, FONT_TYPE_INDEX
, type
);
248 len
= font_unparse_xlfd (entity
, pixelsize
, name
, sizeof name
);
250 ASET (font_object
, FONT_NAME_INDEX
, make_string (name
, len
));
251 len
= font_unparse_fcname (entity
, pixelsize
, name
, sizeof name
);
253 ASET (font_object
, FONT_FULLNAME_INDEX
, make_string (name
, len
));
255 ASET (font_object
, FONT_FULLNAME_INDEX
,
256 AREF (font_object
, FONT_NAME_INDEX
));
260 #endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */
262 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
263 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
264 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
266 static unsigned font_encode_char (Lisp_Object
, int);
268 /* Number of registered font drivers. */
269 static int num_font_drivers
;
272 /* Return a Lispy value of a font property value at STR and LEN bytes.
273 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
274 consist entirely of one or more digits, return a symbol interned
275 from STR. Otherwise, return an integer. */
278 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
280 ptrdiff_t i
, nbytes
, nchars
;
281 Lisp_Object tem
, name
, obarray
;
283 if (len
== 1 && *str
== '*')
285 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
287 for (i
= 1; i
< len
; i
++)
288 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
295 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
298 return make_number (n
);
299 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
303 xsignal1 (Qoverflow_error
, make_string (str
, len
));
307 /* This code is similar to intern function from lread.c. */
308 obarray
= check_obarray (Vobarray
);
309 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
310 tem
= oblookup (obarray
, str
,
311 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
314 name
= make_specified_string (str
, nchars
, len
,
315 len
!= nchars
&& len
== nbytes
);
316 return intern_driver (name
, obarray
, XINT (tem
));
319 /* Return a pixel size of font-spec SPEC on frame F. */
322 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
324 #ifdef HAVE_WINDOW_SYSTEM
325 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
334 eassert (FLOATP (size
));
335 point_size
= XFLOAT_DATA (size
);
336 val
= AREF (spec
, FONT_DPI_INDEX
);
340 dpi
= FRAME_RES_Y (f
);
341 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
349 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
350 font vector. If VAL is not valid (i.e. not registered in
351 font_style_table), return -1 if NOERROR is zero, and return a
352 proper index if NOERROR is nonzero. In that case, register VAL in
353 font_style_table if VAL is a symbol, and return the closest index if
354 VAL is an integer. */
357 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
360 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
363 CHECK_VECTOR (table
);
370 Lisp_Object args
[2], elt
;
372 /* At first try exact match. */
373 for (i
= 0; i
< len
; i
++)
375 CHECK_VECTOR (AREF (table
, i
));
376 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
377 if (EQ (val
, AREF (AREF (table
, i
), j
)))
379 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
380 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
381 | (i
<< 4) | (j
- 1));
384 /* Try also with case-folding match. */
385 s
= SSDATA (SYMBOL_NAME (val
));
386 for (i
= 0; i
< len
; i
++)
387 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
389 elt
= AREF (AREF (table
, i
), j
);
390 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
392 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
393 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
394 | (i
<< 4) | (j
- 1));
400 elt
= Fmake_vector (make_number (2), make_number (100));
403 args
[1] = Fmake_vector (make_number (1), elt
);
404 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
405 return (100 << 8) | (i
<< 4);
410 EMACS_INT numeric
= XINT (val
);
412 for (i
= 0, last_n
= -1; i
< len
; i
++)
416 CHECK_VECTOR (AREF (table
, i
));
417 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
418 n
= XINT (AREF (AREF (table
, i
), 0));
420 return (n
<< 8) | (i
<< 4);
425 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
426 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
432 return ((last_n
<< 8) | ((i
- 1) << 4));
437 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
440 Lisp_Object val
= AREF (font
, prop
);
441 Lisp_Object table
, elt
;
446 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
447 CHECK_VECTOR (table
);
448 i
= XINT (val
) & 0xFF;
449 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
450 elt
= AREF (table
, ((i
>> 4) & 0xF));
452 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
453 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
458 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
459 FONTNAME. ENCODING is a charset symbol that specifies the encoding
460 of the font. REPERTORY is a charset symbol or nil. */
463 find_font_encoding (Lisp_Object fontname
)
465 Lisp_Object tail
, elt
;
467 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
471 && STRINGP (XCAR (elt
))
472 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
473 && (SYMBOLP (XCDR (elt
))
474 ? CHARSETP (XCDR (elt
))
475 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
481 /* Return encoding charset and repertory charset for REGISTRY in
482 ENCODING and REPERTORY correspondingly. If correct information for
483 REGISTRY is available, return 0. Otherwise return -1. */
486 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
489 int encoding_id
, repertory_id
;
491 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
497 encoding_id
= XINT (XCAR (val
));
498 repertory_id
= XINT (XCDR (val
));
502 val
= find_font_encoding (SYMBOL_NAME (registry
));
503 if (SYMBOLP (val
) && CHARSETP (val
))
505 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
507 else if (CONSP (val
))
509 if (! CHARSETP (XCAR (val
)))
511 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
512 if (NILP (XCDR (val
)))
516 if (! CHARSETP (XCDR (val
)))
518 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
523 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
525 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
529 *encoding
= CHARSET_FROM_ID (encoding_id
);
531 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
536 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
541 /* Font property value validators. See the comment of
542 font_property_table for the meaning of the arguments. */
544 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
545 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
546 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
547 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
548 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
549 static int get_font_prop_index (Lisp_Object
);
552 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
555 val
= Fintern (val
, Qnil
);
558 else if (EQ (prop
, QCregistry
))
559 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
565 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
567 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
568 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
572 EMACS_INT n
= XINT (val
);
573 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
575 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
579 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
582 if ((n
& 0xF) + 1 >= ASIZE (elt
))
586 CHECK_NUMBER (AREF (elt
, 0));
587 if (XINT (AREF (elt
, 0)) != (n
>> 8))
592 else if (SYMBOLP (val
))
594 int n
= font_style_to_value (prop
, val
, 0);
596 val
= n
>= 0 ? make_number (n
) : Qerror
;
604 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
606 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
611 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
613 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
615 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
617 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
619 if (spacing
== 'c' || spacing
== 'C')
620 return make_number (FONT_SPACING_CHARCELL
);
621 if (spacing
== 'm' || spacing
== 'M')
622 return make_number (FONT_SPACING_MONO
);
623 if (spacing
== 'p' || spacing
== 'P')
624 return make_number (FONT_SPACING_PROPORTIONAL
);
625 if (spacing
== 'd' || spacing
== 'D')
626 return make_number (FONT_SPACING_DUAL
);
632 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
634 Lisp_Object tail
, tmp
;
637 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
638 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
639 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
642 if (! SYMBOLP (XCAR (val
)))
647 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
649 for (i
= 0; i
< 2; i
++)
656 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
657 if (! SYMBOLP (XCAR (tmp
)))
665 /* Structure of known font property keys and validator of the
669 /* Pointer to the key symbol. */
671 /* Function to validate PROP's value VAL, or NULL if any value is
672 ok. The value is VAL or its regularized value if VAL is valid,
673 and Qerror if not. */
674 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
675 } font_property_table
[] =
676 { { &QCtype
, font_prop_validate_symbol
},
677 { &QCfoundry
, font_prop_validate_symbol
},
678 { &QCfamily
, font_prop_validate_symbol
},
679 { &QCadstyle
, font_prop_validate_symbol
},
680 { &QCregistry
, font_prop_validate_symbol
},
681 { &QCweight
, font_prop_validate_style
},
682 { &QCslant
, font_prop_validate_style
},
683 { &QCwidth
, font_prop_validate_style
},
684 { &QCsize
, font_prop_validate_non_neg
},
685 { &QCdpi
, font_prop_validate_non_neg
},
686 { &QCspacing
, font_prop_validate_spacing
},
687 { &QCavgwidth
, font_prop_validate_non_neg
},
688 /* The order of the above entries must match with enum
689 font_property_index. */
690 { &QClang
, font_prop_validate_symbol
},
691 { &QCscript
, font_prop_validate_symbol
},
692 { &QCotf
, font_prop_validate_otf
}
695 /* Return an index number of font property KEY or -1 if KEY is not an
696 already known property. */
699 get_font_prop_index (Lisp_Object key
)
703 for (i
= 0; i
< ARRAYELTS (font_property_table
); i
++)
704 if (EQ (key
, *font_property_table
[i
].key
))
709 /* Validate the font property. The property key is specified by the
710 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
711 signal an error. The value is VAL or the regularized one. */
714 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
716 Lisp_Object validated
;
721 prop
= *font_property_table
[idx
].key
;
724 idx
= get_font_prop_index (prop
);
728 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
729 if (EQ (validated
, Qerror
))
730 signal_error ("invalid font property", Fcons (prop
, val
));
735 /* Store VAL as a value of extra font property PROP in FONT while
736 keeping the sorting order. Don't check the validity of VAL. */
739 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
741 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
742 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
746 Lisp_Object prev
= Qnil
;
749 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
750 prev
= extra
, extra
= XCDR (extra
);
753 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
755 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
761 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
766 /* Font name parser and unparser. */
768 static int parse_matrix (const char *);
769 static int font_expand_wildcards (Lisp_Object
*, int);
770 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
772 /* An enumerator for each field of an XLFD font name. */
773 enum xlfd_field_index
792 /* An enumerator for mask bit corresponding to each XLFD field. */
795 XLFD_FOUNDRY_MASK
= 0x0001,
796 XLFD_FAMILY_MASK
= 0x0002,
797 XLFD_WEIGHT_MASK
= 0x0004,
798 XLFD_SLANT_MASK
= 0x0008,
799 XLFD_SWIDTH_MASK
= 0x0010,
800 XLFD_ADSTYLE_MASK
= 0x0020,
801 XLFD_PIXEL_MASK
= 0x0040,
802 XLFD_POINT_MASK
= 0x0080,
803 XLFD_RESX_MASK
= 0x0100,
804 XLFD_RESY_MASK
= 0x0200,
805 XLFD_SPACING_MASK
= 0x0400,
806 XLFD_AVGWIDTH_MASK
= 0x0800,
807 XLFD_REGISTRY_MASK
= 0x1000,
808 XLFD_ENCODING_MASK
= 0x2000
812 /* Parse P pointing to the pixel/point size field of the form
813 `[A B C D]' which specifies a transformation matrix:
819 by which all glyphs of the font are transformed. The spec says
820 that scalar value N for the pixel/point size is equivalent to:
821 A = N * resx/resy, B = C = 0, D = N.
823 Return the scalar value N if the form is valid. Otherwise return
827 parse_matrix (const char *p
)
833 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
836 matrix
[i
] = - strtod (p
+ 1, &end
);
838 matrix
[i
] = strtod (p
, &end
);
841 return (i
== 4 ? (int) matrix
[3] : -1);
844 /* Expand a wildcard field in FIELD (the first N fields are filled) to
845 multiple fields to fill in all 14 XLFD fields while restricting a
846 field position by its contents. */
849 font_expand_wildcards (Lisp_Object
*field
, int n
)
852 Lisp_Object tmp
[XLFD_LAST_INDEX
];
853 /* Array of information about where this element can go. Nth
854 element is for Nth element of FIELD. */
856 /* Minimum possible field. */
858 /* Maximum possible field. */
860 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
862 } range
[XLFD_LAST_INDEX
];
864 int range_from
, range_to
;
867 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
868 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
869 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
870 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
871 | XLFD_AVGWIDTH_MASK)
872 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
874 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
875 field. The value is shifted to left one bit by one in the
877 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
878 range_mask
= (range_mask
<< 1) | 1;
880 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
881 position-based restriction for FIELD[I]. */
882 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
883 i
++, range_from
++, range_to
++, range_mask
<<= 1)
885 Lisp_Object val
= field
[i
];
891 range
[i
].from
= range_from
;
892 range
[i
].to
= range_to
;
893 range
[i
].mask
= range_mask
;
897 /* The triplet FROM, TO, and MASK is a value-based
898 restriction for FIELD[I]. */
904 EMACS_INT numeric
= XINT (val
);
907 from
= to
= XLFD_ENCODING_INDEX
,
908 mask
= XLFD_ENCODING_MASK
;
909 else if (numeric
== 0)
910 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
911 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
912 else if (numeric
<= 48)
913 from
= to
= XLFD_PIXEL_INDEX
,
914 mask
= XLFD_PIXEL_MASK
;
916 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
917 mask
= XLFD_LARGENUM_MASK
;
919 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
920 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
921 mask
= XLFD_NULL_MASK
;
923 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
926 Lisp_Object name
= SYMBOL_NAME (val
);
928 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
929 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
930 mask
= XLFD_REGENC_MASK
;
932 from
= to
= XLFD_ENCODING_INDEX
,
933 mask
= XLFD_ENCODING_MASK
;
935 else if (range_from
<= XLFD_WEIGHT_INDEX
936 && range_to
>= XLFD_WEIGHT_INDEX
937 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
938 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
939 else if (range_from
<= XLFD_SLANT_INDEX
940 && range_to
>= XLFD_SLANT_INDEX
941 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
942 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
943 else if (range_from
<= XLFD_SWIDTH_INDEX
944 && range_to
>= XLFD_SWIDTH_INDEX
945 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
946 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
949 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
950 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
952 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
953 mask
= XLFD_SYMBOL_MASK
;
956 /* Merge position-based and value-based restrictions. */
958 while (from
< range_from
)
959 mask
&= ~(1 << from
++);
960 while (from
< 14 && ! (mask
& (1 << from
)))
962 while (to
> range_to
)
963 mask
&= ~(1 << to
--);
964 while (to
>= 0 && ! (mask
& (1 << to
)))
968 range
[i
].from
= from
;
970 range
[i
].mask
= mask
;
972 if (from
> range_from
|| to
< range_to
)
974 /* The range is narrowed by value-based restrictions.
975 Reflect it to the other fields. */
977 /* Following fields should be after FROM. */
979 /* Preceding fields should be before TO. */
980 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
982 /* Check FROM for non-wildcard field. */
983 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
985 while (range
[j
].from
< from
)
986 range
[j
].mask
&= ~(1 << range
[j
].from
++);
987 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
989 range
[j
].from
= from
;
992 from
= range
[j
].from
;
993 if (range
[j
].to
> to
)
995 while (range
[j
].to
> to
)
996 range
[j
].mask
&= ~(1 << range
[j
].to
--);
997 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
1010 /* Decide all fields from restrictions in RANGE. */
1011 for (i
= j
= 0; i
< n
; i
++)
1013 if (j
< range
[i
].from
)
1015 if (i
== 0 || ! NILP (tmp
[i
- 1]))
1016 /* None of TMP[X] corresponds to Jth field. */
1018 for (; j
< range
[i
].from
; j
++)
1021 field
[j
++] = tmp
[i
];
1023 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1025 for (; j
< XLFD_LAST_INDEX
; j
++)
1027 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1028 field
[XLFD_ENCODING_INDEX
]
1029 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1034 /* Parse NAME (null terminated) as XLFD and store information in FONT
1035 (font-spec or font-entity). Size property of FONT is set as
1037 specified XLFD fields FONT property
1038 --------------------- -------------
1039 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1040 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1041 POINT_SIZE POINT_SIZE/10 (Lisp float)
1043 If NAME is successfully parsed, return 0. Otherwise return -1.
1045 FONT is usually a font-spec, but when this function is called from
1046 X font backend driver, it is a font-entity. In that case, NAME is
1047 a fully specified XLFD. */
1050 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1053 char *f
[XLFD_LAST_INDEX
+ 1];
1057 if (len
> 255 || !len
)
1058 /* Maximum XLFD name length is 255. */
1060 /* Accept "*-.." as a fully specified XLFD. */
1061 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1062 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1065 for (p
= name
+ i
; *p
; p
++)
1069 if (i
== XLFD_LAST_INDEX
)
1074 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1075 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1077 if (i
== XLFD_LAST_INDEX
)
1079 /* Fully specified XLFD. */
1082 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1083 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1084 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1085 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1087 val
= INTERN_FIELD_SYM (i
);
1090 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1092 ASET (font
, j
, make_number (n
));
1095 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1096 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1097 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1099 ASET (font
, FONT_REGISTRY_INDEX
,
1100 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1101 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1103 p
= f
[XLFD_PIXEL_INDEX
];
1104 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1105 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1108 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1110 ASET (font
, FONT_SIZE_INDEX
, val
);
1111 else if (FONT_ENTITY_P (font
))
1115 double point_size
= -1;
1117 eassert (FONT_SPEC_P (font
));
1118 p
= f
[XLFD_POINT_INDEX
];
1120 point_size
= parse_matrix (p
);
1121 else if (c_isdigit (*p
))
1122 point_size
= atoi (p
), point_size
/= 10;
1123 if (point_size
>= 0)
1124 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1128 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1129 if (! NILP (val
) && ! INTEGERP (val
))
1131 ASET (font
, FONT_DPI_INDEX
, val
);
1132 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1135 val
= font_prop_validate_spacing (QCspacing
, val
);
1136 if (! INTEGERP (val
))
1138 ASET (font
, FONT_SPACING_INDEX
, val
);
1140 p
= f
[XLFD_AVGWIDTH_INDEX
];
1143 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1144 if (! NILP (val
) && ! INTEGERP (val
))
1146 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1150 bool wild_card_found
= 0;
1151 Lisp_Object prop
[XLFD_LAST_INDEX
];
1153 if (FONT_ENTITY_P (font
))
1155 for (j
= 0; j
< i
; j
++)
1159 if (f
[j
][1] && f
[j
][1] != '-')
1162 wild_card_found
= 1;
1165 prop
[j
] = INTERN_FIELD (j
);
1167 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1169 if (! wild_card_found
)
1171 if (font_expand_wildcards (prop
, i
) < 0)
1174 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1175 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1176 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1177 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1178 if (! NILP (prop
[i
]))
1180 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1182 ASET (font
, j
, make_number (n
));
1184 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1185 val
= prop
[XLFD_REGISTRY_INDEX
];
1188 val
= prop
[XLFD_ENCODING_INDEX
];
1190 val
= concat2 (build_local_string ("*-"), SYMBOL_NAME (val
));
1192 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1193 val
= concat2 (SYMBOL_NAME (val
), build_local_string ("-*"));
1195 val
= concat3 (SYMBOL_NAME (val
), build_local_string ("-"),
1196 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1198 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1200 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1201 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1202 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1204 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1206 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1209 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1210 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1211 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1213 val
= font_prop_validate_spacing (QCspacing
,
1214 prop
[XLFD_SPACING_INDEX
]);
1215 if (! INTEGERP (val
))
1217 ASET (font
, FONT_SPACING_INDEX
, val
);
1219 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1220 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1226 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1227 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1228 0, use PIXEL_SIZE instead. */
1231 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1234 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1238 eassert (FONTP (font
));
1240 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1243 if (i
== FONT_ADSTYLE_INDEX
)
1244 j
= XLFD_ADSTYLE_INDEX
;
1245 else if (i
== FONT_REGISTRY_INDEX
)
1246 j
= XLFD_REGISTRY_INDEX
;
1247 val
= AREF (font
, i
);
1250 if (j
== XLFD_REGISTRY_INDEX
)
1258 val
= SYMBOL_NAME (val
);
1259 if (j
== XLFD_REGISTRY_INDEX
1260 && ! strchr (SSDATA (val
), '-'))
1262 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1263 ptrdiff_t alloc
= SBYTES (val
) + 4;
1264 if (nbytes
<= alloc
)
1266 f
[j
] = p
= alloca (alloc
);
1267 sprintf (p
, "%s%s-*", SDATA (val
),
1268 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1271 f
[j
] = SSDATA (val
);
1275 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1278 val
= font_style_symbolic (font
, i
, 0);
1286 val
= SYMBOL_NAME (val
);
1287 alloc
= SBYTES (val
) + 1;
1288 if (nbytes
<= alloc
)
1290 f
[j
] = p
= alloca (alloc
);
1291 /* Copy the name while excluding '-', '?', ',', and '"'. */
1292 for (k
= l
= 0; k
< alloc
; k
++)
1295 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1301 val
= AREF (font
, FONT_SIZE_INDEX
);
1302 eassert (NUMBERP (val
) || NILP (val
));
1303 char font_size_index_buf
[sizeof "-*"
1304 + MAX (INT_STRLEN_BOUND (EMACS_INT
),
1305 1 + DBL_MAX_10_EXP
+ 1)];
1308 EMACS_INT v
= XINT (val
);
1313 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1314 sprintf (p
, "%"pI
"d-*", v
);
1317 f
[XLFD_PIXEL_INDEX
] = "*-*";
1319 else if (FLOATP (val
))
1321 double v
= XFLOAT_DATA (val
) * 10;
1322 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1323 sprintf (p
, "*-%.0f", v
);
1326 f
[XLFD_PIXEL_INDEX
] = "*-*";
1328 char dpi_index_buf
[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
)];
1329 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1331 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1332 f
[XLFD_RESX_INDEX
] = p
= dpi_index_buf
;
1333 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1336 f
[XLFD_RESX_INDEX
] = "*-*";
1338 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1340 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1342 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1343 : spacing
<= FONT_SPACING_DUAL
? "d"
1344 : spacing
<= FONT_SPACING_MONO
? "m"
1348 f
[XLFD_SPACING_INDEX
] = "*";
1350 char avgwidth_index_buf
[INT_BUFSIZE_BOUND (EMACS_INT
)];
1351 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1353 f
[XLFD_AVGWIDTH_INDEX
] = p
= avgwidth_index_buf
;
1354 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1357 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1359 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1360 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1361 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1362 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1363 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1364 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1365 f
[XLFD_REGISTRY_INDEX
]);
1366 return len
< nbytes
? len
: -1;
1369 /* Parse NAME (null terminated) and store information in FONT
1370 (font-spec or font-entity). NAME is supplied in either the
1371 Fontconfig or GTK font name format. If NAME is successfully
1372 parsed, return 0. Otherwise return -1.
1374 The fontconfig format is
1376 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1380 FAMILY [PROPS...] [SIZE]
1382 This function tries to guess which format it is. */
1385 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1388 char *size_beg
= NULL
, *size_end
= NULL
;
1389 char *props_beg
= NULL
, *family_end
= NULL
;
1394 for (p
= name
; *p
; p
++)
1396 if (*p
== '\\' && p
[1])
1400 props_beg
= family_end
= p
;
1405 bool decimal
= 0, size_found
= 1;
1406 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1407 if (! c_isdigit (*q
))
1409 if (*q
!= '.' || decimal
)
1428 Lisp_Object extra_props
= Qnil
;
1430 /* A fontconfig name with size and/or property data. */
1431 if (family_end
> name
)
1434 family
= font_intern_prop (name
, family_end
- name
, 1);
1435 ASET (font
, FONT_FAMILY_INDEX
, family
);
1439 double point_size
= strtod (size_beg
, &size_end
);
1440 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1441 if (*size_end
== ':' && size_end
[1])
1442 props_beg
= size_end
;
1446 /* Now parse ":KEY=VAL" patterns. */
1449 for (p
= props_beg
; *p
; p
= q
)
1451 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1454 /* Must be an enumerated value. */
1458 val
= font_intern_prop (p
, q
- p
, 1);
1460 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1461 && memcmp (p, STR, strlen (STR)) == 0)
1463 if (PROP_MATCH ("light")
1464 || PROP_MATCH ("medium")
1465 || PROP_MATCH ("demibold")
1466 || PROP_MATCH ("bold")
1467 || PROP_MATCH ("black"))
1468 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1469 else if (PROP_MATCH ("roman")
1470 || PROP_MATCH ("italic")
1471 || PROP_MATCH ("oblique"))
1472 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1473 else if (PROP_MATCH ("charcell"))
1474 ASET (font
, FONT_SPACING_INDEX
,
1475 make_number (FONT_SPACING_CHARCELL
));
1476 else if (PROP_MATCH ("mono"))
1477 ASET (font
, FONT_SPACING_INDEX
,
1478 make_number (FONT_SPACING_MONO
));
1479 else if (PROP_MATCH ("proportional"))
1480 ASET (font
, FONT_SPACING_INDEX
,
1481 make_number (FONT_SPACING_PROPORTIONAL
));
1490 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1491 prop
= FONT_SIZE_INDEX
;
1494 key
= font_intern_prop (p
, q
- p
, 1);
1495 prop
= get_font_prop_index (key
);
1499 for (q
= p
; *q
&& *q
!= ':'; q
++);
1500 val
= font_intern_prop (p
, q
- p
, 0);
1502 if (prop
>= FONT_FOUNDRY_INDEX
1503 && prop
< FONT_EXTRA_INDEX
)
1504 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1507 extra_props
= nconc2 (extra_props
,
1508 list1 (Fcons (key
, val
)));
1515 if (! NILP (extra_props
))
1517 struct font_driver_list
*driver_list
= font_driver_list
;
1518 for ( ; driver_list
; driver_list
= driver_list
->next
)
1519 if (driver_list
->driver
->filter_properties
)
1520 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1526 /* Either a fontconfig-style name with no size and property
1527 data, or a GTK-style name. */
1528 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1529 Lisp_Object width
= Qnil
, size
= Qnil
;
1533 /* Scan backwards from the end, looking for a size. */
1534 for (p
= name
+ len
- 1; p
>= name
; p
--)
1535 if (!c_isdigit (*p
))
1538 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1539 /* Found a font size. */
1540 size
= make_float (strtod (p
+ 1, NULL
));
1544 /* Now P points to the termination of the string, sans size.
1545 Scan backwards, looking for font properties. */
1546 for (; p
> name
; p
= q
)
1548 for (q
= p
- 1; q
>= name
; q
--)
1550 if (q
> name
&& *(q
-1) == '\\')
1551 --q
; /* Skip quoting backslashes. */
1557 word_len
= p
- word_start
;
1559 #define PROP_MATCH(STR) \
1560 (word_len == strlen (STR) \
1561 && memcmp (word_start, STR, strlen (STR)) == 0)
1562 #define PROP_SAVE(VAR, STR) \
1563 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1565 if (PROP_MATCH ("Ultra-Light"))
1566 PROP_SAVE (weight
, "ultra-light");
1567 else if (PROP_MATCH ("Light"))
1568 PROP_SAVE (weight
, "light");
1569 else if (PROP_MATCH ("Book"))
1570 PROP_SAVE (weight
, "book");
1571 else if (PROP_MATCH ("Medium"))
1572 PROP_SAVE (weight
, "medium");
1573 else if (PROP_MATCH ("Semi-Bold"))
1574 PROP_SAVE (weight
, "semi-bold");
1575 else if (PROP_MATCH ("Bold"))
1576 PROP_SAVE (weight
, "bold");
1577 else if (PROP_MATCH ("Italic"))
1578 PROP_SAVE (slant
, "italic");
1579 else if (PROP_MATCH ("Oblique"))
1580 PROP_SAVE (slant
, "oblique");
1581 else if (PROP_MATCH ("Semi-Condensed"))
1582 PROP_SAVE (width
, "semi-condensed");
1583 else if (PROP_MATCH ("Condensed"))
1584 PROP_SAVE (width
, "condensed");
1585 /* An unknown word must be part of the font name. */
1596 ASET (font
, FONT_FAMILY_INDEX
,
1597 font_intern_prop (name
, family_end
- name
, 1));
1599 ASET (font
, FONT_SIZE_INDEX
, size
);
1601 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1603 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1605 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1611 #if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
1613 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1614 NAME (NBYTES length), and return the name length. If
1615 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
1616 Return a negative value on error. */
1619 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1621 Lisp_Object family
, foundry
;
1627 Lisp_Object styles
[3];
1628 const char *style_names
[3] = { "weight", "slant", "width" };
1630 family
= AREF (font
, FONT_FAMILY_INDEX
);
1631 if (! NILP (family
))
1633 if (SYMBOLP (family
))
1634 family
= SYMBOL_NAME (family
);
1639 val
= AREF (font
, FONT_SIZE_INDEX
);
1642 if (XINT (val
) != 0)
1643 pixel_size
= XINT (val
);
1648 eassert (FLOATP (val
));
1650 point_size
= (int) XFLOAT_DATA (val
);
1653 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1654 if (! NILP (foundry
))
1656 if (SYMBOLP (foundry
))
1657 foundry
= SYMBOL_NAME (foundry
);
1662 for (i
= 0; i
< 3; i
++)
1663 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1666 lim
= name
+ nbytes
;
1667 if (! NILP (family
))
1669 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1670 if (! (0 <= len
&& len
< lim
- p
))
1676 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1677 if (! (0 <= len
&& len
< lim
- p
))
1681 else if (pixel_size
> 0)
1683 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1684 if (! (0 <= len
&& len
< lim
- p
))
1688 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1690 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1691 SSDATA (SYMBOL_NAME (AREF (font
,
1692 FONT_FOUNDRY_INDEX
))));
1693 if (! (0 <= len
&& len
< lim
- p
))
1697 for (i
= 0; i
< 3; i
++)
1698 if (! NILP (styles
[i
]))
1700 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1701 SSDATA (SYMBOL_NAME (styles
[i
])));
1702 if (! (0 <= len
&& len
< lim
- p
))
1707 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1709 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1710 XINT (AREF (font
, FONT_DPI_INDEX
)));
1711 if (! (0 <= len
&& len
< lim
- p
))
1716 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1718 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1719 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1720 if (! (0 <= len
&& len
< lim
- p
))
1725 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1727 int len
= snprintf (p
, lim
- p
,
1728 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1730 : ":scalable=false"));
1731 if (! (0 <= len
&& len
< lim
- p
))
1741 /* Parse NAME (null terminated) and store information in FONT
1742 (font-spec or font-entity). If NAME is successfully parsed, return
1743 0. Otherwise return -1. */
1746 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1748 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1749 return font_parse_xlfd (name
, namelen
, font
);
1750 return font_parse_fcname (name
, namelen
, font
);
1754 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1755 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1759 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1765 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1767 CHECK_STRING (family
);
1768 len
= SBYTES (family
);
1769 p0
= SSDATA (family
);
1770 p1
= strchr (p0
, '-');
1773 if ((*p0
!= '*' && p1
- p0
> 0)
1774 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1775 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1778 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1781 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1783 if (! NILP (registry
))
1785 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1786 CHECK_STRING (registry
);
1787 len
= SBYTES (registry
);
1788 p0
= SSDATA (registry
);
1789 p1
= strchr (p0
, '-');
1792 if (SDATA (registry
)[len
- 1] == '*')
1793 registry
= concat2 (registry
, build_local_string ("-*"));
1795 registry
= concat2 (registry
, build_local_string ("*-*"));
1797 registry
= Fdowncase (registry
);
1798 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1803 /* This part (through the next ^L) is still experimental and not
1804 tested much. We may drastically change codes. */
1810 #define LGSTRING_HEADER_SIZE 6
1811 #define LGSTRING_GLYPH_SIZE 8
1814 check_gstring (Lisp_Object gstring
)
1820 CHECK_VECTOR (gstring
);
1821 val
= AREF (gstring
, 0);
1823 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1825 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1826 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1827 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1828 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1829 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1830 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1831 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1832 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1833 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1834 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1835 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1837 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1839 val
= LGSTRING_GLYPH (gstring
, i
);
1841 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1843 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1845 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1846 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1847 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1848 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1849 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1850 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1851 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1852 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1854 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1856 if (ASIZE (val
) < 3)
1858 for (j
= 0; j
< 3; j
++)
1859 CHECK_NUMBER (AREF (val
, j
));
1864 error ("Invalid glyph-string format");
1869 check_otf_features (Lisp_Object otf_features
)
1873 CHECK_CONS (otf_features
);
1874 CHECK_SYMBOL (XCAR (otf_features
));
1875 otf_features
= XCDR (otf_features
);
1876 CHECK_CONS (otf_features
);
1877 CHECK_SYMBOL (XCAR (otf_features
));
1878 otf_features
= XCDR (otf_features
);
1879 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1881 CHECK_SYMBOL (XCAR (val
));
1882 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1883 error ("Invalid OTF GSUB feature: %s",
1884 SDATA (SYMBOL_NAME (XCAR (val
))));
1886 otf_features
= XCDR (otf_features
);
1887 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1889 CHECK_SYMBOL (XCAR (val
));
1890 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1891 error ("Invalid OTF GPOS feature: %s",
1892 SDATA (SYMBOL_NAME (XCAR (val
))));
1899 Lisp_Object otf_list
;
1902 otf_tag_symbol (OTF_Tag tag
)
1906 OTF_tag_name (tag
, name
);
1907 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1911 otf_open (Lisp_Object file
)
1913 Lisp_Object val
= Fassoc (file
, otf_list
);
1917 otf
= XSAVE_POINTER (XCDR (val
), 0);
1920 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1921 val
= make_save_ptr (otf
);
1922 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1928 /* Return a list describing which scripts/languages FONT supports by
1929 which GSUB/GPOS features of OpenType tables. See the comment of
1930 (struct font_driver).otf_capability. */
1933 font_otf_capability (struct font
*font
)
1936 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1939 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1942 for (i
= 0; i
< 2; i
++)
1944 OTF_GSUB_GPOS
*gsub_gpos
;
1945 Lisp_Object script_list
= Qnil
;
1948 if (OTF_get_features (otf
, i
== 0) < 0)
1950 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1951 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1953 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1954 Lisp_Object langsys_list
= Qnil
;
1955 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1958 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1960 OTF_LangSys
*langsys
;
1961 Lisp_Object feature_list
= Qnil
;
1962 Lisp_Object langsys_tag
;
1965 if (k
== script
->LangSysCount
)
1967 langsys
= &script
->DefaultLangSys
;
1972 langsys
= script
->LangSys
+ k
;
1974 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1976 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1978 OTF_Feature
*feature
1979 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1980 Lisp_Object feature_tag
1981 = otf_tag_symbol (feature
->FeatureTag
);
1983 feature_list
= Fcons (feature_tag
, feature_list
);
1985 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1988 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1993 XSETCAR (capability
, script_list
);
1995 XSETCDR (capability
, script_list
);
2001 /* Parse OTF features in SPEC and write a proper features spec string
2002 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2003 assured that the sufficient memory has already allocated for
2007 generate_otf_features (Lisp_Object spec
, char *features
)
2015 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2021 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2026 else if (! asterisk
)
2028 val
= SYMBOL_NAME (val
);
2029 p
+= esprintf (p
, "%s", SDATA (val
));
2033 val
= SYMBOL_NAME (val
);
2034 p
+= esprintf (p
, "~%s", SDATA (val
));
2038 error ("OTF spec too long");
2042 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
2044 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2046 return Fcons (make_number (len
),
2047 make_unibyte_string (device_table
->DeltaValue
, len
));
2051 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2053 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2055 if (value_format
& OTF_XPlacement
)
2056 ASET (val
, 0, make_number (value_record
->XPlacement
));
2057 if (value_format
& OTF_YPlacement
)
2058 ASET (val
, 1, make_number (value_record
->YPlacement
));
2059 if (value_format
& OTF_XAdvance
)
2060 ASET (val
, 2, make_number (value_record
->XAdvance
));
2061 if (value_format
& OTF_YAdvance
)
2062 ASET (val
, 3, make_number (value_record
->YAdvance
));
2063 if (value_format
& OTF_XPlaDevice
)
2064 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2065 if (value_format
& OTF_YPlaDevice
)
2066 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2067 if (value_format
& OTF_XAdvDevice
)
2068 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2069 if (value_format
& OTF_YAdvDevice
)
2070 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2075 font_otf_Anchor (OTF_Anchor
*anchor
)
2079 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2080 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2081 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2082 if (anchor
->AnchorFormat
== 2)
2083 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2086 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2087 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2091 #endif /* HAVE_LIBOTF */
2098 font_rescale_ratio (Lisp_Object font_entity
)
2100 Lisp_Object tail
, elt
;
2101 Lisp_Object name
= Qnil
;
2103 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2106 if (FLOATP (XCDR (elt
)))
2108 if (STRINGP (XCAR (elt
)))
2111 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2112 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2113 return XFLOAT_DATA (XCDR (elt
));
2115 else if (FONT_SPEC_P (XCAR (elt
)))
2117 if (font_match_p (XCAR (elt
), font_entity
))
2118 return XFLOAT_DATA (XCDR (elt
));
2125 /* We sort fonts by scoring each of them against a specified
2126 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2127 the value is, the closer the font is to the font-spec.
2129 The lowest 2 bits of the score are used for driver type. The font
2130 available by the most preferred font driver is 0.
2132 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2133 WEIGHT, SLANT, WIDTH, and SIZE. */
2135 /* How many bits to shift to store the difference value of each font
2136 property in a score. Note that floats for FONT_TYPE_INDEX and
2137 FONT_REGISTRY_INDEX are not used. */
2138 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2140 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2141 The return value indicates how different ENTITY is compared with
2145 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2150 /* Score three style numeric fields. Maximum difference is 127. */
2151 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2152 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2154 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2155 - (XINT (spec_prop
[i
]) >> 8));
2156 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2159 /* Score the size. Maximum difference is 127. */
2160 i
= FONT_SIZE_INDEX
;
2161 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2162 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2164 /* We use the higher 6-bit for the actual size difference. The
2165 lowest bit is set if the DPI is different. */
2167 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2168 EMACS_INT entity_size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
2170 if (CONSP (Vface_font_rescale_alist
))
2171 pixel_size
*= font_rescale_ratio (entity
);
2172 if (pixel_size
* 2 < entity_size
|| entity_size
* 2 < pixel_size
)
2173 /* This size is wrong by more than a factor 2: reject it! */
2175 diff
= eabs (pixel_size
- entity_size
) << 1;
2176 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2177 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2179 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2180 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2182 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2189 /* Concatenate all elements of LIST into one vector. LIST is a list
2190 of font-entity vectors. */
2193 font_vconcat_entity_vectors (Lisp_Object list
)
2195 EMACS_INT nargs
= XFASTINT (Flength (list
));
2198 SAFE_ALLOCA_LISP (args
, nargs
);
2201 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2202 args
[i
] = XCAR (list
);
2203 Lisp_Object result
= Fvconcat (nargs
, args
);
2209 /* The structure for elements being sorted by qsort. */
2210 struct font_sort_data
2213 int font_driver_preference
;
2218 /* The comparison function for qsort. */
2221 font_compare (const void *d1
, const void *d2
)
2223 const struct font_sort_data
*data1
= d1
;
2224 const struct font_sort_data
*data2
= d2
;
2226 if (data1
->score
< data2
->score
)
2228 else if (data1
->score
> data2
->score
)
2230 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2234 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2235 If PREFER specifies a point-size, calculate the corresponding
2236 pixel-size from QCdpi property of PREFER or from the Y-resolution
2237 of FRAME before sorting.
2239 If BEST-ONLY is nonzero, return the best matching entity (that
2240 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2241 if BEST-ONLY is negative). Otherwise, return the sorted result as
2242 a single vector of font-entities.
2244 This function does no optimization for the case that the total
2245 number of elements is 1. The caller should avoid calling this in
2249 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2250 struct frame
*f
, int best_only
)
2252 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2254 struct font_sort_data
*data
;
2255 unsigned best_score
;
2256 Lisp_Object best_entity
;
2257 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2260 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2261 prefer_prop
[i
] = AREF (prefer
, i
);
2262 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2263 prefer_prop
[FONT_SIZE_INDEX
]
2264 = make_number (font_pixel_size (f
, prefer
));
2266 if (NILP (XCDR (list
)))
2268 /* What we have to take care of is this single vector. */
2270 maxlen
= ASIZE (vec
);
2274 /* We don't have to perform sort, so there's no need of creating
2275 a single vector. But, we must find the length of the longest
2278 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2279 if (maxlen
< ASIZE (XCAR (tail
)))
2280 maxlen
= ASIZE (XCAR (tail
));
2284 /* We have to create a single vector to sort it. */
2285 vec
= font_vconcat_entity_vectors (list
);
2286 maxlen
= ASIZE (vec
);
2289 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2290 best_score
= 0xFFFFFFFF;
2293 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2295 int font_driver_preference
= 0;
2296 Lisp_Object current_font_driver
;
2302 /* We are sure that the length of VEC > 0. */
2303 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2304 /* Score the elements. */
2305 for (i
= 0; i
< len
; i
++)
2307 data
[i
].entity
= AREF (vec
, i
);
2309 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2311 ? font_score (data
[i
].entity
, prefer_prop
)
2313 if (best_only
&& best_score
> data
[i
].score
)
2315 best_score
= data
[i
].score
;
2316 best_entity
= data
[i
].entity
;
2317 if (best_score
== 0)
2320 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2322 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2323 font_driver_preference
++;
2325 data
[i
].font_driver_preference
= font_driver_preference
;
2328 /* Sort if necessary. */
2331 qsort (data
, len
, sizeof *data
, font_compare
);
2332 for (i
= 0; i
< len
; i
++)
2333 ASET (vec
, i
, data
[i
].entity
);
2342 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2347 /* API of Font Service Layer. */
2349 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2350 sort_shift_bits. Finternal_set_font_selection_order calls this
2351 function with font_sort_order after setting up it. */
2354 font_update_sort_order (int *order
)
2358 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2360 int xlfd_idx
= order
[i
];
2362 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2363 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2364 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2365 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2366 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2367 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2369 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2374 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2375 Lisp_Object features
, Lisp_Object table
)
2380 table
= assq_no_quit (script
, table
);
2383 table
= XCDR (table
);
2384 if (! NILP (langsys
))
2386 table
= assq_no_quit (langsys
, table
);
2392 val
= assq_no_quit (Qnil
, table
);
2394 table
= XCAR (table
);
2398 table
= XCDR (table
);
2399 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2401 if (NILP (XCAR (features
)))
2406 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2412 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2415 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2417 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2419 script
= XCAR (spec
);
2423 langsys
= XCAR (spec
);
2434 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2435 XCAR (otf_capability
)))
2437 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2438 XCDR (otf_capability
)))
2445 /* Check if FONT (font-entity or font-object) matches with the font
2446 specification SPEC. */
2449 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2451 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2452 Lisp_Object extra
, font_extra
;
2455 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2456 if (! NILP (AREF (spec
, i
))
2457 && ! NILP (AREF (font
, i
))
2458 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2460 props
= XFONT_SPEC (spec
)->props
;
2461 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2463 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2464 prop
[i
] = AREF (spec
, i
);
2465 prop
[FONT_SIZE_INDEX
]
2466 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2470 if (font_score (font
, props
) > 0)
2472 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2473 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2474 for (; CONSP (extra
); extra
= XCDR (extra
))
2476 Lisp_Object key
= XCAR (XCAR (extra
));
2477 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2479 if (EQ (key
, QClang
))
2481 val2
= assq_no_quit (key
, font_extra
);
2490 if (NILP (Fmemq (val
, val2
)))
2495 ? NILP (Fmemq (val
, XCDR (val2
)))
2499 else if (EQ (key
, QCscript
))
2501 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2507 /* All characters in the list must be supported. */
2508 for (; CONSP (val2
); val2
= XCDR (val2
))
2510 if (! CHARACTERP (XCAR (val2
)))
2512 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2513 == FONT_INVALID_CODE
)
2517 else if (VECTORP (val2
))
2519 /* At most one character in the vector must be supported. */
2520 for (i
= 0; i
< ASIZE (val2
); i
++)
2522 if (! CHARACTERP (AREF (val2
, i
)))
2524 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2525 != FONT_INVALID_CODE
)
2528 if (i
== ASIZE (val2
))
2533 else if (EQ (key
, QCotf
))
2537 if (! FONT_OBJECT_P (font
))
2539 fontp
= XFONT_OBJECT (font
);
2540 if (! fontp
->driver
->otf_capability
)
2542 val2
= fontp
->driver
->otf_capability (fontp
);
2543 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2554 Each font backend has the callback function get_cache, and it
2555 returns a cons cell of which cdr part can be freely used for
2556 caching fonts. The cons cell may be shared by multiple frames
2557 and/or multiple font drivers. So, we arrange the cdr part as this:
2559 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2561 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2562 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2563 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2565 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2566 static void font_finish_cache (struct frame
*, struct font_driver
*);
2567 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2568 static void font_clear_cache (struct frame
*, Lisp_Object
,
2569 struct font_driver
*);
2572 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2574 Lisp_Object cache
, val
;
2576 cache
= driver
->get_cache (f
);
2578 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2582 val
= list2 (driver
->type
, make_number (1));
2583 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2587 val
= XCDR (XCAR (val
));
2588 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2594 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2596 Lisp_Object cache
, val
, tmp
;
2599 cache
= driver
->get_cache (f
);
2601 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2602 cache
= val
, val
= XCDR (val
);
2603 eassert (! NILP (val
));
2604 tmp
= XCDR (XCAR (val
));
2605 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2606 if (XINT (XCAR (tmp
)) == 0)
2608 font_clear_cache (f
, XCAR (val
), driver
);
2609 XSETCDR (cache
, XCDR (val
));
2615 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2617 Lisp_Object val
= driver
->get_cache (f
);
2618 Lisp_Object type
= driver
->type
;
2620 eassert (CONSP (val
));
2621 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2622 eassert (CONSP (val
));
2623 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2624 val
= XCDR (XCAR (val
));
2630 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2632 Lisp_Object tail
, elt
;
2636 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2637 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2640 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2641 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2644 eassert (VECTORP (elt
));
2645 for (i
= 0; i
< ASIZE (elt
); i
++)
2647 entity
= AREF (elt
, i
);
2649 if (FONT_ENTITY_P (entity
)
2650 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2652 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2654 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2656 Lisp_Object val
= XCAR (objlist
);
2657 struct font
*font
= XFONT_OBJECT (val
);
2659 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2661 eassert (font
&& driver
== font
->driver
);
2662 driver
->close (font
);
2665 if (driver
->free_entity
)
2666 driver
->free_entity (entity
);
2671 XSETCDR (cache
, Qnil
);
2675 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2677 /* Check each font-entity in VEC, and return a list of font-entities
2678 that satisfy these conditions:
2679 (1) matches with SPEC and SIZE if SPEC is not nil, and
2680 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2684 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2686 Lisp_Object entity
, val
;
2687 enum font_property_index prop
;
2690 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2692 entity
= AREF (vec
, i
);
2693 if (! NILP (Vface_ignored_fonts
))
2697 Lisp_Object tail
, regexp
;
2699 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2702 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2704 regexp
= XCAR (tail
);
2705 if (STRINGP (regexp
)
2706 && fast_c_string_match_ignore_case (regexp
, name
,
2716 val
= Fcons (entity
, val
);
2719 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2720 if (INTEGERP (AREF (spec
, prop
))
2721 && ((XINT (AREF (spec
, prop
)) >> 8)
2722 != (XINT (AREF (entity
, prop
)) >> 8)))
2723 prop
= FONT_SPEC_MAX
;
2724 if (prop
< FONT_SPEC_MAX
2726 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2728 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2730 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2731 prop
= FONT_SPEC_MAX
;
2733 if (prop
< FONT_SPEC_MAX
2734 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2735 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2736 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2737 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2738 prop
= FONT_SPEC_MAX
;
2739 if (prop
< FONT_SPEC_MAX
2740 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2741 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2742 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2743 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2744 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2745 prop
= FONT_SPEC_MAX
;
2746 if (prop
< FONT_SPEC_MAX
)
2747 val
= Fcons (entity
, val
);
2749 return (Fvconcat (1, &val
));
2753 /* Return a list of vectors of font-entities matching with SPEC on
2754 FRAME. Each elements in the list is a vector of entities from the
2755 same font-driver. */
2758 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2760 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2761 Lisp_Object ftype
, val
;
2762 Lisp_Object list
= Qnil
;
2764 bool need_filtering
= 0;
2767 eassert (FONT_SPEC_P (spec
));
2769 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2770 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2771 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2772 size
= font_pixel_size (f
, spec
);
2776 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2777 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2778 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2779 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2780 if (i
!= FONT_SPACING_INDEX
)
2782 ASET (scratch_font_spec
, i
, Qnil
);
2783 if (! NILP (AREF (spec
, i
)))
2786 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2787 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2789 for (; driver_list
; driver_list
= driver_list
->next
)
2791 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2793 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2795 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2796 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2801 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2804 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2806 val
= Fvconcat (1, &val
);
2807 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2808 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2811 if (VECTORP (val
) && ASIZE (val
) > 0
2813 || ! NILP (Vface_ignored_fonts
)))
2814 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2815 if (VECTORP (val
) && ASIZE (val
) > 0)
2816 list
= Fcons (val
, list
);
2819 list
= Fnreverse (list
);
2820 FONT_ADD_LOG ("list", spec
, list
);
2825 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2826 nil, is an array of face's attributes, which specifies preferred
2827 font-related attributes. */
2830 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2832 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2833 Lisp_Object ftype
, size
, entity
;
2834 Lisp_Object work
= copy_font_spec (spec
);
2836 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2837 size
= AREF (spec
, FONT_SIZE_INDEX
);
2840 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2841 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2842 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2843 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2846 for (; driver_list
; driver_list
= driver_list
->next
)
2848 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2850 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2852 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2853 entity
= assoc_no_quit (work
, XCDR (cache
));
2855 entity
= AREF (XCDR (entity
), 0);
2858 entity
= driver_list
->driver
->match (f
, work
);
2861 Lisp_Object copy
= copy_font_spec (work
);
2862 Lisp_Object match
= Fvector (1, &entity
);
2864 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2865 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2868 if (! NILP (entity
))
2871 FONT_ADD_LOG ("match", work
, entity
);
2876 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2877 opened font object. */
2880 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2882 struct font_driver_list
*driver_list
;
2883 Lisp_Object objlist
, size
, val
, font_object
;
2885 int min_width
, height
, psize
;
2887 eassert (FONT_ENTITY_P (entity
));
2888 size
= AREF (entity
, FONT_SIZE_INDEX
);
2889 if (XINT (size
) != 0)
2890 pixel_size
= XINT (size
);
2892 val
= AREF (entity
, FONT_TYPE_INDEX
);
2893 for (driver_list
= f
->font_driver_list
;
2894 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2895 driver_list
= driver_list
->next
);
2899 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2900 objlist
= XCDR (objlist
))
2902 Lisp_Object fn
= XCAR (objlist
);
2903 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2904 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2906 if (driver_list
->driver
->cached_font_ok
== NULL
2907 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2912 /* We always open a font of manageable size; i.e non-zero average
2913 width and height. */
2914 for (psize
= pixel_size
; ; psize
++)
2916 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2917 if (NILP (font_object
))
2919 font
= XFONT_OBJECT (font_object
);
2920 if (font
->average_width
> 0 && font
->height
> 0)
2923 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2924 FONT_ADD_LOG ("open", entity
, font_object
);
2925 ASET (entity
, FONT_OBJLIST_INDEX
,
2926 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2928 font
= XFONT_OBJECT (font_object
);
2929 min_width
= (font
->min_width
? font
->min_width
2930 : font
->average_width
? font
->average_width
2931 : font
->space_width
? font
->space_width
2933 height
= (font
->height
? font
->height
: 1);
2934 #ifdef HAVE_WINDOW_SYSTEM
2935 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2936 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2938 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2939 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2940 f
->fonts_changed
= 1;
2944 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2945 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2946 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2947 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2955 /* Close FONT_OBJECT that is opened on frame F. */
2958 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2960 struct font
*font
= XFONT_OBJECT (font_object
);
2962 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2963 /* Already closed. */
2965 FONT_ADD_LOG ("close", font_object
, Qnil
);
2966 font
->driver
->close (font
);
2967 #ifdef HAVE_WINDOW_SYSTEM
2968 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2969 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2974 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2975 FONT is a font-entity and it must be opened to check. */
2978 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2982 if (FONT_ENTITY_P (font
))
2984 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2985 struct font_driver_list
*driver_list
;
2987 for (driver_list
= f
->font_driver_list
;
2988 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2989 driver_list
= driver_list
->next
);
2992 if (! driver_list
->driver
->has_char
)
2994 return driver_list
->driver
->has_char (font
, c
);
2997 eassert (FONT_OBJECT_P (font
));
2998 fontp
= XFONT_OBJECT (font
);
2999 if (fontp
->driver
->has_char
)
3001 int result
= fontp
->driver
->has_char (font
, c
);
3006 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3010 /* Return the glyph ID of FONT_OBJECT for character C. */
3013 font_encode_char (Lisp_Object font_object
, int c
)
3017 eassert (FONT_OBJECT_P (font_object
));
3018 font
= XFONT_OBJECT (font_object
);
3019 return font
->driver
->encode_char (font
, c
);
3023 /* Return the name of FONT_OBJECT. */
3026 font_get_name (Lisp_Object font_object
)
3028 eassert (FONT_OBJECT_P (font_object
));
3029 return AREF (font_object
, FONT_NAME_INDEX
);
3033 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3034 could not be parsed by font_parse_name, return Qnil. */
3037 font_spec_from_name (Lisp_Object font_name
)
3039 Lisp_Object spec
= Ffont_spec (0, NULL
);
3041 CHECK_STRING (font_name
);
3042 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
3044 font_put_extra (spec
, QCname
, font_name
);
3045 font_put_extra (spec
, QCuser_spec
, font_name
);
3051 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3053 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3058 if (! NILP (Ffont_get (font
, QCname
)))
3060 font
= copy_font_spec (font
);
3061 font_put_extra (font
, QCname
, Qnil
);
3064 if (NILP (AREF (font
, prop
))
3065 && prop
!= FONT_FAMILY_INDEX
3066 && prop
!= FONT_FOUNDRY_INDEX
3067 && prop
!= FONT_WIDTH_INDEX
3068 && prop
!= FONT_SIZE_INDEX
)
3070 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3071 font
= copy_font_spec (font
);
3072 ASET (font
, prop
, Qnil
);
3073 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3075 if (prop
== FONT_FAMILY_INDEX
)
3077 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3078 /* If we are setting the font family, we must also clear
3079 FONT_WIDTH_INDEX to avoid rejecting families that lack
3080 support for some widths. */
3081 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3083 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3084 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3085 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3086 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3087 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3088 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3090 else if (prop
== FONT_SIZE_INDEX
)
3092 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3093 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3094 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3096 else if (prop
== FONT_WIDTH_INDEX
)
3097 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3098 attrs
[LFACE_FONT_INDEX
] = font
;
3101 /* Select a font from ENTITIES (list of font-entity vectors) that
3102 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3105 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3106 Lisp_Object
*attrs
, int pixel_size
, int c
)
3108 Lisp_Object font_entity
;
3112 if (NILP (XCDR (entities
))
3113 && ASIZE (XCAR (entities
)) == 1)
3115 font_entity
= AREF (XCAR (entities
), 0);
3116 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3121 /* Sort fonts by properties specified in ATTRS. */
3122 prefer
= scratch_font_prefer
;
3124 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3125 ASET (prefer
, i
, Qnil
);
3126 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3128 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3130 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3131 ASET (prefer
, i
, AREF (face_font
, i
));
3133 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3134 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3135 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3136 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3137 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3138 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3139 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3141 return font_sort_entities (entities
, prefer
, f
, c
);
3144 /* Return a font-entity that satisfies SPEC and is the best match for
3145 face's font related attributes in ATTRS. C, if not negative, is a
3146 character that the entity must support. */
3149 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3152 Lisp_Object entities
, val
;
3153 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3158 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3159 if (NILP (registry
[0]))
3161 registry
[0] = DEFAULT_ENCODING
;
3162 registry
[1] = Qascii_0
;
3163 registry
[2] = zero_vector
;
3166 registry
[1] = zero_vector
;
3168 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3170 struct charset
*encoding
, *repertory
;
3172 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3173 &encoding
, &repertory
) < 0)
3176 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3178 else if (c
> encoding
->max_char
)
3182 work
= copy_font_spec (spec
);
3183 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3184 pixel_size
= font_pixel_size (f
, spec
);
3185 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3187 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3189 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3193 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3194 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3195 if (! NILP (foundry
[0]))
3196 foundry
[1] = zero_vector
;
3197 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3199 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3200 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3202 foundry
[2] = zero_vector
;
3205 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3207 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3208 if (! NILP (adstyle
[0]))
3209 adstyle
[1] = zero_vector
;
3210 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3212 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3214 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3216 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3218 adstyle
[2] = zero_vector
;
3221 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3224 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3227 val
= AREF (work
, FONT_FAMILY_INDEX
);
3228 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3230 val
= attrs
[LFACE_FAMILY_INDEX
];
3231 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3233 Lisp_Object familybuf
[3];
3238 family
[1] = zero_vector
; /* terminator. */
3243 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3245 if (! NILP (alters
))
3247 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3248 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3249 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3250 family
[i
] = XCAR (alters
);
3251 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3253 family
[i
] = zero_vector
;
3260 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3262 family
[i
] = zero_vector
;
3266 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3268 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3269 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3271 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3272 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3274 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3275 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3277 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3278 entities
= font_list_entities (f
, work
);
3279 if (! NILP (entities
))
3281 val
= font_select_entity (f
, entities
,
3282 attrs
, pixel_size
, c
);
3300 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3304 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3305 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3306 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3309 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3310 size
= font_pixel_size (f
, spec
);
3314 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3315 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3318 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3319 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3320 eassert (INTEGERP (height
));
3325 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3329 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3330 size
= (NUMBERP (ffsize
)
3331 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3335 size
*= font_rescale_ratio (entity
);
3338 return font_open_entity (f
, entity
, size
);
3342 /* Find a font that satisfies SPEC and is the best match for
3343 face's attributes in ATTRS on FRAME, and return the opened
3347 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3349 Lisp_Object entity
, name
;
3351 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3354 /* No font is listed for SPEC, but each font-backend may have
3355 different criteria about "font matching". So, try it. */
3356 entity
= font_matching_entity (f
, attrs
, spec
);
3360 /* Don't lose the original name that was put in initially. We need
3361 it to re-apply the font when font parameters (like hinting or dpi) have
3363 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3366 name
= Ffont_get (spec
, QCuser_spec
);
3367 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3373 /* Make FACE on frame F ready to use the font opened for FACE. */
3376 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3378 if (face
->font
->driver
->prepare_face
)
3379 face
->font
->driver
->prepare_face (f
, face
);
3383 /* Make FACE on frame F stop using the font opened for FACE. */
3386 font_done_for_face (struct frame
*f
, struct face
*face
)
3388 if (face
->font
->driver
->done_face
)
3389 face
->font
->driver
->done_face (f
, face
);
3393 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3394 font is found, return Qnil. */
3397 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3399 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3401 /* We set up the default font-related attributes of a face to prefer
3403 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3404 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3405 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3407 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3409 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3411 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3413 return font_load_for_lface (f
, attrs
, spec
);
3417 /* Open a font that matches NAME on frame F. If no proper font is
3418 found, return Qnil. */
3421 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3423 Lisp_Object args
[2];
3424 Lisp_Object spec
, ret
;
3428 spec
= Ffont_spec (2, args
);
3429 ret
= font_open_by_spec (f
, spec
);
3430 /* Do not lose name originally put in. */
3432 font_put_extra (ret
, QCuser_spec
, args
[1]);
3438 /* Register font-driver DRIVER. This function is used in two ways.
3440 The first is with frame F non-NULL. In this case, make DRIVER
3441 available (but not yet activated) on F. All frame creators
3442 (e.g. Fx_create_frame) must call this function at least once with
3443 an available font-driver.
3445 The second is with frame F NULL. In this case, DRIVER is globally
3446 registered in the variable `font_driver_list'. All font-driver
3447 implementations must call this function in its syms_of_XXXX
3448 (e.g. syms_of_xfont). */
3451 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3453 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3454 struct font_driver_list
*prev
, *list
;
3456 #ifdef HAVE_WINDOW_SYSTEM
3457 if (f
&& ! driver
->draw
)
3458 error ("Unusable font driver for a frame: %s",
3459 SDATA (SYMBOL_NAME (driver
->type
)));
3460 #endif /* HAVE_WINDOW_SYSTEM */
3462 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3463 if (EQ (list
->driver
->type
, driver
->type
))
3464 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3466 list
= xmalloc (sizeof *list
);
3468 list
->driver
= driver
;
3473 f
->font_driver_list
= list
;
3475 font_driver_list
= list
;
3481 free_font_driver_list (struct frame
*f
)
3483 struct font_driver_list
*list
, *next
;
3485 for (list
= f
->font_driver_list
; list
; list
= next
)
3490 f
->font_driver_list
= NULL
;
3494 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3495 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3496 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3498 A caller must free all realized faces if any in advance. The
3499 return value is a list of font backends actually made used on
3503 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3505 Lisp_Object active_drivers
= Qnil
;
3506 struct font_driver_list
*list
;
3508 /* At first, turn off non-requested drivers, and turn on requested
3510 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3512 struct font_driver
*driver
= list
->driver
;
3513 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3518 if (driver
->end_for_frame
)
3519 driver
->end_for_frame (f
);
3520 font_finish_cache (f
, driver
);
3525 if (! driver
->start_for_frame
3526 || driver
->start_for_frame (f
) == 0)
3528 font_prepare_cache (f
, driver
);
3535 if (NILP (new_drivers
))
3538 if (! EQ (new_drivers
, Qt
))
3540 /* Re-order the driver list according to new_drivers. */
3541 struct font_driver_list
**list_table
, **next
;
3546 SAFE_NALLOCA (list_table
, 1, num_font_drivers
+ 1);
3547 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3549 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3550 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3553 list_table
[i
++] = list
;
3555 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3557 list_table
[i
++] = list
;
3558 list_table
[i
] = NULL
;
3560 next
= &f
->font_driver_list
;
3561 for (i
= 0; list_table
[i
]; i
++)
3563 *next
= list_table
[i
];
3564 next
= &(*next
)->next
;
3569 if (! f
->font_driver_list
->on
)
3570 { /* None of the drivers is enabled: enable them all.
3571 Happens if you set the list of drivers to (xft x) in your .emacs
3572 and then use it under w32 or ns. */
3573 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3575 struct font_driver
*driver
= list
->driver
;
3576 eassert (! list
->on
);
3577 if (! driver
->start_for_frame
3578 || driver
->start_for_frame (f
) == 0)
3580 font_prepare_cache (f
, driver
);
3587 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3589 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3590 return active_drivers
;
3593 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
3596 fset_font_data (struct frame
*f
, Lisp_Object val
)
3602 font_put_frame_data (struct frame
*f
, Lisp_Object driver
, void *data
)
3604 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3607 fset_font_data (f
, Fdelq (val
, f
->font_data
));
3611 fset_font_data (f
, Fcons (Fcons (driver
, make_save_ptr (data
)),
3614 XSETCDR (val
, make_save_ptr (data
));
3619 font_get_frame_data (struct frame
*f
, Lisp_Object driver
)
3621 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3623 return NILP (val
) ? NULL
: XSAVE_POINTER (XCDR (val
), 0);
3626 #endif /* HAVE_XFT || HAVE_FREETYPE */
3628 /* Sets attributes on a font. Any properties that appear in ALIST and
3629 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3630 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3631 arrays of strings. This function is intended for use by the font
3632 drivers to implement their specific font_filter_properties. */
3634 font_filter_properties (Lisp_Object font
,
3636 const char *const boolean_properties
[],
3637 const char *const non_boolean_properties
[])
3642 /* Set boolean values to Qt or Qnil. */
3643 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3644 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3646 Lisp_Object key
= XCAR (XCAR (it
));
3647 Lisp_Object val
= XCDR (XCAR (it
));
3648 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3650 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3652 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3653 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3656 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3657 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3658 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3659 || strcmp ("Off", str
) == 0)
3664 Ffont_put (font
, key
, val
);
3668 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3669 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3671 Lisp_Object key
= XCAR (XCAR (it
));
3672 Lisp_Object val
= XCDR (XCAR (it
));
3673 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3674 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3675 Ffont_put (font
, key
, val
);
3680 /* Return the font used to draw character C by FACE at buffer position
3681 POS in window W. If STRING is non-nil, it is a string containing C
3682 at index POS. If C is negative, get C from the current buffer or
3686 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3691 Lisp_Object font_object
;
3693 multibyte
= (NILP (string
)
3694 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3695 : STRING_MULTIBYTE (string
));
3702 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3704 c
= FETCH_CHAR (pos_byte
);
3707 c
= FETCH_BYTE (pos
);
3713 multibyte
= STRING_MULTIBYTE (string
);
3716 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3718 str
= SDATA (string
) + pos_byte
;
3719 c
= STRING_CHAR (str
);
3722 c
= SDATA (string
)[pos
];
3726 f
= XFRAME (w
->frame
);
3727 if (! FRAME_WINDOW_P (f
))
3734 if (STRINGP (string
))
3735 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3736 DEFAULT_FACE_ID
, 0);
3738 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3740 face
= FACE_FROM_ID (f
, face_id
);
3744 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3745 face
= FACE_FROM_ID (f
, face_id
);
3750 XSETFONT (font_object
, face
->font
);
3755 #ifdef HAVE_WINDOW_SYSTEM
3757 /* Check how many characters after character/byte position POS/POS_BYTE
3758 (at most to *LIMIT) can be displayed by the same font in the window W.
3759 FACE, if non-NULL, is the face selected for the character at POS.
3760 If STRING is not nil, it is the string to check instead of the current
3761 buffer. In that case, FACE must be not NULL.
3763 The return value is the font-object for the character at POS.
3764 *LIMIT is set to the position where that font can't be used.
3766 It is assured that the current buffer (or STRING) is multibyte. */
3769 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3770 struct window
*w
, struct face
*face
, Lisp_Object string
)
3774 Lisp_Object font_object
= Qnil
;
3782 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3784 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3790 while (pos
< *limit
)
3792 Lisp_Object category
;
3795 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3797 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3798 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3799 if (INTEGERP (category
)
3800 && (XINT (category
) == UNICODE_CATEGORY_Cf
3801 || CHAR_VARIATION_SELECTOR_P (c
)))
3803 if (NILP (font_object
))
3805 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3806 if (NILP (font_object
))
3810 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3820 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3821 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3822 Return nil otherwise.
3823 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3824 which kind of font it is. It must be one of `font-spec', `font-entity',
3826 (Lisp_Object object
, Lisp_Object extra_type
)
3828 if (NILP (extra_type
))
3829 return (FONTP (object
) ? Qt
: Qnil
);
3830 if (EQ (extra_type
, Qfont_spec
))
3831 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3832 if (EQ (extra_type
, Qfont_entity
))
3833 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3834 if (EQ (extra_type
, Qfont_object
))
3835 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3836 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3839 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3840 doc
: /* Return a newly created font-spec with arguments as properties.
3842 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3843 valid font property name listed below:
3845 `:family', `:weight', `:slant', `:width'
3847 They are the same as face attributes of the same name. See
3848 `set-face-attribute'.
3852 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3856 VALUE must be a string or a symbol specifying the additional
3857 typographic style information of a font, e.g. ``sans''.
3861 VALUE must be a string or a symbol specifying the charset registry and
3862 encoding of a font, e.g. ``iso8859-1''.
3866 VALUE must be a non-negative integer or a floating point number
3867 specifying the font size. It specifies the font size in pixels (if
3868 VALUE is an integer), or in points (if VALUE is a float).
3872 VALUE must be a string of XLFD-style or fontconfig-style font name.
3876 VALUE must be a symbol representing a script that the font must
3877 support. It may be a symbol representing a subgroup of a script
3878 listed in the variable `script-representative-chars'.
3882 VALUE must be a symbol of two-letter ISO-639 language names,
3887 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3888 required OpenType features.
3890 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3891 LANGSYS-TAG: OpenType language system tag symbol,
3892 or nil for the default language system.
3893 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3894 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3896 GSUB and GPOS may contain `nil' element. In such a case, the font
3897 must not have any of the remaining elements.
3899 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3900 be an OpenType font whose GPOS table of `thai' script's default
3901 language system must contain `mark' feature.
3903 usage: (font-spec ARGS...) */)
3904 (ptrdiff_t nargs
, Lisp_Object
*args
)
3906 Lisp_Object spec
= font_make_spec ();
3909 for (i
= 0; i
< nargs
; i
+= 2)
3911 Lisp_Object key
= args
[i
], val
;
3915 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3918 if (EQ (key
, QCname
))
3921 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3922 error ("Invalid font name: %s", SSDATA (val
));
3923 font_put_extra (spec
, key
, val
);
3927 int idx
= get_font_prop_index (key
);
3931 val
= font_prop_validate (idx
, Qnil
, val
);
3932 if (idx
< FONT_EXTRA_INDEX
)
3933 ASET (spec
, idx
, val
);
3935 font_put_extra (spec
, key
, val
);
3938 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3944 /* Return a copy of FONT as a font-spec. */
3946 copy_font_spec (Lisp_Object font
)
3948 Lisp_Object new_spec
, tail
, prev
, extra
;
3952 new_spec
= font_make_spec ();
3953 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3954 ASET (new_spec
, i
, AREF (font
, i
));
3955 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3956 /* We must remove :font-entity property. */
3957 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3958 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3961 extra
= XCDR (extra
);
3963 XSETCDR (prev
, XCDR (tail
));
3966 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3970 /* Merge font-specs FROM and TO, and return a new font-spec.
3971 Every specified property in FROM overrides the corresponding
3974 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3976 Lisp_Object extra
, tail
;
3981 to
= copy_font_spec (to
);
3982 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3983 ASET (to
, i
, AREF (from
, i
));
3984 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3985 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3986 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3988 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3991 XSETCDR (slot
, XCDR (XCAR (tail
)));
3993 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3995 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3999 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4000 doc
: /* Return the value of FONT's property KEY.
4001 FONT is a font-spec, a font-entity, or a font-object.
4002 KEY is any symbol, but these are reserved for specific meanings:
4003 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4004 :size, :name, :script, :otf
4005 See the documentation of `font-spec' for their meanings.
4006 In addition, if FONT is a font-entity or a font-object, values of
4007 :script and :otf are different from those of a font-spec as below:
4009 The value of :script may be a list of scripts that are supported by the font.
4011 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
4012 representing the OpenType features supported by the font by this form:
4013 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4014 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
4016 (Lisp_Object font
, Lisp_Object key
)
4024 idx
= get_font_prop_index (key
);
4025 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4026 return font_style_symbolic (font
, idx
, 0);
4027 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4028 return AREF (font
, idx
);
4029 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4030 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4032 struct font
*fontp
= XFONT_OBJECT (font
);
4034 if (fontp
->driver
->otf_capability
)
4035 val
= fontp
->driver
->otf_capability (fontp
);
4037 val
= Fcons (Qnil
, Qnil
);
4044 #ifdef HAVE_WINDOW_SYSTEM
4046 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4047 doc
: /* Return a plist of face attributes generated by FONT.
4048 FONT is a font name, a font-spec, a font-entity, or a font-object.
4049 The return value is a list of the form
4051 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4053 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4054 compatible with `set-face-attribute'. Some of these key-attribute pairs
4055 may be omitted from the list if they are not specified by FONT.
4057 The optional argument FRAME specifies the frame that the face attributes
4058 are to be displayed on. If omitted, the selected frame is used. */)
4059 (Lisp_Object font
, Lisp_Object frame
)
4061 struct frame
*f
= decode_live_frame (frame
);
4062 Lisp_Object plist
[10];
4068 int fontset
= fs_query_fontset (font
, 0);
4069 Lisp_Object name
= font
;
4071 font
= fontset_ascii (fontset
);
4072 font
= font_spec_from_name (name
);
4074 signal_error ("Invalid font name", name
);
4076 else if (! FONTP (font
))
4077 signal_error ("Invalid font object", font
);
4079 val
= AREF (font
, FONT_FAMILY_INDEX
);
4082 plist
[n
++] = QCfamily
;
4083 plist
[n
++] = SYMBOL_NAME (val
);
4086 val
= AREF (font
, FONT_SIZE_INDEX
);
4089 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4090 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4091 plist
[n
++] = QCheight
;
4092 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4094 else if (FLOATP (val
))
4096 plist
[n
++] = QCheight
;
4097 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4100 val
= FONT_WEIGHT_FOR_FACE (font
);
4103 plist
[n
++] = QCweight
;
4107 val
= FONT_SLANT_FOR_FACE (font
);
4110 plist
[n
++] = QCslant
;
4114 val
= FONT_WIDTH_FOR_FACE (font
);
4117 plist
[n
++] = QCwidth
;
4121 return Flist (n
, plist
);
4126 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4127 doc
: /* Set one property of FONT: give property KEY value VAL.
4128 FONT is a font-spec, a font-entity, or a font-object.
4130 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4131 accepted by the function `font-spec' (which see), VAL must be what
4132 allowed in `font-spec'.
4134 If FONT is a font-entity or a font-object, KEY must not be the one
4135 accepted by `font-spec'. */)
4136 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4140 idx
= get_font_prop_index (prop
);
4141 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4143 CHECK_FONT_SPEC (font
);
4144 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4148 if (EQ (prop
, QCname
)
4149 || EQ (prop
, QCscript
)
4150 || EQ (prop
, QClang
)
4151 || EQ (prop
, QCotf
))
4152 CHECK_FONT_SPEC (font
);
4155 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4160 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4161 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4162 Optional 2nd argument FRAME specifies the target frame.
4163 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4164 Optional 4th argument PREFER, if non-nil, is a font-spec to
4165 control the order of the returned list. Fonts are sorted by
4166 how close they are to PREFER. */)
4167 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4169 struct frame
*f
= decode_live_frame (frame
);
4170 Lisp_Object vec
, list
;
4173 CHECK_FONT_SPEC (font_spec
);
4181 if (! NILP (prefer
))
4182 CHECK_FONT_SPEC (prefer
);
4184 list
= font_list_entities (f
, font_spec
);
4187 if (NILP (XCDR (list
))
4188 && ASIZE (XCAR (list
)) == 1)
4189 return list1 (AREF (XCAR (list
), 0));
4191 if (! NILP (prefer
))
4192 vec
= font_sort_entities (list
, prefer
, f
, 0);
4194 vec
= font_vconcat_entity_vectors (list
);
4195 if (n
== 0 || n
>= ASIZE (vec
))
4197 Lisp_Object args
[2];
4201 list
= Fappend (2, args
);
4205 for (list
= Qnil
, n
--; n
>= 0; n
--)
4206 list
= Fcons (AREF (vec
, n
), list
);
4211 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4212 doc
: /* List available font families on the current frame.
4213 If FRAME is omitted or nil, the selected frame is used. */)
4216 struct frame
*f
= decode_live_frame (frame
);
4217 struct font_driver_list
*driver_list
;
4218 Lisp_Object list
= Qnil
;
4220 for (driver_list
= f
->font_driver_list
; driver_list
;
4221 driver_list
= driver_list
->next
)
4222 if (driver_list
->driver
->list_family
)
4224 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4225 Lisp_Object tail
= list
;
4227 for (; CONSP (val
); val
= XCDR (val
))
4228 if (NILP (Fmemq (XCAR (val
), tail
))
4229 && SYMBOLP (XCAR (val
)))
4230 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4235 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4236 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4237 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4238 (Lisp_Object font_spec
, Lisp_Object frame
)
4240 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4247 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4248 doc
: /* Return XLFD name of FONT.
4249 FONT is a font-spec, font-entity, or font-object.
4250 If the name is too long for XLFD (maximum 255 chars), return nil.
4251 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4252 the consecutive wildcards are folded into one. */)
4253 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4256 int namelen
, pixel_size
= 0;
4260 if (FONT_OBJECT_P (font
))
4262 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4264 if (STRINGP (font_name
)
4265 && SDATA (font_name
)[0] == '-')
4267 if (NILP (fold_wildcards
))
4269 strcpy (name
, SSDATA (font_name
));
4270 namelen
= SBYTES (font_name
);
4273 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4275 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4279 if (! NILP (fold_wildcards
))
4281 char *p0
= name
, *p1
;
4283 while ((p1
= strstr (p0
, "-*-*")))
4285 strcpy (p1
, p1
+ 2);
4291 return make_string (name
, namelen
);
4295 clear_font_cache (struct frame
*f
)
4297 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4299 for (; driver_list
; driver_list
= driver_list
->next
)
4300 if (driver_list
->on
)
4302 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4306 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4308 eassert (! NILP (val
));
4309 tmp
= XCDR (XCAR (val
));
4310 if (XINT (XCAR (tmp
)) == 0)
4312 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4313 XSETCDR (cache
, XCDR (val
));
4318 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4319 doc
: /* Clear font cache of each frame. */)
4322 Lisp_Object list
, frame
;
4324 FOR_EACH_FRAME (list
, frame
)
4325 clear_font_cache (XFRAME (frame
));
4332 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4334 struct font
*font
= XFONT_OBJECT (font_object
);
4335 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4336 struct font_metrics metrics
;
4338 LGLYPH_SET_CODE (glyph
, code
);
4339 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4340 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4341 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4342 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4343 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4344 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4348 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4349 doc
: /* Shape the glyph-string GSTRING.
4350 Shaping means substituting glyphs and/or adjusting positions of glyphs
4351 to get the correct visual image of character sequences set in the
4352 header of the glyph-string.
4354 If the shaping was successful, the value is GSTRING itself or a newly
4355 created glyph-string. Otherwise, the value is nil.
4357 See the documentation of `composition-get-gstring' for the format of
4359 (Lisp_Object gstring
)
4362 Lisp_Object font_object
, n
, glyph
;
4363 ptrdiff_t i
, from
, to
;
4365 if (! composition_gstring_p (gstring
))
4366 signal_error ("Invalid glyph-string: ", gstring
);
4367 if (! NILP (LGSTRING_ID (gstring
)))
4369 font_object
= LGSTRING_FONT (gstring
);
4370 CHECK_FONT_OBJECT (font_object
);
4371 font
= XFONT_OBJECT (font_object
);
4372 if (! font
->driver
->shape
)
4375 /* Try at most three times with larger gstring each time. */
4376 for (i
= 0; i
< 3; i
++)
4378 n
= font
->driver
->shape (gstring
);
4381 gstring
= larger_vector (gstring
,
4382 LGSTRING_GLYPH_LEN (gstring
), -1);
4384 if (i
== 3 || XINT (n
) == 0)
4386 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4387 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4389 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4390 GLYPHS covers all characters (except for the last few ones) in
4391 GSTRING. More formally, provided that NCHARS is the number of
4392 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4393 and TO_IDX of each glyph must satisfy these conditions:
4395 GLYPHS[0].FROM_IDX == 0
4396 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4397 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4398 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4399 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4401 ;; Be sure to cover all characters.
4402 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4403 glyph
= LGSTRING_GLYPH (gstring
, 0);
4404 from
= LGLYPH_FROM (glyph
);
4405 to
= LGLYPH_TO (glyph
);
4406 if (from
!= 0 || to
< from
)
4408 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4410 glyph
= LGSTRING_GLYPH (gstring
, i
);
4413 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4414 && (LGLYPH_FROM (glyph
) == from
4415 ? LGLYPH_TO (glyph
) == to
4416 : LGLYPH_FROM (glyph
) == to
+ 1)))
4418 from
= LGLYPH_FROM (glyph
);
4419 to
= LGLYPH_TO (glyph
);
4421 return composition_gstring_put_cache (gstring
, XINT (n
));
4427 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4429 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4430 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4432 VARIATION-SELECTOR is a character code of variation selection
4433 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4434 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4435 (Lisp_Object font_object
, Lisp_Object character
)
4437 unsigned variations
[256];
4442 CHECK_FONT_OBJECT (font_object
);
4443 CHECK_CHARACTER (character
);
4444 font
= XFONT_OBJECT (font_object
);
4445 if (! font
->driver
->get_variation_glyphs
)
4447 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4451 for (i
= 0; i
< 255; i
++)
4454 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4455 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4456 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4463 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4464 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4465 OTF-FEATURES specifies which features to apply in this format:
4466 (SCRIPT LANGSYS GSUB GPOS)
4468 SCRIPT is a symbol specifying a script tag of OpenType,
4469 LANGSYS is a symbol specifying a langsys tag of OpenType,
4470 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4472 If LANGSYS is nil, the default langsys is selected.
4474 The features are applied in the order they appear in the list. The
4475 symbol `*' means to apply all available features not present in this
4476 list, and the remaining features are ignored. For instance, (vatu
4477 pstf * haln) is to apply vatu and pstf in this order, then to apply
4478 all available features other than vatu, pstf, and haln.
4480 The features are applied to the glyphs in the range FROM and TO of
4481 the glyph-string GSTRING-IN.
4483 If some feature is actually applicable, the resulting glyphs are
4484 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4485 this case, the value is the number of produced glyphs.
4487 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4490 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4491 produced in GSTRING-OUT, and the value is nil.
4493 See the documentation of `composition-get-gstring' for the format of
4495 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4497 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4502 check_otf_features (otf_features
);
4503 CHECK_FONT_OBJECT (font_object
);
4504 font
= XFONT_OBJECT (font_object
);
4505 if (! font
->driver
->otf_drive
)
4506 error ("Font backend %s can't drive OpenType GSUB table",
4507 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4508 CHECK_CONS (otf_features
);
4509 CHECK_SYMBOL (XCAR (otf_features
));
4510 val
= XCDR (otf_features
);
4511 CHECK_SYMBOL (XCAR (val
));
4512 val
= XCDR (otf_features
);
4515 len
= check_gstring (gstring_in
);
4516 CHECK_VECTOR (gstring_out
);
4517 CHECK_NATNUM (from
);
4519 CHECK_NATNUM (index
);
4521 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4522 args_out_of_range_3 (from
, to
, make_number (len
));
4523 if (XINT (index
) >= ASIZE (gstring_out
))
4524 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4525 num
= font
->driver
->otf_drive (font
, otf_features
,
4526 gstring_in
, XINT (from
), XINT (to
),
4527 gstring_out
, XINT (index
), 0);
4530 return make_number (num
);
4533 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4535 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4536 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4538 (SCRIPT LANGSYS FEATURE ...)
4539 See the documentation of `font-drive-otf' for more detail.
4541 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4542 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4543 character code corresponding to the glyph or nil if there's no
4544 corresponding character. */)
4545 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4548 Lisp_Object gstring_in
, gstring_out
, g
;
4549 Lisp_Object alternates
;
4552 CHECK_FONT_GET_OBJECT (font_object
, font
);
4553 if (! font
->driver
->otf_drive
)
4554 error ("Font backend %s can't drive OpenType GSUB table",
4555 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4556 CHECK_CHARACTER (character
);
4557 CHECK_CONS (otf_features
);
4559 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4560 g
= LGSTRING_GLYPH (gstring_in
, 0);
4561 LGLYPH_SET_CHAR (g
, XINT (character
));
4562 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4563 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4564 gstring_out
, 0, 1)) < 0)
4565 gstring_out
= Ffont_make_gstring (font_object
,
4566 make_number (ASIZE (gstring_out
) * 2));
4568 for (i
= 0; i
< num
; i
++)
4570 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4571 int c
= LGLYPH_CHAR (g
);
4572 unsigned code
= LGLYPH_CODE (g
);
4574 alternates
= Fcons (Fcons (make_number (code
),
4575 c
> 0 ? make_number (c
) : Qnil
),
4578 return Fnreverse (alternates
);
4584 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4585 doc
: /* Open FONT-ENTITY. */)
4586 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4589 struct frame
*f
= decode_live_frame (frame
);
4591 CHECK_FONT_ENTITY (font_entity
);
4594 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4597 CHECK_NUMBER_OR_FLOAT (size
);
4599 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4601 isize
= XINT (size
);
4602 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4603 args_out_of_range (font_entity
, size
);
4607 return font_open_entity (f
, font_entity
, isize
);
4610 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4611 doc
: /* Close FONT-OBJECT. */)
4612 (Lisp_Object font_object
, Lisp_Object frame
)
4614 CHECK_FONT_OBJECT (font_object
);
4615 font_close_object (decode_live_frame (frame
), font_object
);
4619 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4620 doc
: /* Return information about FONT-OBJECT.
4621 The value is a vector:
4622 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4625 NAME is the font name, a string (or nil if the font backend doesn't
4628 FILENAME is the font file name, a string (or nil if the font backend
4629 doesn't provide a file name).
4631 PIXEL-SIZE is a pixel size by which the font is opened.
4633 SIZE is a maximum advance width of the font in pixels.
4635 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4638 CAPABILITY is a list whose first element is a symbol representing the
4639 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4640 remaining elements describe the details of the font capability.
4642 If the font is OpenType font, the form of the list is
4643 \(opentype GSUB GPOS)
4644 where GSUB shows which "GSUB" features the font supports, and GPOS
4645 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4646 lists of the format:
4647 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4649 If the font is not OpenType font, currently the length of the form is
4652 SCRIPT is a symbol representing OpenType script tag.
4654 LANGSYS is a symbol representing OpenType langsys tag, or nil
4655 representing the default langsys.
4657 FEATURE is a symbol representing OpenType feature tag.
4659 If the font is not OpenType font, CAPABILITY is nil. */)
4660 (Lisp_Object font_object
)
4665 CHECK_FONT_GET_OBJECT (font_object
, font
);
4667 val
= make_uninit_vector (9);
4668 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4669 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4670 ASET (val
, 2, make_number (font
->pixel_size
));
4671 ASET (val
, 3, make_number (font
->max_width
));
4672 ASET (val
, 4, make_number (font
->ascent
));
4673 ASET (val
, 5, make_number (font
->descent
));
4674 ASET (val
, 6, make_number (font
->space_width
));
4675 ASET (val
, 7, make_number (font
->average_width
));
4676 if (font
->driver
->otf_capability
)
4677 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4679 ASET (val
, 8, Qnil
);
4683 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4685 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4686 FROM and TO are positions (integers or markers) specifying a region
4687 of the current buffer.
4688 If the optional fourth arg OBJECT is not nil, it is a string or a
4689 vector containing the target characters.
4691 Each element is a vector containing information of a glyph in this format:
4692 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4694 FROM is an index numbers of a character the glyph corresponds to.
4695 TO is the same as FROM.
4696 C is the character of the glyph.
4697 CODE is the glyph-code of C in FONT-OBJECT.
4698 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4699 ADJUSTMENT is always nil.
4700 If FONT-OBJECT doesn't have a glyph for a character,
4701 the corresponding element is nil. */)
4702 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4707 Lisp_Object
*chars
, vec
;
4710 CHECK_FONT_GET_OBJECT (font_object
, font
);
4713 ptrdiff_t charpos
, bytepos
;
4715 validate_region (&from
, &to
);
4718 len
= XFASTINT (to
) - XFASTINT (from
);
4719 SAFE_ALLOCA_LISP (chars
, len
);
4720 charpos
= XFASTINT (from
);
4721 bytepos
= CHAR_TO_BYTE (charpos
);
4722 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4725 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4726 chars
[i
] = make_number (c
);
4729 else if (STRINGP (object
))
4731 const unsigned char *p
;
4733 CHECK_NUMBER (from
);
4735 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4736 || XINT (to
) > SCHARS (object
))
4737 args_out_of_range_3 (object
, from
, to
);
4740 len
= XFASTINT (to
) - XFASTINT (from
);
4741 SAFE_ALLOCA_LISP (chars
, len
);
4743 if (STRING_MULTIBYTE (object
))
4744 for (i
= 0; i
< len
; i
++)
4746 int c
= STRING_CHAR_ADVANCE (p
);
4747 chars
[i
] = make_number (c
);
4750 for (i
= 0; i
< len
; i
++)
4751 chars
[i
] = make_number (p
[i
]);
4755 CHECK_VECTOR (object
);
4756 CHECK_NUMBER (from
);
4758 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4759 || XINT (to
) > ASIZE (object
))
4760 args_out_of_range_3 (object
, from
, to
);
4763 len
= XFASTINT (to
) - XFASTINT (from
);
4764 for (i
= 0; i
< len
; i
++)
4766 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4767 CHECK_CHARACTER (elt
);
4769 chars
= aref_addr (object
, XFASTINT (from
));
4772 vec
= make_uninit_vector (len
);
4773 for (i
= 0; i
< len
; i
++)
4776 int c
= XFASTINT (chars
[i
]);
4778 struct font_metrics metrics
;
4780 code
= font
->driver
->encode_char (font
, c
);
4781 if (code
== FONT_INVALID_CODE
)
4783 ASET (vec
, i
, Qnil
);
4787 LGLYPH_SET_FROM (g
, i
);
4788 LGLYPH_SET_TO (g
, i
);
4789 LGLYPH_SET_CHAR (g
, c
);
4790 LGLYPH_SET_CODE (g
, code
);
4791 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4792 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4793 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4794 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4795 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4796 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4799 if (! VECTORP (object
))
4804 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4805 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4806 FONT is a font-spec, font-entity, or font-object. */)
4807 (Lisp_Object spec
, Lisp_Object font
)
4809 CHECK_FONT_SPEC (spec
);
4812 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4815 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4816 doc
: /* Return a font-object for displaying a character at POSITION.
4817 Optional second arg WINDOW, if non-nil, is a window displaying
4818 the current buffer. It defaults to the currently selected window.
4819 Optional third arg STRING, if non-nil, is a string containing the target
4820 character at index specified by POSITION. */)
4821 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4823 struct window
*w
= decode_live_window (window
);
4827 if (XBUFFER (w
->contents
) != current_buffer
)
4828 error ("Specified window is not displaying the current buffer");
4829 CHECK_NUMBER_COERCE_MARKER (position
);
4830 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4831 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4835 CHECK_NUMBER (position
);
4836 CHECK_STRING (string
);
4837 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4838 args_out_of_range (string
, position
);
4841 return font_at (-1, XINT (position
), NULL
, w
, string
);
4845 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4846 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4847 The value is a number of glyphs drawn.
4848 Type C-l to recover what previously shown. */)
4849 (Lisp_Object font_object
, Lisp_Object string
)
4851 Lisp_Object frame
= selected_frame
;
4852 struct frame
*f
= XFRAME (frame
);
4858 CHECK_FONT_GET_OBJECT (font_object
, font
);
4859 CHECK_STRING (string
);
4860 len
= SCHARS (string
);
4861 code
= alloca (sizeof (unsigned) * len
);
4862 for (i
= 0; i
< len
; i
++)
4864 Lisp_Object ch
= Faref (string
, make_number (i
));
4868 code
[i
] = font
->driver
->encode_char (font
, c
);
4869 if (code
[i
] == FONT_INVALID_CODE
)
4872 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4874 if (font
->driver
->prepare_face
)
4875 font
->driver
->prepare_face (f
, face
);
4876 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4877 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4878 if (font
->driver
->done_face
)
4879 font
->driver
->done_face (f
, face
);
4881 return make_number (len
);
4885 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4886 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4887 If FRAME is omitted or nil, use the selected frame. */)
4890 #ifdef HAVE_WINDOW_SYSTEM
4891 struct frame
*f
= decode_live_frame (frame
);
4893 if (FRAME_WINDOW_P (f
))
4894 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4900 #endif /* FONT_DEBUG */
4902 #ifdef HAVE_WINDOW_SYSTEM
4904 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4905 doc
: /* Return information about a font named NAME on frame FRAME.
4906 If FRAME is omitted or nil, use the selected frame.
4907 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4908 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4910 OPENED-NAME is the name used for opening the font,
4911 FULL-NAME is the full name of the font,
4912 SIZE is the pixelsize of the font,
4913 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4914 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4915 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4916 how to compose characters.
4917 If the named font is not yet loaded, return nil. */)
4918 (Lisp_Object name
, Lisp_Object frame
)
4923 Lisp_Object font_object
;
4926 CHECK_STRING (name
);
4927 f
= decode_window_system_frame (frame
);
4931 int fontset
= fs_query_fontset (name
, 0);
4934 name
= fontset_ascii (fontset
);
4935 font_object
= font_open_by_name (f
, name
);
4937 else if (FONT_OBJECT_P (name
))
4939 else if (FONT_ENTITY_P (name
))
4940 font_object
= font_open_entity (f
, name
, 0);
4943 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4944 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4946 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4948 if (NILP (font_object
))
4950 font
= XFONT_OBJECT (font_object
);
4952 info
= make_uninit_vector (7);
4953 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4954 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4955 ASET (info
, 2, make_number (font
->pixel_size
));
4956 ASET (info
, 3, make_number (font
->height
));
4957 ASET (info
, 4, make_number (font
->baseline_offset
));
4958 ASET (info
, 5, make_number (font
->relative_compose
));
4959 ASET (info
, 6, make_number (font
->default_ascent
));
4962 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4963 close it now. Perhaps, we should manage font-objects
4964 by `reference-count'. */
4965 font_close_object (f
, font_object
);
4972 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
4975 build_style_table (const struct table_entry
*entry
, int nelement
)
4978 Lisp_Object table
, elt
;
4980 table
= make_uninit_vector (nelement
);
4981 for (i
= 0; i
< nelement
; i
++)
4983 for (j
= 0; entry
[i
].names
[j
]; j
++);
4984 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4985 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4986 for (j
= 0; entry
[i
].names
[j
]; j
++)
4987 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4988 ASET (table
, i
, elt
);
4993 /* The deferred font-log data of the form [ACTION ARG RESULT].
4994 If ACTION is not nil, that is added to the log when font_add_log is
4995 called next time. At that time, ACTION is set back to nil. */
4996 static Lisp_Object Vfont_log_deferred
;
4998 /* Prepend the font-related logging data in Vfont_log if it is not
4999 `t'. ACTION describes a kind of font-related action (e.g. listing,
5000 opening), ARG is the argument for the action, and RESULT is the
5001 result of the action. */
5003 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5008 if (EQ (Vfont_log
, Qt
))
5010 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5012 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
5014 ASET (Vfont_log_deferred
, 0, Qnil
);
5015 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5016 AREF (Vfont_log_deferred
, 2));
5021 Lisp_Object tail
, elt
;
5022 Lisp_Object equalstr
= build_local_string ("=");
5024 val
= Ffont_xlfd_name (arg
, Qt
);
5025 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5029 if (EQ (XCAR (elt
), QCscript
)
5030 && SYMBOLP (XCDR (elt
)))
5031 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5032 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5033 else if (EQ (XCAR (elt
), QClang
)
5034 && SYMBOLP (XCDR (elt
)))
5035 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5036 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5037 else if (EQ (XCAR (elt
), QCotf
)
5038 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5039 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5041 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5047 && VECTORP (XCAR (result
))
5048 && ASIZE (XCAR (result
)) > 0
5049 && FONTP (AREF (XCAR (result
), 0)))
5050 result
= font_vconcat_entity_vectors (result
);
5053 val
= Ffont_xlfd_name (result
, Qt
);
5054 if (! FONT_SPEC_P (result
))
5055 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5056 build_local_string (":"), val
);
5059 else if (CONSP (result
))
5062 result
= Fcopy_sequence (result
);
5063 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5067 val
= Ffont_xlfd_name (val
, Qt
);
5068 XSETCAR (tail
, val
);
5071 else if (VECTORP (result
))
5073 result
= Fcopy_sequence (result
);
5074 for (i
= 0; i
< ASIZE (result
); i
++)
5076 val
= AREF (result
, i
);
5078 val
= Ffont_xlfd_name (val
, Qt
);
5079 ASET (result
, i
, val
);
5082 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5085 /* Record a font-related logging data to be added to Vfont_log when
5086 font_add_log is called next time. ACTION, ARG, RESULT are the same
5090 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5092 if (EQ (Vfont_log
, Qt
))
5094 ASET (Vfont_log_deferred
, 0, build_string (action
));
5095 ASET (Vfont_log_deferred
, 1, arg
);
5096 ASET (Vfont_log_deferred
, 2, result
);
5102 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5103 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5104 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5105 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5106 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5107 /* Note that the other elements in sort_shift_bits are not used. */
5109 staticpro (&font_charset_alist
);
5110 font_charset_alist
= Qnil
;
5112 DEFSYM (Qopentype
, "opentype");
5114 DEFSYM (Qascii_0
, "ascii-0");
5115 DEFSYM (Qiso8859_1
, "iso8859-1");
5116 DEFSYM (Qiso10646_1
, "iso10646-1");
5117 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5118 DEFSYM (Qunicode_sip
, "unicode-sip");
5122 DEFSYM (QCotf
, ":otf");
5123 DEFSYM (QClang
, ":lang");
5124 DEFSYM (QCscript
, ":script");
5125 DEFSYM (QCantialias
, ":antialias");
5127 DEFSYM (QCfoundry
, ":foundry");
5128 DEFSYM (QCadstyle
, ":adstyle");
5129 DEFSYM (QCregistry
, ":registry");
5130 DEFSYM (QCspacing
, ":spacing");
5131 DEFSYM (QCdpi
, ":dpi");
5132 DEFSYM (QCscalable
, ":scalable");
5133 DEFSYM (QCavgwidth
, ":avgwidth");
5134 DEFSYM (QCfont_entity
, ":font-entity");
5135 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5145 DEFSYM (QCuser_spec
, "user-spec");
5147 staticpro (&scratch_font_spec
);
5148 scratch_font_spec
= Ffont_spec (0, NULL
);
5149 staticpro (&scratch_font_prefer
);
5150 scratch_font_prefer
= Ffont_spec (0, NULL
);
5152 staticpro (&Vfont_log_deferred
);
5153 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5157 staticpro (&otf_list
);
5159 #endif /* HAVE_LIBOTF */
5163 defsubr (&Sfont_spec
);
5164 defsubr (&Sfont_get
);
5165 #ifdef HAVE_WINDOW_SYSTEM
5166 defsubr (&Sfont_face_attributes
);
5168 defsubr (&Sfont_put
);
5169 defsubr (&Slist_fonts
);
5170 defsubr (&Sfont_family_list
);
5171 defsubr (&Sfind_font
);
5172 defsubr (&Sfont_xlfd_name
);
5173 defsubr (&Sclear_font_cache
);
5174 defsubr (&Sfont_shape_gstring
);
5175 defsubr (&Sfont_variation_glyphs
);
5177 defsubr (&Sfont_drive_otf
);
5178 defsubr (&Sfont_otf_alternates
);
5182 defsubr (&Sopen_font
);
5183 defsubr (&Sclose_font
);
5184 defsubr (&Squery_font
);
5185 defsubr (&Sfont_get_glyphs
);
5186 defsubr (&Sfont_match_p
);
5187 defsubr (&Sfont_at
);
5189 defsubr (&Sdraw_string
);
5191 defsubr (&Sframe_font_cache
);
5192 #endif /* FONT_DEBUG */
5193 #ifdef HAVE_WINDOW_SYSTEM
5194 defsubr (&Sfont_info
);
5197 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5199 Alist of fontname patterns vs the corresponding encoding and repertory info.
5200 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5201 where ENCODING is a charset or a char-table,
5202 and REPERTORY is a charset, a char-table, or nil.
5204 If ENCODING and REPERTORY are the same, the element can have the form
5205 \(REGEXP . ENCODING).
5207 ENCODING is for converting a character to a glyph code of the font.
5208 If ENCODING is a charset, encoding a character by the charset gives
5209 the corresponding glyph code. If ENCODING is a char-table, looking up
5210 the table by a character gives the corresponding glyph code.
5212 REPERTORY specifies a repertory of characters supported by the font.
5213 If REPERTORY is a charset, all characters belonging to the charset are
5214 supported. If REPERTORY is a char-table, all characters who have a
5215 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5216 gets the repertory information by an opened font and ENCODING. */);
5217 Vfont_encoding_alist
= Qnil
;
5219 /* FIXME: These 3 vars are not quite what they appear: setq on them
5220 won't have any effect other than disconnect them from the style
5221 table used by the font display code. So we make them read-only,
5222 to avoid this confusing situation. */
5224 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5225 doc
: /* Vector of valid font weight values.
5226 Each element has the form:
5227 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5228 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5229 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5230 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5232 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5233 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5234 See `font-weight-table' for the format of the vector. */);
5235 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5236 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5238 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5239 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5240 See `font-weight-table' for the format of the vector. */);
5241 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5242 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5244 staticpro (&font_style_table
);
5245 font_style_table
= make_uninit_vector (3);
5246 ASET (font_style_table
, 0, Vfont_weight_table
);
5247 ASET (font_style_table
, 1, Vfont_slant_table
);
5248 ASET (font_style_table
, 2, Vfont_width_table
);
5250 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5251 *Logging list of font related actions and results.
5252 The value t means to suppress the logging.
5253 The initial value is set to nil if the environment variable
5254 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5257 #ifdef HAVE_WINDOW_SYSTEM
5258 #ifdef HAVE_FREETYPE
5260 #ifdef HAVE_X_WINDOWS
5265 #endif /* HAVE_XFT */
5266 #endif /* HAVE_X_WINDOWS */
5267 #else /* not HAVE_FREETYPE */
5268 #ifdef HAVE_X_WINDOWS
5270 #endif /* HAVE_X_WINDOWS */
5271 #endif /* not HAVE_FREETYPE */
5274 #endif /* HAVE_BDFFONT */
5277 #endif /* HAVE_NTGUI */
5278 #endif /* HAVE_WINDOW_SYSTEM */
5284 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;