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
);
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));
402 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
,
403 Fvconcat (2, ((Lisp_Object
[])
404 { table
, Fmake_vector (make_number (1), elt
) })));
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
];
1191 AUTO_STRING (stardash
, "*-");
1192 val
= concat2 (stardash
, SYMBOL_NAME (val
));
1195 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1197 AUTO_STRING (dashstar
, "-*");
1198 val
= concat2 (SYMBOL_NAME (val
), dashstar
);
1202 AUTO_STRING (dash
, "-");
1203 val
= concat3 (SYMBOL_NAME (val
), dash
,
1204 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1207 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1209 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1210 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1211 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1213 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1215 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1218 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1219 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1220 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1222 val
= font_prop_validate_spacing (QCspacing
,
1223 prop
[XLFD_SPACING_INDEX
]);
1224 if (! INTEGERP (val
))
1226 ASET (font
, FONT_SPACING_INDEX
, val
);
1228 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1229 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1235 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1236 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1237 0, use PIXEL_SIZE instead. */
1240 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1243 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1247 eassert (FONTP (font
));
1249 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1252 if (i
== FONT_ADSTYLE_INDEX
)
1253 j
= XLFD_ADSTYLE_INDEX
;
1254 else if (i
== FONT_REGISTRY_INDEX
)
1255 j
= XLFD_REGISTRY_INDEX
;
1256 val
= AREF (font
, i
);
1259 if (j
== XLFD_REGISTRY_INDEX
)
1267 val
= SYMBOL_NAME (val
);
1268 if (j
== XLFD_REGISTRY_INDEX
1269 && ! strchr (SSDATA (val
), '-'))
1271 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1272 ptrdiff_t alloc
= SBYTES (val
) + 4;
1273 if (nbytes
<= alloc
)
1275 f
[j
] = p
= alloca (alloc
);
1276 sprintf (p
, "%s%s-*", SDATA (val
),
1277 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1280 f
[j
] = SSDATA (val
);
1284 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1287 val
= font_style_symbolic (font
, i
, 0);
1295 val
= SYMBOL_NAME (val
);
1296 alloc
= SBYTES (val
) + 1;
1297 if (nbytes
<= alloc
)
1299 f
[j
] = p
= alloca (alloc
);
1300 /* Copy the name while excluding '-', '?', ',', and '"'. */
1301 for (k
= l
= 0; k
< alloc
; k
++)
1304 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1310 val
= AREF (font
, FONT_SIZE_INDEX
);
1311 eassert (NUMBERP (val
) || NILP (val
));
1312 char font_size_index_buf
[sizeof "-*"
1313 + MAX (INT_STRLEN_BOUND (EMACS_INT
),
1314 1 + DBL_MAX_10_EXP
+ 1)];
1317 EMACS_INT v
= XINT (val
);
1322 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1323 sprintf (p
, "%"pI
"d-*", v
);
1326 f
[XLFD_PIXEL_INDEX
] = "*-*";
1328 else if (FLOATP (val
))
1330 double v
= XFLOAT_DATA (val
) * 10;
1331 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1332 sprintf (p
, "*-%.0f", v
);
1335 f
[XLFD_PIXEL_INDEX
] = "*-*";
1337 char dpi_index_buf
[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
)];
1338 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1340 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1341 f
[XLFD_RESX_INDEX
] = p
= dpi_index_buf
;
1342 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1345 f
[XLFD_RESX_INDEX
] = "*-*";
1347 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1349 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1351 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1352 : spacing
<= FONT_SPACING_DUAL
? "d"
1353 : spacing
<= FONT_SPACING_MONO
? "m"
1357 f
[XLFD_SPACING_INDEX
] = "*";
1359 char avgwidth_index_buf
[INT_BUFSIZE_BOUND (EMACS_INT
)];
1360 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1362 f
[XLFD_AVGWIDTH_INDEX
] = p
= avgwidth_index_buf
;
1363 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1366 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1368 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1369 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1370 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1371 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1372 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1373 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1374 f
[XLFD_REGISTRY_INDEX
]);
1375 return len
< nbytes
? len
: -1;
1378 /* Parse NAME (null terminated) and store information in FONT
1379 (font-spec or font-entity). NAME is supplied in either the
1380 Fontconfig or GTK font name format. If NAME is successfully
1381 parsed, return 0. Otherwise return -1.
1383 The fontconfig format is
1385 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1389 FAMILY [PROPS...] [SIZE]
1391 This function tries to guess which format it is. */
1394 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1397 char *size_beg
= NULL
, *size_end
= NULL
;
1398 char *props_beg
= NULL
, *family_end
= NULL
;
1403 for (p
= name
; *p
; p
++)
1405 if (*p
== '\\' && p
[1])
1409 props_beg
= family_end
= p
;
1414 bool decimal
= 0, size_found
= 1;
1415 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1416 if (! c_isdigit (*q
))
1418 if (*q
!= '.' || decimal
)
1437 Lisp_Object extra_props
= Qnil
;
1439 /* A fontconfig name with size and/or property data. */
1440 if (family_end
> name
)
1443 family
= font_intern_prop (name
, family_end
- name
, 1);
1444 ASET (font
, FONT_FAMILY_INDEX
, family
);
1448 double point_size
= strtod (size_beg
, &size_end
);
1449 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1450 if (*size_end
== ':' && size_end
[1])
1451 props_beg
= size_end
;
1455 /* Now parse ":KEY=VAL" patterns. */
1458 for (p
= props_beg
; *p
; p
= q
)
1460 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1463 /* Must be an enumerated value. */
1467 val
= font_intern_prop (p
, q
- p
, 1);
1469 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1470 && memcmp (p, STR, strlen (STR)) == 0)
1472 if (PROP_MATCH ("light")
1473 || PROP_MATCH ("medium")
1474 || PROP_MATCH ("demibold")
1475 || PROP_MATCH ("bold")
1476 || PROP_MATCH ("black"))
1477 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1478 else if (PROP_MATCH ("roman")
1479 || PROP_MATCH ("italic")
1480 || PROP_MATCH ("oblique"))
1481 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1482 else if (PROP_MATCH ("charcell"))
1483 ASET (font
, FONT_SPACING_INDEX
,
1484 make_number (FONT_SPACING_CHARCELL
));
1485 else if (PROP_MATCH ("mono"))
1486 ASET (font
, FONT_SPACING_INDEX
,
1487 make_number (FONT_SPACING_MONO
));
1488 else if (PROP_MATCH ("proportional"))
1489 ASET (font
, FONT_SPACING_INDEX
,
1490 make_number (FONT_SPACING_PROPORTIONAL
));
1499 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1500 prop
= FONT_SIZE_INDEX
;
1503 key
= font_intern_prop (p
, q
- p
, 1);
1504 prop
= get_font_prop_index (key
);
1508 for (q
= p
; *q
&& *q
!= ':'; q
++);
1509 val
= font_intern_prop (p
, q
- p
, 0);
1511 if (prop
>= FONT_FOUNDRY_INDEX
1512 && prop
< FONT_EXTRA_INDEX
)
1513 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1516 extra_props
= nconc2 (extra_props
,
1517 list1 (Fcons (key
, val
)));
1524 if (! NILP (extra_props
))
1526 struct font_driver_list
*driver_list
= font_driver_list
;
1527 for ( ; driver_list
; driver_list
= driver_list
->next
)
1528 if (driver_list
->driver
->filter_properties
)
1529 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1535 /* Either a fontconfig-style name with no size and property
1536 data, or a GTK-style name. */
1537 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1538 Lisp_Object width
= Qnil
, size
= Qnil
;
1542 /* Scan backwards from the end, looking for a size. */
1543 for (p
= name
+ len
- 1; p
>= name
; p
--)
1544 if (!c_isdigit (*p
))
1547 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1548 /* Found a font size. */
1549 size
= make_float (strtod (p
+ 1, NULL
));
1553 /* Now P points to the termination of the string, sans size.
1554 Scan backwards, looking for font properties. */
1555 for (; p
> name
; p
= q
)
1557 for (q
= p
- 1; q
>= name
; q
--)
1559 if (q
> name
&& *(q
-1) == '\\')
1560 --q
; /* Skip quoting backslashes. */
1566 word_len
= p
- word_start
;
1568 #define PROP_MATCH(STR) \
1569 (word_len == strlen (STR) \
1570 && memcmp (word_start, STR, strlen (STR)) == 0)
1571 #define PROP_SAVE(VAR, STR) \
1572 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1574 if (PROP_MATCH ("Ultra-Light"))
1575 PROP_SAVE (weight
, "ultra-light");
1576 else if (PROP_MATCH ("Light"))
1577 PROP_SAVE (weight
, "light");
1578 else if (PROP_MATCH ("Book"))
1579 PROP_SAVE (weight
, "book");
1580 else if (PROP_MATCH ("Medium"))
1581 PROP_SAVE (weight
, "medium");
1582 else if (PROP_MATCH ("Semi-Bold"))
1583 PROP_SAVE (weight
, "semi-bold");
1584 else if (PROP_MATCH ("Bold"))
1585 PROP_SAVE (weight
, "bold");
1586 else if (PROP_MATCH ("Italic"))
1587 PROP_SAVE (slant
, "italic");
1588 else if (PROP_MATCH ("Oblique"))
1589 PROP_SAVE (slant
, "oblique");
1590 else if (PROP_MATCH ("Semi-Condensed"))
1591 PROP_SAVE (width
, "semi-condensed");
1592 else if (PROP_MATCH ("Condensed"))
1593 PROP_SAVE (width
, "condensed");
1594 /* An unknown word must be part of the font name. */
1605 ASET (font
, FONT_FAMILY_INDEX
,
1606 font_intern_prop (name
, family_end
- name
, 1));
1608 ASET (font
, FONT_SIZE_INDEX
, size
);
1610 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1612 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1614 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1620 #if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
1622 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1623 NAME (NBYTES length), and return the name length. If
1624 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
1625 Return a negative value on error. */
1628 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1630 Lisp_Object family
, foundry
;
1636 Lisp_Object styles
[3];
1637 const char *style_names
[3] = { "weight", "slant", "width" };
1639 family
= AREF (font
, FONT_FAMILY_INDEX
);
1640 if (! NILP (family
))
1642 if (SYMBOLP (family
))
1643 family
= SYMBOL_NAME (family
);
1648 val
= AREF (font
, FONT_SIZE_INDEX
);
1651 if (XINT (val
) != 0)
1652 pixel_size
= XINT (val
);
1657 eassert (FLOATP (val
));
1659 point_size
= (int) XFLOAT_DATA (val
);
1662 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1663 if (! NILP (foundry
))
1665 if (SYMBOLP (foundry
))
1666 foundry
= SYMBOL_NAME (foundry
);
1671 for (i
= 0; i
< 3; i
++)
1672 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1675 lim
= name
+ nbytes
;
1676 if (! NILP (family
))
1678 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1679 if (! (0 <= len
&& len
< lim
- p
))
1685 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1686 if (! (0 <= len
&& len
< lim
- p
))
1690 else if (pixel_size
> 0)
1692 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1693 if (! (0 <= len
&& len
< lim
- p
))
1697 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1699 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1700 SSDATA (SYMBOL_NAME (AREF (font
,
1701 FONT_FOUNDRY_INDEX
))));
1702 if (! (0 <= len
&& len
< lim
- p
))
1706 for (i
= 0; i
< 3; i
++)
1707 if (! NILP (styles
[i
]))
1709 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1710 SSDATA (SYMBOL_NAME (styles
[i
])));
1711 if (! (0 <= len
&& len
< lim
- p
))
1716 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1718 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1719 XINT (AREF (font
, FONT_DPI_INDEX
)));
1720 if (! (0 <= len
&& len
< lim
- p
))
1725 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1727 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1728 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1729 if (! (0 <= len
&& len
< lim
- p
))
1734 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1736 int len
= snprintf (p
, lim
- p
,
1737 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1739 : ":scalable=false"));
1740 if (! (0 <= len
&& len
< lim
- p
))
1750 /* Parse NAME (null terminated) and store information in FONT
1751 (font-spec or font-entity). If NAME is successfully parsed, return
1752 0. Otherwise return -1. */
1755 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1757 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1758 return font_parse_xlfd (name
, namelen
, font
);
1759 return font_parse_fcname (name
, namelen
, font
);
1763 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1764 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1768 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1774 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1776 CHECK_STRING (family
);
1777 len
= SBYTES (family
);
1778 p0
= SSDATA (family
);
1779 p1
= strchr (p0
, '-');
1782 if ((*p0
!= '*' && p1
- p0
> 0)
1783 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1784 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1787 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1790 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1792 if (! NILP (registry
))
1794 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1795 CHECK_STRING (registry
);
1796 len
= SBYTES (registry
);
1797 p0
= SSDATA (registry
);
1798 p1
= strchr (p0
, '-');
1801 AUTO_STRING (extra
, ("*-*" + (len
&& p0
[len
- 1] == '*')));
1802 registry
= concat2 (registry
, extra
);
1804 registry
= Fdowncase (registry
);
1805 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1810 /* This part (through the next ^L) is still experimental and not
1811 tested much. We may drastically change codes. */
1817 #define LGSTRING_HEADER_SIZE 6
1818 #define LGSTRING_GLYPH_SIZE 8
1821 check_gstring (Lisp_Object gstring
)
1827 CHECK_VECTOR (gstring
);
1828 val
= AREF (gstring
, 0);
1830 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1832 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1833 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1834 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1835 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1836 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1837 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1838 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1839 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1840 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1841 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1842 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1844 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1846 val
= LGSTRING_GLYPH (gstring
, i
);
1848 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1850 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1852 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1853 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1854 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1855 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1856 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1857 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1858 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1859 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1861 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1863 if (ASIZE (val
) < 3)
1865 for (j
= 0; j
< 3; j
++)
1866 CHECK_NUMBER (AREF (val
, j
));
1871 error ("Invalid glyph-string format");
1876 check_otf_features (Lisp_Object otf_features
)
1880 CHECK_CONS (otf_features
);
1881 CHECK_SYMBOL (XCAR (otf_features
));
1882 otf_features
= XCDR (otf_features
);
1883 CHECK_CONS (otf_features
);
1884 CHECK_SYMBOL (XCAR (otf_features
));
1885 otf_features
= XCDR (otf_features
);
1886 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1888 CHECK_SYMBOL (XCAR (val
));
1889 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1890 error ("Invalid OTF GSUB feature: %s",
1891 SDATA (SYMBOL_NAME (XCAR (val
))));
1893 otf_features
= XCDR (otf_features
);
1894 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1896 CHECK_SYMBOL (XCAR (val
));
1897 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1898 error ("Invalid OTF GPOS feature: %s",
1899 SDATA (SYMBOL_NAME (XCAR (val
))));
1906 Lisp_Object otf_list
;
1909 otf_tag_symbol (OTF_Tag tag
)
1913 OTF_tag_name (tag
, name
);
1914 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1918 otf_open (Lisp_Object file
)
1920 Lisp_Object val
= Fassoc (file
, otf_list
);
1924 otf
= XSAVE_POINTER (XCDR (val
), 0);
1927 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1928 val
= make_save_ptr (otf
);
1929 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1935 /* Return a list describing which scripts/languages FONT supports by
1936 which GSUB/GPOS features of OpenType tables. See the comment of
1937 (struct font_driver).otf_capability. */
1940 font_otf_capability (struct font
*font
)
1943 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1946 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1949 for (i
= 0; i
< 2; i
++)
1951 OTF_GSUB_GPOS
*gsub_gpos
;
1952 Lisp_Object script_list
= Qnil
;
1955 if (OTF_get_features (otf
, i
== 0) < 0)
1957 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1958 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1960 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1961 Lisp_Object langsys_list
= Qnil
;
1962 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1965 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1967 OTF_LangSys
*langsys
;
1968 Lisp_Object feature_list
= Qnil
;
1969 Lisp_Object langsys_tag
;
1972 if (k
== script
->LangSysCount
)
1974 langsys
= &script
->DefaultLangSys
;
1979 langsys
= script
->LangSys
+ k
;
1981 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1983 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1985 OTF_Feature
*feature
1986 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1987 Lisp_Object feature_tag
1988 = otf_tag_symbol (feature
->FeatureTag
);
1990 feature_list
= Fcons (feature_tag
, feature_list
);
1992 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1995 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2000 XSETCAR (capability
, script_list
);
2002 XSETCDR (capability
, script_list
);
2008 /* Parse OTF features in SPEC and write a proper features spec string
2009 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2010 assured that the sufficient memory has already allocated for
2014 generate_otf_features (Lisp_Object spec
, char *features
)
2022 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2028 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2033 else if (! asterisk
)
2035 val
= SYMBOL_NAME (val
);
2036 p
+= esprintf (p
, "%s", SDATA (val
));
2040 val
= SYMBOL_NAME (val
);
2041 p
+= esprintf (p
, "~%s", SDATA (val
));
2045 error ("OTF spec too long");
2049 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
2051 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2053 return Fcons (make_number (len
),
2054 make_unibyte_string (device_table
->DeltaValue
, len
));
2058 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2060 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2062 if (value_format
& OTF_XPlacement
)
2063 ASET (val
, 0, make_number (value_record
->XPlacement
));
2064 if (value_format
& OTF_YPlacement
)
2065 ASET (val
, 1, make_number (value_record
->YPlacement
));
2066 if (value_format
& OTF_XAdvance
)
2067 ASET (val
, 2, make_number (value_record
->XAdvance
));
2068 if (value_format
& OTF_YAdvance
)
2069 ASET (val
, 3, make_number (value_record
->YAdvance
));
2070 if (value_format
& OTF_XPlaDevice
)
2071 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2072 if (value_format
& OTF_YPlaDevice
)
2073 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2074 if (value_format
& OTF_XAdvDevice
)
2075 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2076 if (value_format
& OTF_YAdvDevice
)
2077 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2082 font_otf_Anchor (OTF_Anchor
*anchor
)
2086 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2087 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2088 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2089 if (anchor
->AnchorFormat
== 2)
2090 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2093 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2094 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2098 #endif /* HAVE_LIBOTF */
2105 font_rescale_ratio (Lisp_Object font_entity
)
2107 Lisp_Object tail
, elt
;
2108 Lisp_Object name
= Qnil
;
2110 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2113 if (FLOATP (XCDR (elt
)))
2115 if (STRINGP (XCAR (elt
)))
2118 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2119 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2120 return XFLOAT_DATA (XCDR (elt
));
2122 else if (FONT_SPEC_P (XCAR (elt
)))
2124 if (font_match_p (XCAR (elt
), font_entity
))
2125 return XFLOAT_DATA (XCDR (elt
));
2132 /* We sort fonts by scoring each of them against a specified
2133 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2134 the value is, the closer the font is to the font-spec.
2136 The lowest 2 bits of the score are used for driver type. The font
2137 available by the most preferred font driver is 0.
2139 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2140 WEIGHT, SLANT, WIDTH, and SIZE. */
2142 /* How many bits to shift to store the difference value of each font
2143 property in a score. Note that floats for FONT_TYPE_INDEX and
2144 FONT_REGISTRY_INDEX are not used. */
2145 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2147 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2148 The return value indicates how different ENTITY is compared with
2152 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2157 /* Score three style numeric fields. Maximum difference is 127. */
2158 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2159 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2161 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2162 - (XINT (spec_prop
[i
]) >> 8));
2163 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2166 /* Score the size. Maximum difference is 127. */
2167 i
= FONT_SIZE_INDEX
;
2168 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2169 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2171 /* We use the higher 6-bit for the actual size difference. The
2172 lowest bit is set if the DPI is different. */
2174 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2175 EMACS_INT entity_size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
2177 if (CONSP (Vface_font_rescale_alist
))
2178 pixel_size
*= font_rescale_ratio (entity
);
2179 if (pixel_size
* 2 < entity_size
|| entity_size
* 2 < pixel_size
)
2180 /* This size is wrong by more than a factor 2: reject it! */
2182 diff
= eabs (pixel_size
- entity_size
) << 1;
2183 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2184 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2186 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2187 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2189 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2196 /* Concatenate all elements of LIST into one vector. LIST is a list
2197 of font-entity vectors. */
2200 font_vconcat_entity_vectors (Lisp_Object list
)
2202 EMACS_INT nargs
= XFASTINT (Flength (list
));
2205 SAFE_ALLOCA_LISP (args
, nargs
);
2208 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2209 args
[i
] = XCAR (list
);
2210 Lisp_Object result
= Fvconcat (nargs
, args
);
2216 /* The structure for elements being sorted by qsort. */
2217 struct font_sort_data
2220 int font_driver_preference
;
2225 /* The comparison function for qsort. */
2228 font_compare (const void *d1
, const void *d2
)
2230 const struct font_sort_data
*data1
= d1
;
2231 const struct font_sort_data
*data2
= d2
;
2233 if (data1
->score
< data2
->score
)
2235 else if (data1
->score
> data2
->score
)
2237 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2241 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2242 If PREFER specifies a point-size, calculate the corresponding
2243 pixel-size from QCdpi property of PREFER or from the Y-resolution
2244 of FRAME before sorting.
2246 If BEST-ONLY is nonzero, return the best matching entity (that
2247 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2248 if BEST-ONLY is negative). Otherwise, return the sorted result as
2249 a single vector of font-entities.
2251 This function does no optimization for the case that the total
2252 number of elements is 1. The caller should avoid calling this in
2256 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2257 struct frame
*f
, int best_only
)
2259 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2261 struct font_sort_data
*data
;
2262 unsigned best_score
;
2263 Lisp_Object best_entity
;
2264 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2267 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2268 prefer_prop
[i
] = AREF (prefer
, i
);
2269 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2270 prefer_prop
[FONT_SIZE_INDEX
]
2271 = make_number (font_pixel_size (f
, prefer
));
2273 if (NILP (XCDR (list
)))
2275 /* What we have to take care of is this single vector. */
2277 maxlen
= ASIZE (vec
);
2281 /* We don't have to perform sort, so there's no need of creating
2282 a single vector. But, we must find the length of the longest
2285 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2286 if (maxlen
< ASIZE (XCAR (tail
)))
2287 maxlen
= ASIZE (XCAR (tail
));
2291 /* We have to create a single vector to sort it. */
2292 vec
= font_vconcat_entity_vectors (list
);
2293 maxlen
= ASIZE (vec
);
2296 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2297 best_score
= 0xFFFFFFFF;
2300 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2302 int font_driver_preference
= 0;
2303 Lisp_Object current_font_driver
;
2309 /* We are sure that the length of VEC > 0. */
2310 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2311 /* Score the elements. */
2312 for (i
= 0; i
< len
; i
++)
2314 data
[i
].entity
= AREF (vec
, i
);
2316 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2318 ? font_score (data
[i
].entity
, prefer_prop
)
2320 if (best_only
&& best_score
> data
[i
].score
)
2322 best_score
= data
[i
].score
;
2323 best_entity
= data
[i
].entity
;
2324 if (best_score
== 0)
2327 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2329 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2330 font_driver_preference
++;
2332 data
[i
].font_driver_preference
= font_driver_preference
;
2335 /* Sort if necessary. */
2338 qsort (data
, len
, sizeof *data
, font_compare
);
2339 for (i
= 0; i
< len
; i
++)
2340 ASET (vec
, i
, data
[i
].entity
);
2349 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2354 /* API of Font Service Layer. */
2356 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2357 sort_shift_bits. Finternal_set_font_selection_order calls this
2358 function with font_sort_order after setting up it. */
2361 font_update_sort_order (int *order
)
2365 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2367 int xlfd_idx
= order
[i
];
2369 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2370 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2371 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2372 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2373 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2374 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2376 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2381 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2382 Lisp_Object features
, Lisp_Object table
)
2387 table
= assq_no_quit (script
, table
);
2390 table
= XCDR (table
);
2391 if (! NILP (langsys
))
2393 table
= assq_no_quit (langsys
, table
);
2399 val
= assq_no_quit (Qnil
, table
);
2401 table
= XCAR (table
);
2405 table
= XCDR (table
);
2406 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2408 if (NILP (XCAR (features
)))
2413 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2419 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2422 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2424 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2426 script
= XCAR (spec
);
2430 langsys
= XCAR (spec
);
2441 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2442 XCAR (otf_capability
)))
2444 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2445 XCDR (otf_capability
)))
2452 /* Check if FONT (font-entity or font-object) matches with the font
2453 specification SPEC. */
2456 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2458 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2459 Lisp_Object extra
, font_extra
;
2462 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2463 if (! NILP (AREF (spec
, i
))
2464 && ! NILP (AREF (font
, i
))
2465 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2467 props
= XFONT_SPEC (spec
)->props
;
2468 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2470 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2471 prop
[i
] = AREF (spec
, i
);
2472 prop
[FONT_SIZE_INDEX
]
2473 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2477 if (font_score (font
, props
) > 0)
2479 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2480 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2481 for (; CONSP (extra
); extra
= XCDR (extra
))
2483 Lisp_Object key
= XCAR (XCAR (extra
));
2484 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2486 if (EQ (key
, QClang
))
2488 val2
= assq_no_quit (key
, font_extra
);
2497 if (NILP (Fmemq (val
, val2
)))
2502 ? NILP (Fmemq (val
, XCDR (val2
)))
2506 else if (EQ (key
, QCscript
))
2508 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2514 /* All characters in the list must be supported. */
2515 for (; CONSP (val2
); val2
= XCDR (val2
))
2517 if (! CHARACTERP (XCAR (val2
)))
2519 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2520 == FONT_INVALID_CODE
)
2524 else if (VECTORP (val2
))
2526 /* At most one character in the vector must be supported. */
2527 for (i
= 0; i
< ASIZE (val2
); i
++)
2529 if (! CHARACTERP (AREF (val2
, i
)))
2531 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2532 != FONT_INVALID_CODE
)
2535 if (i
== ASIZE (val2
))
2540 else if (EQ (key
, QCotf
))
2544 if (! FONT_OBJECT_P (font
))
2546 fontp
= XFONT_OBJECT (font
);
2547 if (! fontp
->driver
->otf_capability
)
2549 val2
= fontp
->driver
->otf_capability (fontp
);
2550 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2561 Each font backend has the callback function get_cache, and it
2562 returns a cons cell of which cdr part can be freely used for
2563 caching fonts. The cons cell may be shared by multiple frames
2564 and/or multiple font drivers. So, we arrange the cdr part as this:
2566 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2568 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2569 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2570 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2572 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2573 static void font_finish_cache (struct frame
*, struct font_driver
*);
2574 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2575 static void font_clear_cache (struct frame
*, Lisp_Object
,
2576 struct font_driver
*);
2579 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2581 Lisp_Object cache
, val
;
2583 cache
= driver
->get_cache (f
);
2585 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2589 val
= list2 (driver
->type
, make_number (1));
2590 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2594 val
= XCDR (XCAR (val
));
2595 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2601 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2603 Lisp_Object cache
, val
, tmp
;
2606 cache
= driver
->get_cache (f
);
2608 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2609 cache
= val
, val
= XCDR (val
);
2610 eassert (! NILP (val
));
2611 tmp
= XCDR (XCAR (val
));
2612 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2613 if (XINT (XCAR (tmp
)) == 0)
2615 font_clear_cache (f
, XCAR (val
), driver
);
2616 XSETCDR (cache
, XCDR (val
));
2622 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2624 Lisp_Object val
= driver
->get_cache (f
);
2625 Lisp_Object type
= driver
->type
;
2627 eassert (CONSP (val
));
2628 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2629 eassert (CONSP (val
));
2630 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2631 val
= XCDR (XCAR (val
));
2637 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2639 Lisp_Object tail
, elt
;
2643 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2644 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2647 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2648 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2651 eassert (VECTORP (elt
));
2652 for (i
= 0; i
< ASIZE (elt
); i
++)
2654 entity
= AREF (elt
, i
);
2656 if (FONT_ENTITY_P (entity
)
2657 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2659 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2661 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2663 Lisp_Object val
= XCAR (objlist
);
2664 struct font
*font
= XFONT_OBJECT (val
);
2666 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2668 eassert (font
&& driver
== font
->driver
);
2669 driver
->close (font
);
2672 if (driver
->free_entity
)
2673 driver
->free_entity (entity
);
2678 XSETCDR (cache
, Qnil
);
2682 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2684 /* Check each font-entity in VEC, and return a list of font-entities
2685 that satisfy these conditions:
2686 (1) matches with SPEC and SIZE if SPEC is not nil, and
2687 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2691 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2693 Lisp_Object entity
, val
;
2694 enum font_property_index prop
;
2697 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2699 entity
= AREF (vec
, i
);
2700 if (! NILP (Vface_ignored_fonts
))
2704 Lisp_Object tail
, regexp
;
2706 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2709 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2711 regexp
= XCAR (tail
);
2712 if (STRINGP (regexp
)
2713 && fast_c_string_match_ignore_case (regexp
, name
,
2723 val
= Fcons (entity
, val
);
2726 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2727 if (INTEGERP (AREF (spec
, prop
))
2728 && ((XINT (AREF (spec
, prop
)) >> 8)
2729 != (XINT (AREF (entity
, prop
)) >> 8)))
2730 prop
= FONT_SPEC_MAX
;
2731 if (prop
< FONT_SPEC_MAX
2733 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2735 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2737 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2738 prop
= FONT_SPEC_MAX
;
2740 if (prop
< FONT_SPEC_MAX
2741 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2742 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2743 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2744 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2745 prop
= FONT_SPEC_MAX
;
2746 if (prop
< FONT_SPEC_MAX
2747 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2748 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2749 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2750 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2751 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2752 prop
= FONT_SPEC_MAX
;
2753 if (prop
< FONT_SPEC_MAX
)
2754 val
= Fcons (entity
, val
);
2756 return (Fvconcat (1, &val
));
2760 /* Return a list of vectors of font-entities matching with SPEC on
2761 FRAME. Each elements in the list is a vector of entities from the
2762 same font-driver. */
2765 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2767 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2768 Lisp_Object ftype
, val
;
2769 Lisp_Object list
= Qnil
;
2771 bool need_filtering
= 0;
2774 eassert (FONT_SPEC_P (spec
));
2776 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2777 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2778 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2779 size
= font_pixel_size (f
, spec
);
2783 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2784 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2785 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2786 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2787 if (i
!= FONT_SPACING_INDEX
)
2789 ASET (scratch_font_spec
, i
, Qnil
);
2790 if (! NILP (AREF (spec
, i
)))
2793 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2794 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2796 for (; driver_list
; driver_list
= driver_list
->next
)
2798 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2800 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2802 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2803 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2808 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2811 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2813 val
= Fvconcat (1, &val
);
2814 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2815 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2818 if (VECTORP (val
) && ASIZE (val
) > 0
2820 || ! NILP (Vface_ignored_fonts
)))
2821 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2822 if (VECTORP (val
) && ASIZE (val
) > 0)
2823 list
= Fcons (val
, list
);
2826 list
= Fnreverse (list
);
2827 FONT_ADD_LOG ("list", spec
, list
);
2832 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2833 nil, is an array of face's attributes, which specifies preferred
2834 font-related attributes. */
2837 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2839 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2840 Lisp_Object ftype
, size
, entity
;
2841 Lisp_Object work
= copy_font_spec (spec
);
2843 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2844 size
= AREF (spec
, FONT_SIZE_INDEX
);
2847 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2848 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2849 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2850 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2853 for (; driver_list
; driver_list
= driver_list
->next
)
2855 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2857 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2859 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2860 entity
= assoc_no_quit (work
, XCDR (cache
));
2862 entity
= AREF (XCDR (entity
), 0);
2865 entity
= driver_list
->driver
->match (f
, work
);
2868 Lisp_Object copy
= copy_font_spec (work
);
2869 Lisp_Object match
= Fvector (1, &entity
);
2871 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2872 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2875 if (! NILP (entity
))
2878 FONT_ADD_LOG ("match", work
, entity
);
2883 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2884 opened font object. */
2887 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2889 struct font_driver_list
*driver_list
;
2890 Lisp_Object objlist
, size
, val
, font_object
;
2892 int min_width
, height
, psize
;
2894 eassert (FONT_ENTITY_P (entity
));
2895 size
= AREF (entity
, FONT_SIZE_INDEX
);
2896 if (XINT (size
) != 0)
2897 pixel_size
= XINT (size
);
2899 val
= AREF (entity
, FONT_TYPE_INDEX
);
2900 for (driver_list
= f
->font_driver_list
;
2901 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2902 driver_list
= driver_list
->next
);
2906 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2907 objlist
= XCDR (objlist
))
2909 Lisp_Object fn
= XCAR (objlist
);
2910 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2911 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2913 if (driver_list
->driver
->cached_font_ok
== NULL
2914 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2919 /* We always open a font of manageable size; i.e non-zero average
2920 width and height. */
2921 for (psize
= pixel_size
; ; psize
++)
2923 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2924 if (NILP (font_object
))
2926 font
= XFONT_OBJECT (font_object
);
2927 if (font
->average_width
> 0 && font
->height
> 0)
2930 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2931 FONT_ADD_LOG ("open", entity
, font_object
);
2932 ASET (entity
, FONT_OBJLIST_INDEX
,
2933 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2935 font
= XFONT_OBJECT (font_object
);
2936 min_width
= (font
->min_width
? font
->min_width
2937 : font
->average_width
? font
->average_width
2938 : font
->space_width
? font
->space_width
2940 height
= (font
->height
? font
->height
: 1);
2941 #ifdef HAVE_WINDOW_SYSTEM
2942 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2943 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2945 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2946 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2947 f
->fonts_changed
= 1;
2951 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2952 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2953 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2954 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2962 /* Close FONT_OBJECT that is opened on frame F. */
2965 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2967 struct font
*font
= XFONT_OBJECT (font_object
);
2969 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2970 /* Already closed. */
2972 FONT_ADD_LOG ("close", font_object
, Qnil
);
2973 font
->driver
->close (font
);
2974 #ifdef HAVE_WINDOW_SYSTEM
2975 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2976 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2981 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2982 FONT is a font-entity and it must be opened to check. */
2985 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2989 if (FONT_ENTITY_P (font
))
2991 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2992 struct font_driver_list
*driver_list
;
2994 for (driver_list
= f
->font_driver_list
;
2995 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2996 driver_list
= driver_list
->next
);
2999 if (! driver_list
->driver
->has_char
)
3001 return driver_list
->driver
->has_char (font
, c
);
3004 eassert (FONT_OBJECT_P (font
));
3005 fontp
= XFONT_OBJECT (font
);
3006 if (fontp
->driver
->has_char
)
3008 int result
= fontp
->driver
->has_char (font
, c
);
3013 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3017 /* Return the glyph ID of FONT_OBJECT for character C. */
3020 font_encode_char (Lisp_Object font_object
, int c
)
3024 eassert (FONT_OBJECT_P (font_object
));
3025 font
= XFONT_OBJECT (font_object
);
3026 return font
->driver
->encode_char (font
, c
);
3030 /* Return the name of FONT_OBJECT. */
3033 font_get_name (Lisp_Object font_object
)
3035 eassert (FONT_OBJECT_P (font_object
));
3036 return AREF (font_object
, FONT_NAME_INDEX
);
3040 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3041 could not be parsed by font_parse_name, return Qnil. */
3044 font_spec_from_name (Lisp_Object font_name
)
3046 Lisp_Object spec
= Ffont_spec (0, NULL
);
3048 CHECK_STRING (font_name
);
3049 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
3051 font_put_extra (spec
, QCname
, font_name
);
3052 font_put_extra (spec
, QCuser_spec
, font_name
);
3058 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3060 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3065 if (! NILP (Ffont_get (font
, QCname
)))
3067 font
= copy_font_spec (font
);
3068 font_put_extra (font
, QCname
, Qnil
);
3071 if (NILP (AREF (font
, prop
))
3072 && prop
!= FONT_FAMILY_INDEX
3073 && prop
!= FONT_FOUNDRY_INDEX
3074 && prop
!= FONT_WIDTH_INDEX
3075 && prop
!= FONT_SIZE_INDEX
)
3077 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3078 font
= copy_font_spec (font
);
3079 ASET (font
, prop
, Qnil
);
3080 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3082 if (prop
== FONT_FAMILY_INDEX
)
3084 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3085 /* If we are setting the font family, we must also clear
3086 FONT_WIDTH_INDEX to avoid rejecting families that lack
3087 support for some widths. */
3088 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3090 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3091 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3092 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3093 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3094 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3095 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3097 else if (prop
== FONT_SIZE_INDEX
)
3099 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3100 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3101 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3103 else if (prop
== FONT_WIDTH_INDEX
)
3104 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3105 attrs
[LFACE_FONT_INDEX
] = font
;
3108 /* Select a font from ENTITIES (list of font-entity vectors) that
3109 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3112 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3113 Lisp_Object
*attrs
, int pixel_size
, int c
)
3115 Lisp_Object font_entity
;
3119 if (NILP (XCDR (entities
))
3120 && ASIZE (XCAR (entities
)) == 1)
3122 font_entity
= AREF (XCAR (entities
), 0);
3123 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3128 /* Sort fonts by properties specified in ATTRS. */
3129 prefer
= scratch_font_prefer
;
3131 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3132 ASET (prefer
, i
, Qnil
);
3133 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3135 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3137 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3138 ASET (prefer
, i
, AREF (face_font
, i
));
3140 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3141 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3142 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3143 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3144 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3145 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3146 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3148 return font_sort_entities (entities
, prefer
, f
, c
);
3151 /* Return a font-entity that satisfies SPEC and is the best match for
3152 face's font related attributes in ATTRS. C, if not negative, is a
3153 character that the entity must support. */
3156 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3159 Lisp_Object entities
, val
;
3160 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3165 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3166 if (NILP (registry
[0]))
3168 registry
[0] = DEFAULT_ENCODING
;
3169 registry
[1] = Qascii_0
;
3170 registry
[2] = zero_vector
;
3173 registry
[1] = zero_vector
;
3175 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3177 struct charset
*encoding
, *repertory
;
3179 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3180 &encoding
, &repertory
) < 0)
3183 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3185 else if (c
> encoding
->max_char
)
3189 work
= copy_font_spec (spec
);
3190 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3191 pixel_size
= font_pixel_size (f
, spec
);
3192 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3194 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3196 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3200 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3201 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3202 if (! NILP (foundry
[0]))
3203 foundry
[1] = zero_vector
;
3204 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3206 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3207 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3209 foundry
[2] = zero_vector
;
3212 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3214 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3215 if (! NILP (adstyle
[0]))
3216 adstyle
[1] = zero_vector
;
3217 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3219 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3221 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3223 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3225 adstyle
[2] = zero_vector
;
3228 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3231 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3234 val
= AREF (work
, FONT_FAMILY_INDEX
);
3235 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3237 val
= attrs
[LFACE_FAMILY_INDEX
];
3238 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3240 Lisp_Object familybuf
[3];
3245 family
[1] = zero_vector
; /* terminator. */
3250 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3252 if (! NILP (alters
))
3254 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3255 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3256 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3257 family
[i
] = XCAR (alters
);
3258 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3260 family
[i
] = zero_vector
;
3267 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3269 family
[i
] = zero_vector
;
3273 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3275 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3276 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3278 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3279 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3281 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3282 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3284 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3285 entities
= font_list_entities (f
, work
);
3286 if (! NILP (entities
))
3288 val
= font_select_entity (f
, entities
,
3289 attrs
, pixel_size
, c
);
3307 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3311 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3312 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3313 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3316 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3317 size
= font_pixel_size (f
, spec
);
3321 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3322 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3325 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3326 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3327 eassert (INTEGERP (height
));
3332 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3336 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3337 size
= (NUMBERP (ffsize
)
3338 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3342 size
*= font_rescale_ratio (entity
);
3345 return font_open_entity (f
, entity
, size
);
3349 /* Find a font that satisfies SPEC and is the best match for
3350 face's attributes in ATTRS on FRAME, and return the opened
3354 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3356 Lisp_Object entity
, name
;
3358 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3361 /* No font is listed for SPEC, but each font-backend may have
3362 different criteria about "font matching". So, try it. */
3363 entity
= font_matching_entity (f
, attrs
, spec
);
3367 /* Don't lose the original name that was put in initially. We need
3368 it to re-apply the font when font parameters (like hinting or dpi) have
3370 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3373 name
= Ffont_get (spec
, QCuser_spec
);
3374 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3380 /* Make FACE on frame F ready to use the font opened for FACE. */
3383 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3385 if (face
->font
->driver
->prepare_face
)
3386 face
->font
->driver
->prepare_face (f
, face
);
3390 /* Make FACE on frame F stop using the font opened for FACE. */
3393 font_done_for_face (struct frame
*f
, struct face
*face
)
3395 if (face
->font
->driver
->done_face
)
3396 face
->font
->driver
->done_face (f
, face
);
3400 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3401 font is found, return Qnil. */
3404 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3406 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3408 /* We set up the default font-related attributes of a face to prefer
3410 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3411 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3412 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3414 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3416 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3418 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3420 return font_load_for_lface (f
, attrs
, spec
);
3424 /* Open a font that matches NAME on frame F. If no proper font is
3425 found, return Qnil. */
3428 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3430 Lisp_Object args
[2];
3431 Lisp_Object spec
, ret
;
3435 spec
= Ffont_spec (2, args
);
3436 ret
= font_open_by_spec (f
, spec
);
3437 /* Do not lose name originally put in. */
3439 font_put_extra (ret
, QCuser_spec
, args
[1]);
3445 /* Register font-driver DRIVER. This function is used in two ways.
3447 The first is with frame F non-NULL. In this case, make DRIVER
3448 available (but not yet activated) on F. All frame creators
3449 (e.g. Fx_create_frame) must call this function at least once with
3450 an available font-driver.
3452 The second is with frame F NULL. In this case, DRIVER is globally
3453 registered in the variable `font_driver_list'. All font-driver
3454 implementations must call this function in its syms_of_XXXX
3455 (e.g. syms_of_xfont). */
3458 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3460 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3461 struct font_driver_list
*prev
, *list
;
3463 #ifdef HAVE_WINDOW_SYSTEM
3464 if (f
&& ! driver
->draw
)
3465 error ("Unusable font driver for a frame: %s",
3466 SDATA (SYMBOL_NAME (driver
->type
)));
3467 #endif /* HAVE_WINDOW_SYSTEM */
3469 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3470 if (EQ (list
->driver
->type
, driver
->type
))
3471 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3473 list
= xmalloc (sizeof *list
);
3475 list
->driver
= driver
;
3480 f
->font_driver_list
= list
;
3482 font_driver_list
= list
;
3488 free_font_driver_list (struct frame
*f
)
3490 struct font_driver_list
*list
, *next
;
3492 for (list
= f
->font_driver_list
; list
; list
= next
)
3497 f
->font_driver_list
= NULL
;
3501 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3502 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3503 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3505 A caller must free all realized faces if any in advance. The
3506 return value is a list of font backends actually made used on
3510 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3512 Lisp_Object active_drivers
= Qnil
;
3513 struct font_driver_list
*list
;
3515 /* At first, turn off non-requested drivers, and turn on requested
3517 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3519 struct font_driver
*driver
= list
->driver
;
3520 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3525 if (driver
->end_for_frame
)
3526 driver
->end_for_frame (f
);
3527 font_finish_cache (f
, driver
);
3532 if (! driver
->start_for_frame
3533 || driver
->start_for_frame (f
) == 0)
3535 font_prepare_cache (f
, driver
);
3542 if (NILP (new_drivers
))
3545 if (! EQ (new_drivers
, Qt
))
3547 /* Re-order the driver list according to new_drivers. */
3548 struct font_driver_list
**list_table
, **next
;
3553 SAFE_NALLOCA (list_table
, 1, num_font_drivers
+ 1);
3554 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3556 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3557 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3560 list_table
[i
++] = list
;
3562 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3564 list_table
[i
++] = list
;
3565 list_table
[i
] = NULL
;
3567 next
= &f
->font_driver_list
;
3568 for (i
= 0; list_table
[i
]; i
++)
3570 *next
= list_table
[i
];
3571 next
= &(*next
)->next
;
3576 if (! f
->font_driver_list
->on
)
3577 { /* None of the drivers is enabled: enable them all.
3578 Happens if you set the list of drivers to (xft x) in your .emacs
3579 and then use it under w32 or ns. */
3580 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3582 struct font_driver
*driver
= list
->driver
;
3583 eassert (! list
->on
);
3584 if (! driver
->start_for_frame
3585 || driver
->start_for_frame (f
) == 0)
3587 font_prepare_cache (f
, driver
);
3594 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3596 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3597 return active_drivers
;
3600 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
3603 fset_font_data (struct frame
*f
, Lisp_Object val
)
3609 font_put_frame_data (struct frame
*f
, Lisp_Object driver
, void *data
)
3611 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3614 fset_font_data (f
, Fdelq (val
, f
->font_data
));
3618 fset_font_data (f
, Fcons (Fcons (driver
, make_save_ptr (data
)),
3621 XSETCDR (val
, make_save_ptr (data
));
3626 font_get_frame_data (struct frame
*f
, Lisp_Object driver
)
3628 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3630 return NILP (val
) ? NULL
: XSAVE_POINTER (XCDR (val
), 0);
3633 #endif /* HAVE_XFT || HAVE_FREETYPE */
3635 /* Sets attributes on a font. Any properties that appear in ALIST and
3636 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3637 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3638 arrays of strings. This function is intended for use by the font
3639 drivers to implement their specific font_filter_properties. */
3641 font_filter_properties (Lisp_Object font
,
3643 const char *const boolean_properties
[],
3644 const char *const non_boolean_properties
[])
3649 /* Set boolean values to Qt or Qnil. */
3650 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3651 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3653 Lisp_Object key
= XCAR (XCAR (it
));
3654 Lisp_Object val
= XCDR (XCAR (it
));
3655 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3657 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3659 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3660 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3663 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3664 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3665 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3666 || strcmp ("Off", str
) == 0)
3671 Ffont_put (font
, key
, val
);
3675 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3676 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3678 Lisp_Object key
= XCAR (XCAR (it
));
3679 Lisp_Object val
= XCDR (XCAR (it
));
3680 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3681 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3682 Ffont_put (font
, key
, val
);
3687 /* Return the font used to draw character C by FACE at buffer position
3688 POS in window W. If STRING is non-nil, it is a string containing C
3689 at index POS. If C is negative, get C from the current buffer or
3693 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3698 Lisp_Object font_object
;
3700 multibyte
= (NILP (string
)
3701 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3702 : STRING_MULTIBYTE (string
));
3709 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3711 c
= FETCH_CHAR (pos_byte
);
3714 c
= FETCH_BYTE (pos
);
3720 multibyte
= STRING_MULTIBYTE (string
);
3723 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3725 str
= SDATA (string
) + pos_byte
;
3726 c
= STRING_CHAR (str
);
3729 c
= SDATA (string
)[pos
];
3733 f
= XFRAME (w
->frame
);
3734 if (! FRAME_WINDOW_P (f
))
3741 if (STRINGP (string
))
3742 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3743 DEFAULT_FACE_ID
, 0);
3745 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3747 face
= FACE_FROM_ID (f
, face_id
);
3751 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3752 face
= FACE_FROM_ID (f
, face_id
);
3757 XSETFONT (font_object
, face
->font
);
3762 #ifdef HAVE_WINDOW_SYSTEM
3764 /* Check how many characters after character/byte position POS/POS_BYTE
3765 (at most to *LIMIT) can be displayed by the same font in the window W.
3766 FACE, if non-NULL, is the face selected for the character at POS.
3767 If STRING is not nil, it is the string to check instead of the current
3768 buffer. In that case, FACE must be not NULL.
3770 The return value is the font-object for the character at POS.
3771 *LIMIT is set to the position where that font can't be used.
3773 It is assured that the current buffer (or STRING) is multibyte. */
3776 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3777 struct window
*w
, struct face
*face
, Lisp_Object string
)
3781 Lisp_Object font_object
= Qnil
;
3789 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3791 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3797 while (pos
< *limit
)
3799 Lisp_Object category
;
3802 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3804 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3805 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3806 if (INTEGERP (category
)
3807 && (XINT (category
) == UNICODE_CATEGORY_Cf
3808 || CHAR_VARIATION_SELECTOR_P (c
)))
3810 if (NILP (font_object
))
3812 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3813 if (NILP (font_object
))
3817 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3827 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3828 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3829 Return nil otherwise.
3830 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3831 which kind of font it is. It must be one of `font-spec', `font-entity',
3833 (Lisp_Object object
, Lisp_Object extra_type
)
3835 if (NILP (extra_type
))
3836 return (FONTP (object
) ? Qt
: Qnil
);
3837 if (EQ (extra_type
, Qfont_spec
))
3838 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3839 if (EQ (extra_type
, Qfont_entity
))
3840 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3841 if (EQ (extra_type
, Qfont_object
))
3842 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3843 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3846 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3847 doc
: /* Return a newly created font-spec with arguments as properties.
3849 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3850 valid font property name listed below:
3852 `:family', `:weight', `:slant', `:width'
3854 They are the same as face attributes of the same name. See
3855 `set-face-attribute'.
3859 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3863 VALUE must be a string or a symbol specifying the additional
3864 typographic style information of a font, e.g. ``sans''.
3868 VALUE must be a string or a symbol specifying the charset registry and
3869 encoding of a font, e.g. ``iso8859-1''.
3873 VALUE must be a non-negative integer or a floating point number
3874 specifying the font size. It specifies the font size in pixels (if
3875 VALUE is an integer), or in points (if VALUE is a float).
3879 VALUE must be a string of XLFD-style or fontconfig-style font name.
3883 VALUE must be a symbol representing a script that the font must
3884 support. It may be a symbol representing a subgroup of a script
3885 listed in the variable `script-representative-chars'.
3889 VALUE must be a symbol of two-letter ISO-639 language names,
3894 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3895 required OpenType features.
3897 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3898 LANGSYS-TAG: OpenType language system tag symbol,
3899 or nil for the default language system.
3900 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3901 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3903 GSUB and GPOS may contain `nil' element. In such a case, the font
3904 must not have any of the remaining elements.
3906 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3907 be an OpenType font whose GPOS table of `thai' script's default
3908 language system must contain `mark' feature.
3910 usage: (font-spec ARGS...) */)
3911 (ptrdiff_t nargs
, Lisp_Object
*args
)
3913 Lisp_Object spec
= font_make_spec ();
3916 for (i
= 0; i
< nargs
; i
+= 2)
3918 Lisp_Object key
= args
[i
], val
;
3922 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3925 if (EQ (key
, QCname
))
3928 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3929 error ("Invalid font name: %s", SSDATA (val
));
3930 font_put_extra (spec
, key
, val
);
3934 int idx
= get_font_prop_index (key
);
3938 val
= font_prop_validate (idx
, Qnil
, val
);
3939 if (idx
< FONT_EXTRA_INDEX
)
3940 ASET (spec
, idx
, val
);
3942 font_put_extra (spec
, key
, val
);
3945 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3951 /* Return a copy of FONT as a font-spec. */
3953 copy_font_spec (Lisp_Object font
)
3955 Lisp_Object new_spec
, tail
, prev
, extra
;
3959 new_spec
= font_make_spec ();
3960 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3961 ASET (new_spec
, i
, AREF (font
, i
));
3962 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3963 /* We must remove :font-entity property. */
3964 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3965 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3968 extra
= XCDR (extra
);
3970 XSETCDR (prev
, XCDR (tail
));
3973 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3977 /* Merge font-specs FROM and TO, and return a new font-spec.
3978 Every specified property in FROM overrides the corresponding
3981 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3983 Lisp_Object extra
, tail
;
3988 to
= copy_font_spec (to
);
3989 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3990 ASET (to
, i
, AREF (from
, i
));
3991 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3992 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3993 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3995 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3998 XSETCDR (slot
, XCDR (XCAR (tail
)));
4000 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4002 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4006 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4007 doc
: /* Return the value of FONT's property KEY.
4008 FONT is a font-spec, a font-entity, or a font-object.
4009 KEY is any symbol, but these are reserved for specific meanings:
4010 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4011 :size, :name, :script, :otf
4012 See the documentation of `font-spec' for their meanings.
4013 In addition, if FONT is a font-entity or a font-object, values of
4014 :script and :otf are different from those of a font-spec as below:
4016 The value of :script may be a list of scripts that are supported by the font.
4018 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
4019 representing the OpenType features supported by the font by this form:
4020 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4021 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
4023 (Lisp_Object font
, Lisp_Object key
)
4031 idx
= get_font_prop_index (key
);
4032 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4033 return font_style_symbolic (font
, idx
, 0);
4034 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4035 return AREF (font
, idx
);
4036 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4037 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4039 struct font
*fontp
= XFONT_OBJECT (font
);
4041 if (fontp
->driver
->otf_capability
)
4042 val
= fontp
->driver
->otf_capability (fontp
);
4044 val
= Fcons (Qnil
, Qnil
);
4051 #ifdef HAVE_WINDOW_SYSTEM
4053 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4054 doc
: /* Return a plist of face attributes generated by FONT.
4055 FONT is a font name, a font-spec, a font-entity, or a font-object.
4056 The return value is a list of the form
4058 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4060 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4061 compatible with `set-face-attribute'. Some of these key-attribute pairs
4062 may be omitted from the list if they are not specified by FONT.
4064 The optional argument FRAME specifies the frame that the face attributes
4065 are to be displayed on. If omitted, the selected frame is used. */)
4066 (Lisp_Object font
, Lisp_Object frame
)
4068 struct frame
*f
= decode_live_frame (frame
);
4069 Lisp_Object plist
[10];
4075 int fontset
= fs_query_fontset (font
, 0);
4076 Lisp_Object name
= font
;
4078 font
= fontset_ascii (fontset
);
4079 font
= font_spec_from_name (name
);
4081 signal_error ("Invalid font name", name
);
4083 else if (! FONTP (font
))
4084 signal_error ("Invalid font object", font
);
4086 val
= AREF (font
, FONT_FAMILY_INDEX
);
4089 plist
[n
++] = QCfamily
;
4090 plist
[n
++] = SYMBOL_NAME (val
);
4093 val
= AREF (font
, FONT_SIZE_INDEX
);
4096 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4097 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4098 plist
[n
++] = QCheight
;
4099 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4101 else if (FLOATP (val
))
4103 plist
[n
++] = QCheight
;
4104 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4107 val
= FONT_WEIGHT_FOR_FACE (font
);
4110 plist
[n
++] = QCweight
;
4114 val
= FONT_SLANT_FOR_FACE (font
);
4117 plist
[n
++] = QCslant
;
4121 val
= FONT_WIDTH_FOR_FACE (font
);
4124 plist
[n
++] = QCwidth
;
4128 return Flist (n
, plist
);
4133 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4134 doc
: /* Set one property of FONT: give property KEY value VAL.
4135 FONT is a font-spec, a font-entity, or a font-object.
4137 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4138 accepted by the function `font-spec' (which see), VAL must be what
4139 allowed in `font-spec'.
4141 If FONT is a font-entity or a font-object, KEY must not be the one
4142 accepted by `font-spec'. */)
4143 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4147 idx
= get_font_prop_index (prop
);
4148 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4150 CHECK_FONT_SPEC (font
);
4151 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4155 if (EQ (prop
, QCname
)
4156 || EQ (prop
, QCscript
)
4157 || EQ (prop
, QClang
)
4158 || EQ (prop
, QCotf
))
4159 CHECK_FONT_SPEC (font
);
4162 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4167 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4168 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4169 Optional 2nd argument FRAME specifies the target frame.
4170 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4171 Optional 4th argument PREFER, if non-nil, is a font-spec to
4172 control the order of the returned list. Fonts are sorted by
4173 how close they are to PREFER. */)
4174 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4176 struct frame
*f
= decode_live_frame (frame
);
4177 Lisp_Object vec
, list
;
4180 CHECK_FONT_SPEC (font_spec
);
4188 if (! NILP (prefer
))
4189 CHECK_FONT_SPEC (prefer
);
4191 list
= font_list_entities (f
, font_spec
);
4194 if (NILP (XCDR (list
))
4195 && ASIZE (XCAR (list
)) == 1)
4196 return list1 (AREF (XCAR (list
), 0));
4198 if (! NILP (prefer
))
4199 vec
= font_sort_entities (list
, prefer
, f
, 0);
4201 vec
= font_vconcat_entity_vectors (list
);
4202 if (n
== 0 || n
>= ASIZE (vec
))
4204 Lisp_Object args
[2];
4208 list
= Fappend (2, args
);
4212 for (list
= Qnil
, n
--; n
>= 0; n
--)
4213 list
= Fcons (AREF (vec
, n
), list
);
4218 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4219 doc
: /* List available font families on the current frame.
4220 If FRAME is omitted or nil, the selected frame is used. */)
4223 struct frame
*f
= decode_live_frame (frame
);
4224 struct font_driver_list
*driver_list
;
4225 Lisp_Object list
= Qnil
;
4227 for (driver_list
= f
->font_driver_list
; driver_list
;
4228 driver_list
= driver_list
->next
)
4229 if (driver_list
->driver
->list_family
)
4231 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4232 Lisp_Object tail
= list
;
4234 for (; CONSP (val
); val
= XCDR (val
))
4235 if (NILP (Fmemq (XCAR (val
), tail
))
4236 && SYMBOLP (XCAR (val
)))
4237 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4242 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4243 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4244 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4245 (Lisp_Object font_spec
, Lisp_Object frame
)
4247 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4254 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4255 doc
: /* Return XLFD name of FONT.
4256 FONT is a font-spec, font-entity, or font-object.
4257 If the name is too long for XLFD (maximum 255 chars), return nil.
4258 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4259 the consecutive wildcards are folded into one. */)
4260 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4263 int namelen
, pixel_size
= 0;
4267 if (FONT_OBJECT_P (font
))
4269 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4271 if (STRINGP (font_name
)
4272 && SDATA (font_name
)[0] == '-')
4274 if (NILP (fold_wildcards
))
4276 lispstpcpy (name
, font_name
);
4277 namelen
= SBYTES (font_name
);
4280 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4282 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4286 if (! NILP (fold_wildcards
))
4288 char *p0
= name
, *p1
;
4290 while ((p1
= strstr (p0
, "-*-*")))
4292 strcpy (p1
, p1
+ 2);
4298 return make_string (name
, namelen
);
4302 clear_font_cache (struct frame
*f
)
4304 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4306 for (; driver_list
; driver_list
= driver_list
->next
)
4307 if (driver_list
->on
)
4309 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4313 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4315 eassert (! NILP (val
));
4316 tmp
= XCDR (XCAR (val
));
4317 if (XINT (XCAR (tmp
)) == 0)
4319 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4320 XSETCDR (cache
, XCDR (val
));
4325 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4326 doc
: /* Clear font cache of each frame. */)
4329 Lisp_Object list
, frame
;
4331 FOR_EACH_FRAME (list
, frame
)
4332 clear_font_cache (XFRAME (frame
));
4339 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4341 struct font
*font
= XFONT_OBJECT (font_object
);
4342 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4343 struct font_metrics metrics
;
4345 LGLYPH_SET_CODE (glyph
, code
);
4346 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4347 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4348 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4349 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4350 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4351 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4355 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4356 doc
: /* Shape the glyph-string GSTRING.
4357 Shaping means substituting glyphs and/or adjusting positions of glyphs
4358 to get the correct visual image of character sequences set in the
4359 header of the glyph-string.
4361 If the shaping was successful, the value is GSTRING itself or a newly
4362 created glyph-string. Otherwise, the value is nil.
4364 See the documentation of `composition-get-gstring' for the format of
4366 (Lisp_Object gstring
)
4369 Lisp_Object font_object
, n
, glyph
;
4370 ptrdiff_t i
, from
, to
;
4372 if (! composition_gstring_p (gstring
))
4373 signal_error ("Invalid glyph-string: ", gstring
);
4374 if (! NILP (LGSTRING_ID (gstring
)))
4376 font_object
= LGSTRING_FONT (gstring
);
4377 CHECK_FONT_OBJECT (font_object
);
4378 font
= XFONT_OBJECT (font_object
);
4379 if (! font
->driver
->shape
)
4382 /* Try at most three times with larger gstring each time. */
4383 for (i
= 0; i
< 3; i
++)
4385 n
= font
->driver
->shape (gstring
);
4388 gstring
= larger_vector (gstring
,
4389 LGSTRING_GLYPH_LEN (gstring
), -1);
4391 if (i
== 3 || XINT (n
) == 0)
4393 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4394 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4396 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4397 GLYPHS covers all characters (except for the last few ones) in
4398 GSTRING. More formally, provided that NCHARS is the number of
4399 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4400 and TO_IDX of each glyph must satisfy these conditions:
4402 GLYPHS[0].FROM_IDX == 0
4403 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4404 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4405 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4406 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4408 ;; Be sure to cover all characters.
4409 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4410 glyph
= LGSTRING_GLYPH (gstring
, 0);
4411 from
= LGLYPH_FROM (glyph
);
4412 to
= LGLYPH_TO (glyph
);
4413 if (from
!= 0 || to
< from
)
4415 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4417 glyph
= LGSTRING_GLYPH (gstring
, i
);
4420 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4421 && (LGLYPH_FROM (glyph
) == from
4422 ? LGLYPH_TO (glyph
) == to
4423 : LGLYPH_FROM (glyph
) == to
+ 1)))
4425 from
= LGLYPH_FROM (glyph
);
4426 to
= LGLYPH_TO (glyph
);
4428 return composition_gstring_put_cache (gstring
, XINT (n
));
4434 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4436 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4437 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4439 VARIATION-SELECTOR is a character code of variation selection
4440 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4441 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4442 (Lisp_Object font_object
, Lisp_Object character
)
4444 unsigned variations
[256];
4449 CHECK_FONT_OBJECT (font_object
);
4450 CHECK_CHARACTER (character
);
4451 font
= XFONT_OBJECT (font_object
);
4452 if (! font
->driver
->get_variation_glyphs
)
4454 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4458 for (i
= 0; i
< 255; i
++)
4461 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4462 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4463 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4470 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4471 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4472 OTF-FEATURES specifies which features to apply in this format:
4473 (SCRIPT LANGSYS GSUB GPOS)
4475 SCRIPT is a symbol specifying a script tag of OpenType,
4476 LANGSYS is a symbol specifying a langsys tag of OpenType,
4477 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4479 If LANGSYS is nil, the default langsys is selected.
4481 The features are applied in the order they appear in the list. The
4482 symbol `*' means to apply all available features not present in this
4483 list, and the remaining features are ignored. For instance, (vatu
4484 pstf * haln) is to apply vatu and pstf in this order, then to apply
4485 all available features other than vatu, pstf, and haln.
4487 The features are applied to the glyphs in the range FROM and TO of
4488 the glyph-string GSTRING-IN.
4490 If some feature is actually applicable, the resulting glyphs are
4491 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4492 this case, the value is the number of produced glyphs.
4494 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4497 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4498 produced in GSTRING-OUT, and the value is nil.
4500 See the documentation of `composition-get-gstring' for the format of
4502 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4504 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4509 check_otf_features (otf_features
);
4510 CHECK_FONT_OBJECT (font_object
);
4511 font
= XFONT_OBJECT (font_object
);
4512 if (! font
->driver
->otf_drive
)
4513 error ("Font backend %s can't drive OpenType GSUB table",
4514 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4515 CHECK_CONS (otf_features
);
4516 CHECK_SYMBOL (XCAR (otf_features
));
4517 val
= XCDR (otf_features
);
4518 CHECK_SYMBOL (XCAR (val
));
4519 val
= XCDR (otf_features
);
4522 len
= check_gstring (gstring_in
);
4523 CHECK_VECTOR (gstring_out
);
4524 CHECK_NATNUM (from
);
4526 CHECK_NATNUM (index
);
4528 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4529 args_out_of_range_3 (from
, to
, make_number (len
));
4530 if (XINT (index
) >= ASIZE (gstring_out
))
4531 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4532 num
= font
->driver
->otf_drive (font
, otf_features
,
4533 gstring_in
, XINT (from
), XINT (to
),
4534 gstring_out
, XINT (index
), 0);
4537 return make_number (num
);
4540 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4542 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4543 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4545 (SCRIPT LANGSYS FEATURE ...)
4546 See the documentation of `font-drive-otf' for more detail.
4548 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4549 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4550 character code corresponding to the glyph or nil if there's no
4551 corresponding character. */)
4552 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4555 Lisp_Object gstring_in
, gstring_out
, g
;
4556 Lisp_Object alternates
;
4559 CHECK_FONT_GET_OBJECT (font_object
, font
);
4560 if (! font
->driver
->otf_drive
)
4561 error ("Font backend %s can't drive OpenType GSUB table",
4562 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4563 CHECK_CHARACTER (character
);
4564 CHECK_CONS (otf_features
);
4566 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4567 g
= LGSTRING_GLYPH (gstring_in
, 0);
4568 LGLYPH_SET_CHAR (g
, XINT (character
));
4569 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4570 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4571 gstring_out
, 0, 1)) < 0)
4572 gstring_out
= Ffont_make_gstring (font_object
,
4573 make_number (ASIZE (gstring_out
) * 2));
4575 for (i
= 0; i
< num
; i
++)
4577 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4578 int c
= LGLYPH_CHAR (g
);
4579 unsigned code
= LGLYPH_CODE (g
);
4581 alternates
= Fcons (Fcons (make_number (code
),
4582 c
> 0 ? make_number (c
) : Qnil
),
4585 return Fnreverse (alternates
);
4591 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4592 doc
: /* Open FONT-ENTITY. */)
4593 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4596 struct frame
*f
= decode_live_frame (frame
);
4598 CHECK_FONT_ENTITY (font_entity
);
4601 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4604 CHECK_NUMBER_OR_FLOAT (size
);
4606 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4608 isize
= XINT (size
);
4609 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4610 args_out_of_range (font_entity
, size
);
4614 return font_open_entity (f
, font_entity
, isize
);
4617 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4618 doc
: /* Close FONT-OBJECT. */)
4619 (Lisp_Object font_object
, Lisp_Object frame
)
4621 CHECK_FONT_OBJECT (font_object
);
4622 font_close_object (decode_live_frame (frame
), font_object
);
4626 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4627 doc
: /* Return information about FONT-OBJECT.
4628 The value is a vector:
4629 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4632 NAME is the font name, a string (or nil if the font backend doesn't
4635 FILENAME is the font file name, a string (or nil if the font backend
4636 doesn't provide a file name).
4638 PIXEL-SIZE is a pixel size by which the font is opened.
4640 SIZE is a maximum advance width of the font in pixels.
4642 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4645 CAPABILITY is a list whose first element is a symbol representing the
4646 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4647 remaining elements describe the details of the font capability.
4649 If the font is OpenType font, the form of the list is
4650 \(opentype GSUB GPOS)
4651 where GSUB shows which "GSUB" features the font supports, and GPOS
4652 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4653 lists of the format:
4654 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4656 If the font is not OpenType font, currently the length of the form is
4659 SCRIPT is a symbol representing OpenType script tag.
4661 LANGSYS is a symbol representing OpenType langsys tag, or nil
4662 representing the default langsys.
4664 FEATURE is a symbol representing OpenType feature tag.
4666 If the font is not OpenType font, CAPABILITY is nil. */)
4667 (Lisp_Object font_object
)
4672 CHECK_FONT_GET_OBJECT (font_object
, font
);
4674 val
= make_uninit_vector (9);
4675 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4676 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4677 ASET (val
, 2, make_number (font
->pixel_size
));
4678 ASET (val
, 3, make_number (font
->max_width
));
4679 ASET (val
, 4, make_number (font
->ascent
));
4680 ASET (val
, 5, make_number (font
->descent
));
4681 ASET (val
, 6, make_number (font
->space_width
));
4682 ASET (val
, 7, make_number (font
->average_width
));
4683 if (font
->driver
->otf_capability
)
4684 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4686 ASET (val
, 8, Qnil
);
4690 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4692 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4693 FROM and TO are positions (integers or markers) specifying a region
4694 of the current buffer.
4695 If the optional fourth arg OBJECT is not nil, it is a string or a
4696 vector containing the target characters.
4698 Each element is a vector containing information of a glyph in this format:
4699 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4701 FROM is an index numbers of a character the glyph corresponds to.
4702 TO is the same as FROM.
4703 C is the character of the glyph.
4704 CODE is the glyph-code of C in FONT-OBJECT.
4705 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4706 ADJUSTMENT is always nil.
4707 If FONT-OBJECT doesn't have a glyph for a character,
4708 the corresponding element is nil. */)
4709 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4714 Lisp_Object
*chars
, vec
;
4717 CHECK_FONT_GET_OBJECT (font_object
, font
);
4720 ptrdiff_t charpos
, bytepos
;
4722 validate_region (&from
, &to
);
4725 len
= XFASTINT (to
) - XFASTINT (from
);
4726 SAFE_ALLOCA_LISP (chars
, len
);
4727 charpos
= XFASTINT (from
);
4728 bytepos
= CHAR_TO_BYTE (charpos
);
4729 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4732 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4733 chars
[i
] = make_number (c
);
4736 else if (STRINGP (object
))
4738 const unsigned char *p
;
4740 CHECK_NUMBER (from
);
4742 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4743 || XINT (to
) > SCHARS (object
))
4744 args_out_of_range_3 (object
, from
, to
);
4747 len
= XFASTINT (to
) - XFASTINT (from
);
4748 SAFE_ALLOCA_LISP (chars
, len
);
4750 if (STRING_MULTIBYTE (object
))
4751 for (i
= 0; i
< len
; i
++)
4753 int c
= STRING_CHAR_ADVANCE (p
);
4754 chars
[i
] = make_number (c
);
4757 for (i
= 0; i
< len
; i
++)
4758 chars
[i
] = make_number (p
[i
]);
4762 CHECK_VECTOR (object
);
4763 CHECK_NUMBER (from
);
4765 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4766 || XINT (to
) > ASIZE (object
))
4767 args_out_of_range_3 (object
, from
, to
);
4770 len
= XFASTINT (to
) - XFASTINT (from
);
4771 for (i
= 0; i
< len
; i
++)
4773 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4774 CHECK_CHARACTER (elt
);
4776 chars
= aref_addr (object
, XFASTINT (from
));
4779 vec
= make_uninit_vector (len
);
4780 for (i
= 0; i
< len
; i
++)
4783 int c
= XFASTINT (chars
[i
]);
4785 struct font_metrics metrics
;
4787 code
= font
->driver
->encode_char (font
, c
);
4788 if (code
== FONT_INVALID_CODE
)
4790 ASET (vec
, i
, Qnil
);
4794 LGLYPH_SET_FROM (g
, i
);
4795 LGLYPH_SET_TO (g
, i
);
4796 LGLYPH_SET_CHAR (g
, c
);
4797 LGLYPH_SET_CODE (g
, code
);
4798 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4799 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4800 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4801 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4802 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4803 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4806 if (! VECTORP (object
))
4811 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4812 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4813 FONT is a font-spec, font-entity, or font-object. */)
4814 (Lisp_Object spec
, Lisp_Object font
)
4816 CHECK_FONT_SPEC (spec
);
4819 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4822 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4823 doc
: /* Return a font-object for displaying a character at POSITION.
4824 Optional second arg WINDOW, if non-nil, is a window displaying
4825 the current buffer. It defaults to the currently selected window.
4826 Optional third arg STRING, if non-nil, is a string containing the target
4827 character at index specified by POSITION. */)
4828 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4830 struct window
*w
= decode_live_window (window
);
4834 if (XBUFFER (w
->contents
) != current_buffer
)
4835 error ("Specified window is not displaying the current buffer");
4836 CHECK_NUMBER_COERCE_MARKER (position
);
4837 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4838 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4842 CHECK_NUMBER (position
);
4843 CHECK_STRING (string
);
4844 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4845 args_out_of_range (string
, position
);
4848 return font_at (-1, XINT (position
), NULL
, w
, string
);
4852 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4853 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4854 The value is a number of glyphs drawn.
4855 Type C-l to recover what previously shown. */)
4856 (Lisp_Object font_object
, Lisp_Object string
)
4858 Lisp_Object frame
= selected_frame
;
4859 struct frame
*f
= XFRAME (frame
);
4865 CHECK_FONT_GET_OBJECT (font_object
, font
);
4866 CHECK_STRING (string
);
4867 len
= SCHARS (string
);
4868 code
= alloca (sizeof (unsigned) * len
);
4869 for (i
= 0; i
< len
; i
++)
4871 Lisp_Object ch
= Faref (string
, make_number (i
));
4875 code
[i
] = font
->driver
->encode_char (font
, c
);
4876 if (code
[i
] == FONT_INVALID_CODE
)
4879 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4881 if (font
->driver
->prepare_face
)
4882 font
->driver
->prepare_face (f
, face
);
4883 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4884 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4885 if (font
->driver
->done_face
)
4886 font
->driver
->done_face (f
, face
);
4888 return make_number (len
);
4892 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4893 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4894 If FRAME is omitted or nil, use the selected frame. */)
4897 #ifdef HAVE_WINDOW_SYSTEM
4898 struct frame
*f
= decode_live_frame (frame
);
4900 if (FRAME_WINDOW_P (f
))
4901 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4907 #endif /* FONT_DEBUG */
4909 #ifdef HAVE_WINDOW_SYSTEM
4911 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4912 doc
: /* Return information about a font named NAME on frame FRAME.
4913 If FRAME is omitted or nil, use the selected frame.
4914 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4915 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4917 OPENED-NAME is the name used for opening the font,
4918 FULL-NAME is the full name of the font,
4919 SIZE is the pixelsize of the font,
4920 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4921 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4922 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4923 how to compose characters.
4924 If the named font is not yet loaded, return nil. */)
4925 (Lisp_Object name
, Lisp_Object frame
)
4930 Lisp_Object font_object
;
4933 CHECK_STRING (name
);
4934 f
= decode_window_system_frame (frame
);
4938 int fontset
= fs_query_fontset (name
, 0);
4941 name
= fontset_ascii (fontset
);
4942 font_object
= font_open_by_name (f
, name
);
4944 else if (FONT_OBJECT_P (name
))
4946 else if (FONT_ENTITY_P (name
))
4947 font_object
= font_open_entity (f
, name
, 0);
4950 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4951 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4953 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4955 if (NILP (font_object
))
4957 font
= XFONT_OBJECT (font_object
);
4959 info
= make_uninit_vector (7);
4960 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4961 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4962 ASET (info
, 2, make_number (font
->pixel_size
));
4963 ASET (info
, 3, make_number (font
->height
));
4964 ASET (info
, 4, make_number (font
->baseline_offset
));
4965 ASET (info
, 5, make_number (font
->relative_compose
));
4966 ASET (info
, 6, make_number (font
->default_ascent
));
4969 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4970 close it now. Perhaps, we should manage font-objects
4971 by `reference-count'. */
4972 font_close_object (f
, font_object
);
4979 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
4982 build_style_table (const struct table_entry
*entry
, int nelement
)
4985 Lisp_Object table
, elt
;
4987 table
= make_uninit_vector (nelement
);
4988 for (i
= 0; i
< nelement
; i
++)
4990 for (j
= 0; entry
[i
].names
[j
]; j
++);
4991 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4992 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4993 for (j
= 0; entry
[i
].names
[j
]; j
++)
4994 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4995 ASET (table
, i
, elt
);
5000 /* The deferred font-log data of the form [ACTION ARG RESULT].
5001 If ACTION is not nil, that is added to the log when font_add_log is
5002 called next time. At that time, ACTION is set back to nil. */
5003 static Lisp_Object Vfont_log_deferred
;
5005 /* Prepend the font-related logging data in Vfont_log if it is not
5006 `t'. ACTION describes a kind of font-related action (e.g. listing,
5007 opening), ARG is the argument for the action, and RESULT is the
5008 result of the action. */
5010 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5015 if (EQ (Vfont_log
, Qt
))
5017 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5019 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
5021 ASET (Vfont_log_deferred
, 0, Qnil
);
5022 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5023 AREF (Vfont_log_deferred
, 2));
5028 Lisp_Object tail
, elt
;
5029 AUTO_STRING (equalstr
, "=");
5031 val
= Ffont_xlfd_name (arg
, Qt
);
5032 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5036 if (EQ (XCAR (elt
), QCscript
)
5037 && SYMBOLP (XCDR (elt
)))
5038 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5039 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5040 else if (EQ (XCAR (elt
), QClang
)
5041 && SYMBOLP (XCDR (elt
)))
5042 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5043 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5044 else if (EQ (XCAR (elt
), QCotf
)
5045 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5046 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5048 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5054 && VECTORP (XCAR (result
))
5055 && ASIZE (XCAR (result
)) > 0
5056 && FONTP (AREF (XCAR (result
), 0)))
5057 result
= font_vconcat_entity_vectors (result
);
5060 val
= Ffont_xlfd_name (result
, Qt
);
5061 if (! FONT_SPEC_P (result
))
5063 AUTO_STRING (colon
, ":");
5064 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5069 else if (CONSP (result
))
5072 result
= Fcopy_sequence (result
);
5073 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5077 val
= Ffont_xlfd_name (val
, Qt
);
5078 XSETCAR (tail
, val
);
5081 else if (VECTORP (result
))
5083 result
= Fcopy_sequence (result
);
5084 for (i
= 0; i
< ASIZE (result
); i
++)
5086 val
= AREF (result
, i
);
5088 val
= Ffont_xlfd_name (val
, Qt
);
5089 ASET (result
, i
, val
);
5092 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5095 /* Record a font-related logging data to be added to Vfont_log when
5096 font_add_log is called next time. ACTION, ARG, RESULT are the same
5100 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5102 if (EQ (Vfont_log
, Qt
))
5104 ASET (Vfont_log_deferred
, 0, build_string (action
));
5105 ASET (Vfont_log_deferred
, 1, arg
);
5106 ASET (Vfont_log_deferred
, 2, result
);
5112 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5113 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5114 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5115 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5116 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5117 /* Note that the other elements in sort_shift_bits are not used. */
5119 staticpro (&font_charset_alist
);
5120 font_charset_alist
= Qnil
;
5122 DEFSYM (Qopentype
, "opentype");
5124 DEFSYM (Qascii_0
, "ascii-0");
5125 DEFSYM (Qiso8859_1
, "iso8859-1");
5126 DEFSYM (Qiso10646_1
, "iso10646-1");
5127 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5128 DEFSYM (Qunicode_sip
, "unicode-sip");
5132 DEFSYM (QCotf
, ":otf");
5133 DEFSYM (QClang
, ":lang");
5134 DEFSYM (QCscript
, ":script");
5135 DEFSYM (QCantialias
, ":antialias");
5137 DEFSYM (QCfoundry
, ":foundry");
5138 DEFSYM (QCadstyle
, ":adstyle");
5139 DEFSYM (QCregistry
, ":registry");
5140 DEFSYM (QCspacing
, ":spacing");
5141 DEFSYM (QCdpi
, ":dpi");
5142 DEFSYM (QCscalable
, ":scalable");
5143 DEFSYM (QCavgwidth
, ":avgwidth");
5144 DEFSYM (QCfont_entity
, ":font-entity");
5145 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5155 DEFSYM (QCuser_spec
, "user-spec");
5157 staticpro (&scratch_font_spec
);
5158 scratch_font_spec
= Ffont_spec (0, NULL
);
5159 staticpro (&scratch_font_prefer
);
5160 scratch_font_prefer
= Ffont_spec (0, NULL
);
5162 staticpro (&Vfont_log_deferred
);
5163 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5167 staticpro (&otf_list
);
5169 #endif /* HAVE_LIBOTF */
5173 defsubr (&Sfont_spec
);
5174 defsubr (&Sfont_get
);
5175 #ifdef HAVE_WINDOW_SYSTEM
5176 defsubr (&Sfont_face_attributes
);
5178 defsubr (&Sfont_put
);
5179 defsubr (&Slist_fonts
);
5180 defsubr (&Sfont_family_list
);
5181 defsubr (&Sfind_font
);
5182 defsubr (&Sfont_xlfd_name
);
5183 defsubr (&Sclear_font_cache
);
5184 defsubr (&Sfont_shape_gstring
);
5185 defsubr (&Sfont_variation_glyphs
);
5187 defsubr (&Sfont_drive_otf
);
5188 defsubr (&Sfont_otf_alternates
);
5192 defsubr (&Sopen_font
);
5193 defsubr (&Sclose_font
);
5194 defsubr (&Squery_font
);
5195 defsubr (&Sfont_get_glyphs
);
5196 defsubr (&Sfont_match_p
);
5197 defsubr (&Sfont_at
);
5199 defsubr (&Sdraw_string
);
5201 defsubr (&Sframe_font_cache
);
5202 #endif /* FONT_DEBUG */
5203 #ifdef HAVE_WINDOW_SYSTEM
5204 defsubr (&Sfont_info
);
5207 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5209 Alist of fontname patterns vs the corresponding encoding and repertory info.
5210 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5211 where ENCODING is a charset or a char-table,
5212 and REPERTORY is a charset, a char-table, or nil.
5214 If ENCODING and REPERTORY are the same, the element can have the form
5215 \(REGEXP . ENCODING).
5217 ENCODING is for converting a character to a glyph code of the font.
5218 If ENCODING is a charset, encoding a character by the charset gives
5219 the corresponding glyph code. If ENCODING is a char-table, looking up
5220 the table by a character gives the corresponding glyph code.
5222 REPERTORY specifies a repertory of characters supported by the font.
5223 If REPERTORY is a charset, all characters belonging to the charset are
5224 supported. If REPERTORY is a char-table, all characters who have a
5225 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5226 gets the repertory information by an opened font and ENCODING. */);
5227 Vfont_encoding_alist
= Qnil
;
5229 /* FIXME: These 3 vars are not quite what they appear: setq on them
5230 won't have any effect other than disconnect them from the style
5231 table used by the font display code. So we make them read-only,
5232 to avoid this confusing situation. */
5234 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5235 doc
: /* Vector of valid font weight values.
5236 Each element has the form:
5237 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5238 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5239 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5240 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5242 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5243 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5244 See `font-weight-table' for the format of the vector. */);
5245 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5246 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5248 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5249 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5250 See `font-weight-table' for the format of the vector. */);
5251 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5252 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5254 staticpro (&font_style_table
);
5255 font_style_table
= make_uninit_vector (3);
5256 ASET (font_style_table
, 0, Vfont_weight_table
);
5257 ASET (font_style_table
, 1, Vfont_slant_table
);
5258 ASET (font_style_table
, 2, Vfont_width_table
);
5260 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5261 *Logging list of font related actions and results.
5262 The value t means to suppress the logging.
5263 The initial value is set to nil if the environment variable
5264 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5267 #ifdef HAVE_WINDOW_SYSTEM
5268 #ifdef HAVE_FREETYPE
5270 #ifdef HAVE_X_WINDOWS
5275 #endif /* HAVE_XFT */
5276 #endif /* HAVE_X_WINDOWS */
5277 #else /* not HAVE_FREETYPE */
5278 #ifdef HAVE_X_WINDOWS
5280 #endif /* HAVE_X_WINDOWS */
5281 #endif /* not HAVE_FREETYPE */
5284 #endif /* HAVE_BDFFONT */
5287 #endif /* HAVE_NTGUI */
5288 #endif /* HAVE_WINDOW_SYSTEM */
5294 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;