1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2012 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/>. */
31 #include "character.h"
35 #include "dispextern.h"
37 #include "composite.h"
41 #ifdef HAVE_WINDOW_SYSTEM
43 #endif /* HAVE_WINDOW_SYSTEM */
45 Lisp_Object Qopentype
;
47 /* Important character set strings. */
48 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
50 #define DEFAULT_ENCODING Qiso8859_1
52 /* Unicode category `Cf'. */
53 static Lisp_Object QCf
;
55 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
56 static Lisp_Object font_style_table
;
58 /* Structure used for tables mapping weight, slant, and width numeric
59 values and their names. */
64 /* The first one is a valid name as a face attribute.
65 The second one (if any) is a typical name in XLFD field. */
69 /* Table of weight numeric values and their names. This table must be
70 sorted by numeric values in ascending order. */
72 static const struct table_entry weight_table
[] =
75 { 20, { "ultra-light", "ultralight" }},
76 { 40, { "extra-light", "extralight" }},
78 { 75, { "semi-light", "semilight", "demilight", "book" }},
79 { 100, { "normal", "medium", "regular", "unspecified" }},
80 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
82 { 205, { "extra-bold", "extrabold" }},
83 { 210, { "ultra-bold", "ultrabold", "black" }}
86 /* Table of slant numeric values and their names. This table must be
87 sorted by numeric values in ascending order. */
89 static const struct table_entry slant_table
[] =
91 { 0, { "reverse-oblique", "ro" }},
92 { 10, { "reverse-italic", "ri" }},
93 { 100, { "normal", "r", "unspecified" }},
94 { 200, { "italic" ,"i", "ot" }},
95 { 210, { "oblique", "o" }}
98 /* Table of width numeric values and their names. This table must be
99 sorted by numeric values in ascending order. */
101 static const struct table_entry width_table
[] =
103 { 50, { "ultra-condensed", "ultracondensed" }},
104 { 63, { "extra-condensed", "extracondensed" }},
105 { 75, { "condensed", "compressed", "narrow" }},
106 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
107 { 100, { "normal", "medium", "regular", "unspecified" }},
108 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
109 { 125, { "expanded" }},
110 { 150, { "extra-expanded", "extraexpanded" }},
111 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
114 Lisp_Object QCfoundry
;
115 static Lisp_Object QCadstyle
, QCregistry
;
116 /* Symbols representing keys of font extra info. */
117 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
118 Lisp_Object QCantialias
, QCfont_entity
;
119 static Lisp_Object QCfc_unknown_spec
;
120 /* Symbols representing values of font spacing property. */
121 static Lisp_Object Qc
, Qm
, Qd
;
123 /* Special ADSTYLE properties to avoid fonts used for Latin
124 characters; used in xfont.c and ftfont.c. */
125 Lisp_Object Qja
, Qko
;
127 static Lisp_Object QCuser_spec
;
129 /* Alist of font registry symbols and the corresponding charset
130 information. The information is retrieved from
131 Vfont_encoding_alist on demand.
133 Eash element has the form:
134 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
138 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
139 encodes a character code to a glyph code of a font, and
140 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
141 character is supported by a font.
143 The latter form means that the information for REGISTRY couldn't be
145 static Lisp_Object font_charset_alist
;
147 /* List of all font drivers. Each font-backend (XXXfont.c) calls
148 register_font_driver in syms_of_XXXfont to register its font-driver
150 static struct font_driver_list
*font_driver_list
;
154 /* Creators of font-related Lisp object. */
157 font_make_spec (void)
159 Lisp_Object font_spec
;
160 struct font_spec
*spec
161 = ((struct font_spec
*)
162 allocate_pseudovector (VECSIZE (struct font_spec
),
163 FONT_SPEC_MAX
, PVEC_FONT
));
164 XSETFONT (font_spec
, spec
);
169 font_make_entity (void)
171 Lisp_Object font_entity
;
172 struct font_entity
*entity
173 = ((struct font_entity
*)
174 allocate_pseudovector (VECSIZE (struct font_entity
),
175 FONT_ENTITY_MAX
, PVEC_FONT
));
176 XSETFONT (font_entity
, entity
);
180 /* Create a font-object whose structure size is SIZE. If ENTITY is
181 not nil, copy properties from ENTITY to the font-object. If
182 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
184 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
186 Lisp_Object font_object
;
188 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
191 XSETFONT (font_object
, font
);
195 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
196 font
->props
[i
] = AREF (entity
, i
);
197 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
198 font
->props
[FONT_EXTRA_INDEX
]
199 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
202 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
208 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
209 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
210 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
212 static unsigned font_encode_char (Lisp_Object
, int);
214 /* Number of registered font drivers. */
215 static int num_font_drivers
;
218 /* Return a Lispy value of a font property value at STR and LEN bytes.
219 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
220 consist entirely of one or more digits, return a symbol interned
221 from STR. Otherwise, return an integer. */
224 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
229 ptrdiff_t nbytes
, nchars
;
231 if (len
== 1 && *str
== '*')
233 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
235 for (i
= 1; i
< len
; i
++)
236 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
243 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
246 return make_number (n
);
247 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
251 xsignal1 (Qoverflow_error
, make_string (str
, len
));
255 /* This code is similar to intern function from lread.c. */
256 obarray
= check_obarray (Vobarray
);
257 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
258 tem
= oblookup (obarray
, str
,
259 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
263 if (len
== nchars
|| len
!= nbytes
)
264 tem
= make_unibyte_string (str
, len
);
266 tem
= make_multibyte_string (str
, nchars
, len
);
267 return Fintern (tem
, obarray
);
270 /* Return a pixel size of font-spec SPEC on frame F. */
273 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
275 #ifdef HAVE_WINDOW_SYSTEM
276 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
285 eassert (FLOATP (size
));
286 point_size
= XFLOAT_DATA (size
);
287 val
= AREF (spec
, FONT_DPI_INDEX
);
292 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
300 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
301 font vector. If VAL is not valid (i.e. not registered in
302 font_style_table), return -1 if NOERROR is zero, and return a
303 proper index if NOERROR is nonzero. In that case, register VAL in
304 font_style_table if VAL is a symbol, and return the closest index if
305 VAL is an integer. */
308 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
311 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
314 CHECK_VECTOR (table
);
321 Lisp_Object args
[2], elt
;
323 /* At first try exact match. */
324 for (i
= 0; i
< len
; i
++)
326 CHECK_VECTOR (AREF (table
, i
));
327 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
328 if (EQ (val
, AREF (AREF (table
, i
), j
)))
330 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
331 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
332 | (i
<< 4) | (j
- 1));
335 /* Try also with case-folding match. */
336 s
= SSDATA (SYMBOL_NAME (val
));
337 for (i
= 0; i
< len
; i
++)
338 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
340 elt
= AREF (AREF (table
, i
), j
);
341 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
343 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
344 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
345 | (i
<< 4) | (j
- 1));
351 elt
= Fmake_vector (make_number (2), make_number (100));
354 args
[1] = Fmake_vector (make_number (1), elt
);
355 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
356 return (100 << 8) | (i
<< 4);
361 EMACS_INT numeric
= XINT (val
);
363 for (i
= 0, last_n
= -1; i
< len
; i
++)
367 CHECK_VECTOR (AREF (table
, i
));
368 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
369 n
= XINT (AREF (AREF (table
, i
), 0));
371 return (n
<< 8) | (i
<< 4);
376 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
377 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
383 return ((last_n
<< 8) | ((i
- 1) << 4));
388 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
391 Lisp_Object val
= AREF (font
, prop
);
392 Lisp_Object table
, elt
;
397 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
398 CHECK_VECTOR (table
);
399 i
= XINT (val
) & 0xFF;
400 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
401 elt
= AREF (table
, ((i
>> 4) & 0xF));
403 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
404 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
409 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
410 FONTNAME. ENCODING is a charset symbol that specifies the encoding
411 of the font. REPERTORY is a charset symbol or nil. */
414 find_font_encoding (Lisp_Object fontname
)
416 Lisp_Object tail
, elt
;
418 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
422 && STRINGP (XCAR (elt
))
423 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
424 && (SYMBOLP (XCDR (elt
))
425 ? CHARSETP (XCDR (elt
))
426 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
432 /* Return encoding charset and repertory charset for REGISTRY in
433 ENCODING and REPERTORY correspondingly. If correct information for
434 REGISTRY is available, return 0. Otherwise return -1. */
437 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
440 int encoding_id
, repertory_id
;
442 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
448 encoding_id
= XINT (XCAR (val
));
449 repertory_id
= XINT (XCDR (val
));
453 val
= find_font_encoding (SYMBOL_NAME (registry
));
454 if (SYMBOLP (val
) && CHARSETP (val
))
456 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
458 else if (CONSP (val
))
460 if (! CHARSETP (XCAR (val
)))
462 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
463 if (NILP (XCDR (val
)))
467 if (! CHARSETP (XCDR (val
)))
469 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
474 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
476 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
480 *encoding
= CHARSET_FROM_ID (encoding_id
);
482 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
487 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
492 /* Font property value validators. See the comment of
493 font_property_table for the meaning of the arguments. */
495 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
496 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
497 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
498 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
499 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
500 static int get_font_prop_index (Lisp_Object
);
503 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
506 val
= Fintern (val
, Qnil
);
509 else if (EQ (prop
, QCregistry
))
510 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
516 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
518 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
519 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
523 EMACS_INT n
= XINT (val
);
524 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
526 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
530 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
533 if ((n
& 0xF) + 1 >= ASIZE (elt
))
537 CHECK_NUMBER (AREF (elt
, 0));
538 if (XINT (AREF (elt
, 0)) != (n
>> 8))
543 else if (SYMBOLP (val
))
545 int n
= font_style_to_value (prop
, val
, 0);
547 val
= n
>= 0 ? make_number (n
) : Qerror
;
555 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
557 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
562 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
564 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
566 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
568 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
570 if (spacing
== 'c' || spacing
== 'C')
571 return make_number (FONT_SPACING_CHARCELL
);
572 if (spacing
== 'm' || spacing
== 'M')
573 return make_number (FONT_SPACING_MONO
);
574 if (spacing
== 'p' || spacing
== 'P')
575 return make_number (FONT_SPACING_PROPORTIONAL
);
576 if (spacing
== 'd' || spacing
== 'D')
577 return make_number (FONT_SPACING_DUAL
);
583 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
585 Lisp_Object tail
, tmp
;
588 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
589 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
590 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
593 if (! SYMBOLP (XCAR (val
)))
598 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
600 for (i
= 0; i
< 2; i
++)
607 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
608 if (! SYMBOLP (XCAR (tmp
)))
616 /* Structure of known font property keys and validator of the
620 /* Pointer to the key symbol. */
622 /* Function to validate PROP's value VAL, or NULL if any value is
623 ok. The value is VAL or its regularized value if VAL is valid,
624 and Qerror if not. */
625 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
626 } font_property_table
[] =
627 { { &QCtype
, font_prop_validate_symbol
},
628 { &QCfoundry
, font_prop_validate_symbol
},
629 { &QCfamily
, font_prop_validate_symbol
},
630 { &QCadstyle
, font_prop_validate_symbol
},
631 { &QCregistry
, font_prop_validate_symbol
},
632 { &QCweight
, font_prop_validate_style
},
633 { &QCslant
, font_prop_validate_style
},
634 { &QCwidth
, font_prop_validate_style
},
635 { &QCsize
, font_prop_validate_non_neg
},
636 { &QCdpi
, font_prop_validate_non_neg
},
637 { &QCspacing
, font_prop_validate_spacing
},
638 { &QCavgwidth
, font_prop_validate_non_neg
},
639 /* The order of the above entries must match with enum
640 font_property_index. */
641 { &QClang
, font_prop_validate_symbol
},
642 { &QCscript
, font_prop_validate_symbol
},
643 { &QCotf
, font_prop_validate_otf
}
646 /* Size (number of elements) of the above table. */
647 #define FONT_PROPERTY_TABLE_SIZE \
648 ((sizeof font_property_table) / (sizeof *font_property_table))
650 /* Return an index number of font property KEY or -1 if KEY is not an
651 already known property. */
654 get_font_prop_index (Lisp_Object key
)
658 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
659 if (EQ (key
, *font_property_table
[i
].key
))
664 /* Validate the font property. The property key is specified by the
665 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
666 signal an error. The value is VAL or the regularized one. */
669 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
671 Lisp_Object validated
;
676 prop
= *font_property_table
[idx
].key
;
679 idx
= get_font_prop_index (prop
);
683 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
684 if (EQ (validated
, Qerror
))
685 signal_error ("invalid font property", Fcons (prop
, val
));
690 /* Store VAL as a value of extra font property PROP in FONT while
691 keeping the sorting order. Don't check the validity of VAL. */
694 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
696 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
697 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
701 Lisp_Object prev
= Qnil
;
704 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
705 prev
= extra
, extra
= XCDR (extra
);
708 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
710 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
716 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
721 /* Font name parser and unparser */
723 static int parse_matrix (const char *);
724 static int font_expand_wildcards (Lisp_Object
*, int);
725 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
727 /* An enumerator for each field of an XLFD font name. */
728 enum xlfd_field_index
747 /* An enumerator for mask bit corresponding to each XLFD field. */
750 XLFD_FOUNDRY_MASK
= 0x0001,
751 XLFD_FAMILY_MASK
= 0x0002,
752 XLFD_WEIGHT_MASK
= 0x0004,
753 XLFD_SLANT_MASK
= 0x0008,
754 XLFD_SWIDTH_MASK
= 0x0010,
755 XLFD_ADSTYLE_MASK
= 0x0020,
756 XLFD_PIXEL_MASK
= 0x0040,
757 XLFD_POINT_MASK
= 0x0080,
758 XLFD_RESX_MASK
= 0x0100,
759 XLFD_RESY_MASK
= 0x0200,
760 XLFD_SPACING_MASK
= 0x0400,
761 XLFD_AVGWIDTH_MASK
= 0x0800,
762 XLFD_REGISTRY_MASK
= 0x1000,
763 XLFD_ENCODING_MASK
= 0x2000
767 /* Parse P pointing to the pixel/point size field of the form
768 `[A B C D]' which specifies a transformation matrix:
774 by which all glyphs of the font are transformed. The spec says
775 that scalar value N for the pixel/point size is equivalent to:
776 A = N * resx/resy, B = C = 0, D = N.
778 Return the scalar value N if the form is valid. Otherwise return
782 parse_matrix (const char *p
)
788 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
791 matrix
[i
] = - strtod (p
+ 1, &end
);
793 matrix
[i
] = strtod (p
, &end
);
796 return (i
== 4 ? (int) matrix
[3] : -1);
799 /* Expand a wildcard field in FIELD (the first N fields are filled) to
800 multiple fields to fill in all 14 XLFD fields while restricting a
801 field position by its contents. */
804 font_expand_wildcards (Lisp_Object
*field
, int n
)
807 Lisp_Object tmp
[XLFD_LAST_INDEX
];
808 /* Array of information about where this element can go. Nth
809 element is for Nth element of FIELD. */
811 /* Minimum possible field. */
813 /* Maximum possible field. */
815 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
817 } range
[XLFD_LAST_INDEX
];
819 int range_from
, range_to
;
822 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
823 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
824 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
825 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
826 | XLFD_AVGWIDTH_MASK)
827 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
829 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
830 field. The value is shifted to left one bit by one in the
832 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
833 range_mask
= (range_mask
<< 1) | 1;
835 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
836 position-based restriction for FIELD[I]. */
837 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
838 i
++, range_from
++, range_to
++, range_mask
<<= 1)
840 Lisp_Object val
= field
[i
];
846 range
[i
].from
= range_from
;
847 range
[i
].to
= range_to
;
848 range
[i
].mask
= range_mask
;
852 /* The triplet FROM, TO, and MASK is a value-based
853 restriction for FIELD[I]. */
859 EMACS_INT numeric
= XINT (val
);
862 from
= to
= XLFD_ENCODING_INDEX
,
863 mask
= XLFD_ENCODING_MASK
;
864 else if (numeric
== 0)
865 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
866 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
867 else if (numeric
<= 48)
868 from
= to
= XLFD_PIXEL_INDEX
,
869 mask
= XLFD_PIXEL_MASK
;
871 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
872 mask
= XLFD_LARGENUM_MASK
;
874 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
875 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
876 mask
= XLFD_NULL_MASK
;
878 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
881 Lisp_Object name
= SYMBOL_NAME (val
);
883 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
884 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
885 mask
= XLFD_REGENC_MASK
;
887 from
= to
= XLFD_ENCODING_INDEX
,
888 mask
= XLFD_ENCODING_MASK
;
890 else if (range_from
<= XLFD_WEIGHT_INDEX
891 && range_to
>= XLFD_WEIGHT_INDEX
892 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
893 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
894 else if (range_from
<= XLFD_SLANT_INDEX
895 && range_to
>= XLFD_SLANT_INDEX
896 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
897 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
898 else if (range_from
<= XLFD_SWIDTH_INDEX
899 && range_to
>= XLFD_SWIDTH_INDEX
900 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
901 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
904 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
905 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
907 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
908 mask
= XLFD_SYMBOL_MASK
;
911 /* Merge position-based and value-based restrictions. */
913 while (from
< range_from
)
914 mask
&= ~(1 << from
++);
915 while (from
< 14 && ! (mask
& (1 << from
)))
917 while (to
> range_to
)
918 mask
&= ~(1 << to
--);
919 while (to
>= 0 && ! (mask
& (1 << to
)))
923 range
[i
].from
= from
;
925 range
[i
].mask
= mask
;
927 if (from
> range_from
|| to
< range_to
)
929 /* The range is narrowed by value-based restrictions.
930 Reflect it to the other fields. */
932 /* Following fields should be after FROM. */
934 /* Preceding fields should be before TO. */
935 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
937 /* Check FROM for non-wildcard field. */
938 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
940 while (range
[j
].from
< from
)
941 range
[j
].mask
&= ~(1 << range
[j
].from
++);
942 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
944 range
[j
].from
= from
;
947 from
= range
[j
].from
;
948 if (range
[j
].to
> to
)
950 while (range
[j
].to
> to
)
951 range
[j
].mask
&= ~(1 << range
[j
].to
--);
952 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
965 /* Decide all fields from restrictions in RANGE. */
966 for (i
= j
= 0; i
< n
; i
++)
968 if (j
< range
[i
].from
)
970 if (i
== 0 || ! NILP (tmp
[i
- 1]))
971 /* None of TMP[X] corresponds to Jth field. */
973 for (; j
< range
[i
].from
; j
++)
978 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
980 for (; j
< XLFD_LAST_INDEX
; j
++)
982 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
983 field
[XLFD_ENCODING_INDEX
]
984 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
989 /* Parse NAME (null terminated) as XLFD and store information in FONT
990 (font-spec or font-entity). Size property of FONT is set as
992 specified XLFD fields FONT property
993 --------------------- -------------
994 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
995 POINT_SIZE and RESY calculated pixel size (Lisp integer)
996 POINT_SIZE POINT_SIZE/10 (Lisp float)
998 If NAME is successfully parsed, return 0. Otherwise return -1.
1000 FONT is usually a font-spec, but when this function is called from
1001 X font backend driver, it is a font-entity. In that case, NAME is
1002 a fully specified XLFD. */
1005 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1008 char *f
[XLFD_LAST_INDEX
+ 1];
1012 if (len
> 255 || !len
)
1013 /* Maximum XLFD name length is 255. */
1015 /* Accept "*-.." as a fully specified XLFD. */
1016 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1017 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1020 for (p
= name
+ i
; *p
; p
++)
1024 if (i
== XLFD_LAST_INDEX
)
1029 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1030 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1032 if (i
== XLFD_LAST_INDEX
)
1034 /* Fully specified XLFD. */
1037 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1038 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1039 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1040 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1042 val
= INTERN_FIELD_SYM (i
);
1045 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1047 ASET (font
, j
, make_number (n
));
1050 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1051 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1052 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1054 ASET (font
, FONT_REGISTRY_INDEX
,
1055 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1056 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1058 p
= f
[XLFD_PIXEL_INDEX
];
1059 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1060 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1063 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1065 ASET (font
, FONT_SIZE_INDEX
, val
);
1066 else if (FONT_ENTITY_P (font
))
1070 double point_size
= -1;
1072 eassert (FONT_SPEC_P (font
));
1073 p
= f
[XLFD_POINT_INDEX
];
1075 point_size
= parse_matrix (p
);
1076 else if (c_isdigit (*p
))
1077 point_size
= atoi (p
), point_size
/= 10;
1078 if (point_size
>= 0)
1079 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1083 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1084 if (! NILP (val
) && ! INTEGERP (val
))
1086 ASET (font
, FONT_DPI_INDEX
, val
);
1087 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1090 val
= font_prop_validate_spacing (QCspacing
, val
);
1091 if (! INTEGERP (val
))
1093 ASET (font
, FONT_SPACING_INDEX
, val
);
1095 p
= f
[XLFD_AVGWIDTH_INDEX
];
1098 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1099 if (! NILP (val
) && ! INTEGERP (val
))
1101 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1105 bool wild_card_found
= 0;
1106 Lisp_Object prop
[XLFD_LAST_INDEX
];
1108 if (FONT_ENTITY_P (font
))
1110 for (j
= 0; j
< i
; j
++)
1114 if (f
[j
][1] && f
[j
][1] != '-')
1117 wild_card_found
= 1;
1120 prop
[j
] = INTERN_FIELD (j
);
1122 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1124 if (! wild_card_found
)
1126 if (font_expand_wildcards (prop
, i
) < 0)
1129 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1130 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1131 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1132 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1133 if (! NILP (prop
[i
]))
1135 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1137 ASET (font
, j
, make_number (n
));
1139 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1140 val
= prop
[XLFD_REGISTRY_INDEX
];
1143 val
= prop
[XLFD_ENCODING_INDEX
];
1145 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1147 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1148 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1150 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1151 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1153 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1155 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1156 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1157 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1159 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1161 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1164 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1165 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1166 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1168 val
= font_prop_validate_spacing (QCspacing
,
1169 prop
[XLFD_SPACING_INDEX
]);
1170 if (! INTEGERP (val
))
1172 ASET (font
, FONT_SPACING_INDEX
, val
);
1174 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1175 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1181 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1182 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1183 0, use PIXEL_SIZE instead. */
1186 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1189 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1193 eassert (FONTP (font
));
1195 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1198 if (i
== FONT_ADSTYLE_INDEX
)
1199 j
= XLFD_ADSTYLE_INDEX
;
1200 else if (i
== FONT_REGISTRY_INDEX
)
1201 j
= XLFD_REGISTRY_INDEX
;
1202 val
= AREF (font
, i
);
1205 if (j
== XLFD_REGISTRY_INDEX
)
1213 val
= SYMBOL_NAME (val
);
1214 if (j
== XLFD_REGISTRY_INDEX
1215 && ! strchr (SSDATA (val
), '-'))
1217 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1218 ptrdiff_t alloc
= SBYTES (val
) + 4;
1219 if (nbytes
<= alloc
)
1221 f
[j
] = p
= alloca (alloc
);
1222 sprintf (p
, "%s%s-*", SDATA (val
),
1223 "*" + (SDATA (val
)[SBYTES (val
) - 1] == '*'));
1226 f
[j
] = SSDATA (val
);
1230 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1233 val
= font_style_symbolic (font
, i
, 0);
1238 val
= SYMBOL_NAME (val
);
1239 f
[j
] = SSDATA (val
);
1243 val
= AREF (font
, FONT_SIZE_INDEX
);
1244 eassert (NUMBERP (val
) || NILP (val
));
1247 EMACS_INT v
= XINT (val
);
1252 f
[XLFD_PIXEL_INDEX
] = p
=
1253 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1254 sprintf (p
, "%"pI
"d-*", v
);
1257 f
[XLFD_PIXEL_INDEX
] = "*-*";
1259 else if (FLOATP (val
))
1261 double v
= XFLOAT_DATA (val
) * 10;
1262 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1263 sprintf (p
, "*-%.0f", v
);
1266 f
[XLFD_PIXEL_INDEX
] = "*-*";
1268 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1270 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1271 f
[XLFD_RESX_INDEX
] = p
=
1272 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1273 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1276 f
[XLFD_RESX_INDEX
] = "*-*";
1277 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1279 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1281 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1282 : spacing
<= FONT_SPACING_DUAL
? "d"
1283 : spacing
<= FONT_SPACING_MONO
? "m"
1287 f
[XLFD_SPACING_INDEX
] = "*";
1288 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1290 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1291 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1294 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1295 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1296 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1297 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1298 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1299 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1300 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1301 f
[XLFD_REGISTRY_INDEX
]);
1302 return len
< nbytes
? len
: -1;
1305 /* Parse NAME (null terminated) and store information in FONT
1306 (font-spec or font-entity). NAME is supplied in either the
1307 Fontconfig or GTK font name format. If NAME is successfully
1308 parsed, return 0. Otherwise return -1.
1310 The fontconfig format is
1312 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1316 FAMILY [PROPS...] [SIZE]
1318 This function tries to guess which format it is. */
1321 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1324 char *size_beg
= NULL
, *size_end
= NULL
;
1325 char *props_beg
= NULL
, *family_end
= NULL
;
1330 for (p
= name
; *p
; p
++)
1332 if (*p
== '\\' && p
[1])
1336 props_beg
= family_end
= p
;
1341 bool decimal
= 0, size_found
= 1;
1342 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1343 if (! c_isdigit (*q
))
1345 if (*q
!= '.' || decimal
)
1364 Lisp_Object extra_props
= Qnil
;
1366 /* A fontconfig name with size and/or property data. */
1367 if (family_end
> name
)
1370 family
= font_intern_prop (name
, family_end
- name
, 1);
1371 ASET (font
, FONT_FAMILY_INDEX
, family
);
1375 double point_size
= strtod (size_beg
, &size_end
);
1376 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1377 if (*size_end
== ':' && size_end
[1])
1378 props_beg
= size_end
;
1382 /* Now parse ":KEY=VAL" patterns. */
1385 for (p
= props_beg
; *p
; p
= q
)
1387 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1390 /* Must be an enumerated value. */
1394 val
= font_intern_prop (p
, q
- p
, 1);
1396 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1397 && memcmp (p, STR, strlen (STR)) == 0)
1399 if (PROP_MATCH ("light")
1400 || PROP_MATCH ("medium")
1401 || PROP_MATCH ("demibold")
1402 || PROP_MATCH ("bold")
1403 || PROP_MATCH ("black"))
1404 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1405 else if (PROP_MATCH ("roman")
1406 || PROP_MATCH ("italic")
1407 || PROP_MATCH ("oblique"))
1408 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1409 else if (PROP_MATCH ("charcell"))
1410 ASET (font
, FONT_SPACING_INDEX
,
1411 make_number (FONT_SPACING_CHARCELL
));
1412 else if (PROP_MATCH ("mono"))
1413 ASET (font
, FONT_SPACING_INDEX
,
1414 make_number (FONT_SPACING_MONO
));
1415 else if (PROP_MATCH ("proportional"))
1416 ASET (font
, FONT_SPACING_INDEX
,
1417 make_number (FONT_SPACING_PROPORTIONAL
));
1426 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1427 prop
= FONT_SIZE_INDEX
;
1430 key
= font_intern_prop (p
, q
- p
, 1);
1431 prop
= get_font_prop_index (key
);
1435 for (q
= p
; *q
&& *q
!= ':'; q
++);
1436 val
= font_intern_prop (p
, q
- p
, 0);
1438 if (prop
>= FONT_FOUNDRY_INDEX
1439 && prop
< FONT_EXTRA_INDEX
)
1440 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1443 extra_props
= nconc2 (extra_props
,
1444 Fcons (Fcons (key
, val
), Qnil
));
1451 if (! NILP (extra_props
))
1453 struct font_driver_list
*driver_list
= font_driver_list
;
1454 for ( ; driver_list
; driver_list
= driver_list
->next
)
1455 if (driver_list
->driver
->filter_properties
)
1456 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1462 /* Either a fontconfig-style name with no size and property
1463 data, or a GTK-style name. */
1464 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1465 Lisp_Object width
= Qnil
, size
= Qnil
;
1469 /* Scan backwards from the end, looking for a size. */
1470 for (p
= name
+ len
- 1; p
>= name
; p
--)
1471 if (!c_isdigit (*p
))
1474 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1475 /* Found a font size. */
1476 size
= make_float (strtod (p
+ 1, NULL
));
1480 /* Now P points to the termination of the string, sans size.
1481 Scan backwards, looking for font properties. */
1482 for (; p
> name
; p
= q
)
1484 for (q
= p
- 1; q
>= name
; q
--)
1486 if (q
> name
&& *(q
-1) == '\\')
1487 --q
; /* Skip quoting backslashes. */
1493 word_len
= p
- word_start
;
1495 #define PROP_MATCH(STR) \
1496 (word_len == strlen (STR) \
1497 && memcmp (word_start, STR, strlen (STR)) == 0)
1498 #define PROP_SAVE(VAR, STR) \
1499 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1501 if (PROP_MATCH ("Ultra-Light"))
1502 PROP_SAVE (weight
, "ultra-light");
1503 else if (PROP_MATCH ("Light"))
1504 PROP_SAVE (weight
, "light");
1505 else if (PROP_MATCH ("Book"))
1506 PROP_SAVE (weight
, "book");
1507 else if (PROP_MATCH ("Medium"))
1508 PROP_SAVE (weight
, "medium");
1509 else if (PROP_MATCH ("Semi-Bold"))
1510 PROP_SAVE (weight
, "semi-bold");
1511 else if (PROP_MATCH ("Bold"))
1512 PROP_SAVE (weight
, "bold");
1513 else if (PROP_MATCH ("Italic"))
1514 PROP_SAVE (slant
, "italic");
1515 else if (PROP_MATCH ("Oblique"))
1516 PROP_SAVE (slant
, "oblique");
1517 else if (PROP_MATCH ("Semi-Condensed"))
1518 PROP_SAVE (width
, "semi-condensed");
1519 else if (PROP_MATCH ("Condensed"))
1520 PROP_SAVE (width
, "condensed");
1521 /* An unknown word must be part of the font name. */
1532 ASET (font
, FONT_FAMILY_INDEX
,
1533 font_intern_prop (name
, family_end
- name
, 1));
1535 ASET (font
, FONT_SIZE_INDEX
, size
);
1537 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1539 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1541 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1547 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1548 NAME (NBYTES length), and return the name length. If
1549 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1552 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1554 Lisp_Object family
, foundry
;
1560 Lisp_Object styles
[3];
1561 const char *style_names
[3] = { "weight", "slant", "width" };
1563 family
= AREF (font
, FONT_FAMILY_INDEX
);
1564 if (! NILP (family
))
1566 if (SYMBOLP (family
))
1567 family
= SYMBOL_NAME (family
);
1572 val
= AREF (font
, FONT_SIZE_INDEX
);
1575 if (XINT (val
) != 0)
1576 pixel_size
= XINT (val
);
1581 eassert (FLOATP (val
));
1583 point_size
= (int) XFLOAT_DATA (val
);
1586 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1587 if (! NILP (foundry
))
1589 if (SYMBOLP (foundry
))
1590 foundry
= SYMBOL_NAME (foundry
);
1595 for (i
= 0; i
< 3; i
++)
1596 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1599 lim
= name
+ nbytes
;
1600 if (! NILP (family
))
1602 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1603 if (! (0 <= len
&& len
< lim
- p
))
1609 int len
= snprintf (p
, lim
- p
, "-%d" + (p
== name
), point_size
);
1610 if (! (0 <= len
&& len
< lim
- p
))
1614 else if (pixel_size
> 0)
1616 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1617 if (! (0 <= len
&& len
< lim
- p
))
1621 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1623 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1624 SSDATA (SYMBOL_NAME (AREF (font
,
1625 FONT_FOUNDRY_INDEX
))));
1626 if (! (0 <= len
&& len
< lim
- p
))
1630 for (i
= 0; i
< 3; i
++)
1631 if (! NILP (styles
[i
]))
1633 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1634 SSDATA (SYMBOL_NAME (styles
[i
])));
1635 if (! (0 <= len
&& len
< lim
- p
))
1640 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1642 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1643 XINT (AREF (font
, FONT_DPI_INDEX
)));
1644 if (! (0 <= len
&& len
< lim
- p
))
1649 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1651 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1652 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1653 if (! (0 <= len
&& len
< lim
- p
))
1658 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1660 int len
= snprintf (p
, lim
- p
,
1661 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1663 : ":scalable=false"));
1664 if (! (0 <= len
&& len
< lim
- p
))
1672 /* Parse NAME (null terminated) and store information in FONT
1673 (font-spec or font-entity). If NAME is successfully parsed, return
1674 0. Otherwise return -1. */
1677 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1679 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1680 return font_parse_xlfd (name
, namelen
, font
);
1681 return font_parse_fcname (name
, namelen
, font
);
1685 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1686 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1690 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1696 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1698 CHECK_STRING (family
);
1699 len
= SBYTES (family
);
1700 p0
= SSDATA (family
);
1701 p1
= strchr (p0
, '-');
1704 if ((*p0
!= '*' && p1
- p0
> 0)
1705 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1706 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1709 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1712 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1714 if (! NILP (registry
))
1716 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1717 CHECK_STRING (registry
);
1718 len
= SBYTES (registry
);
1719 p0
= SSDATA (registry
);
1720 p1
= strchr (p0
, '-');
1723 if (SDATA (registry
)[len
- 1] == '*')
1724 registry
= concat2 (registry
, build_string ("-*"));
1726 registry
= concat2 (registry
, build_string ("*-*"));
1728 registry
= Fdowncase (registry
);
1729 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1734 /* This part (through the next ^L) is still experimental and not
1735 tested much. We may drastically change codes. */
1741 #define LGSTRING_HEADER_SIZE 6
1742 #define LGSTRING_GLYPH_SIZE 8
1745 check_gstring (Lisp_Object gstring
)
1751 CHECK_VECTOR (gstring
);
1752 val
= AREF (gstring
, 0);
1754 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1756 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1757 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1758 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1759 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1760 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1761 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1762 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1763 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1764 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1765 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1766 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1768 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1770 val
= LGSTRING_GLYPH (gstring
, i
);
1772 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1774 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1776 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1777 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1778 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1779 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1780 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1781 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1782 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1783 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1785 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1787 if (ASIZE (val
) < 3)
1789 for (j
= 0; j
< 3; j
++)
1790 CHECK_NUMBER (AREF (val
, j
));
1795 error ("Invalid glyph-string format");
1800 check_otf_features (Lisp_Object otf_features
)
1804 CHECK_CONS (otf_features
);
1805 CHECK_SYMBOL (XCAR (otf_features
));
1806 otf_features
= XCDR (otf_features
);
1807 CHECK_CONS (otf_features
);
1808 CHECK_SYMBOL (XCAR (otf_features
));
1809 otf_features
= XCDR (otf_features
);
1810 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1812 CHECK_SYMBOL (XCAR (val
));
1813 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1814 error ("Invalid OTF GSUB feature: %s",
1815 SDATA (SYMBOL_NAME (XCAR (val
))));
1817 otf_features
= XCDR (otf_features
);
1818 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1820 CHECK_SYMBOL (XCAR (val
));
1821 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1822 error ("Invalid OTF GPOS feature: %s",
1823 SDATA (SYMBOL_NAME (XCAR (val
))));
1830 Lisp_Object otf_list
;
1833 otf_tag_symbol (OTF_Tag tag
)
1837 OTF_tag_name (tag
, name
);
1838 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1842 otf_open (Lisp_Object file
)
1844 Lisp_Object val
= Fassoc (file
, otf_list
);
1848 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1851 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1852 val
= make_save_value (otf
, 0);
1853 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1859 /* Return a list describing which scripts/languages FONT supports by
1860 which GSUB/GPOS features of OpenType tables. See the comment of
1861 (struct font_driver).otf_capability. */
1864 font_otf_capability (struct font
*font
)
1867 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1870 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1873 for (i
= 0; i
< 2; i
++)
1875 OTF_GSUB_GPOS
*gsub_gpos
;
1876 Lisp_Object script_list
= Qnil
;
1879 if (OTF_get_features (otf
, i
== 0) < 0)
1881 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1882 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1884 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1885 Lisp_Object langsys_list
= Qnil
;
1886 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1889 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1891 OTF_LangSys
*langsys
;
1892 Lisp_Object feature_list
= Qnil
;
1893 Lisp_Object langsys_tag
;
1896 if (k
== script
->LangSysCount
)
1898 langsys
= &script
->DefaultLangSys
;
1903 langsys
= script
->LangSys
+ k
;
1905 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1907 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1909 OTF_Feature
*feature
1910 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1911 Lisp_Object feature_tag
1912 = otf_tag_symbol (feature
->FeatureTag
);
1914 feature_list
= Fcons (feature_tag
, feature_list
);
1916 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1919 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1924 XSETCAR (capability
, script_list
);
1926 XSETCDR (capability
, script_list
);
1932 /* Parse OTF features in SPEC and write a proper features spec string
1933 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1934 assured that the sufficient memory has already allocated for
1938 generate_otf_features (Lisp_Object spec
, char *features
)
1946 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1952 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1957 else if (! asterisk
)
1959 val
= SYMBOL_NAME (val
);
1960 p
+= esprintf (p
, "%s", SDATA (val
));
1964 val
= SYMBOL_NAME (val
);
1965 p
+= esprintf (p
, "~%s", SDATA (val
));
1969 error ("OTF spec too long");
1973 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1975 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1977 return Fcons (make_number (len
),
1978 make_unibyte_string (device_table
->DeltaValue
, len
));
1982 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
1984 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1986 if (value_format
& OTF_XPlacement
)
1987 ASET (val
, 0, make_number (value_record
->XPlacement
));
1988 if (value_format
& OTF_YPlacement
)
1989 ASET (val
, 1, make_number (value_record
->YPlacement
));
1990 if (value_format
& OTF_XAdvance
)
1991 ASET (val
, 2, make_number (value_record
->XAdvance
));
1992 if (value_format
& OTF_YAdvance
)
1993 ASET (val
, 3, make_number (value_record
->YAdvance
));
1994 if (value_format
& OTF_XPlaDevice
)
1995 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1996 if (value_format
& OTF_YPlaDevice
)
1997 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1998 if (value_format
& OTF_XAdvDevice
)
1999 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2000 if (value_format
& OTF_YAdvDevice
)
2001 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2006 font_otf_Anchor (OTF_Anchor
*anchor
)
2010 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2011 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2012 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2013 if (anchor
->AnchorFormat
== 2)
2014 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2017 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2018 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2022 #endif /* HAVE_LIBOTF */
2028 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2029 static int font_compare (const void *, const void *);
2030 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2034 font_rescale_ratio (Lisp_Object font_entity
)
2036 Lisp_Object tail
, elt
;
2037 Lisp_Object name
= Qnil
;
2039 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2042 if (FLOATP (XCDR (elt
)))
2044 if (STRINGP (XCAR (elt
)))
2047 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2048 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2049 return XFLOAT_DATA (XCDR (elt
));
2051 else if (FONT_SPEC_P (XCAR (elt
)))
2053 if (font_match_p (XCAR (elt
), font_entity
))
2054 return XFLOAT_DATA (XCDR (elt
));
2061 /* We sort fonts by scoring each of them against a specified
2062 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2063 the value is, the closer the font is to the font-spec.
2065 The lowest 2 bits of the score are used for driver type. The font
2066 available by the most preferred font driver is 0.
2068 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2069 WEIGHT, SLANT, WIDTH, and SIZE. */
2071 /* How many bits to shift to store the difference value of each font
2072 property in a score. Note that floats for FONT_TYPE_INDEX and
2073 FONT_REGISTRY_INDEX are not used. */
2074 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2076 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2077 The return value indicates how different ENTITY is compared with
2081 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2086 /* Score three style numeric fields. Maximum difference is 127. */
2087 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2088 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2090 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2091 - (XINT (spec_prop
[i
]) >> 8));
2094 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2097 /* Score the size. Maximum difference is 127. */
2098 i
= FONT_SIZE_INDEX
;
2099 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2100 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2102 /* We use the higher 6-bit for the actual size difference. The
2103 lowest bit is set if the DPI is different. */
2105 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2107 if (CONSP (Vface_font_rescale_alist
))
2108 pixel_size
*= font_rescale_ratio (entity
);
2109 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2113 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2114 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2116 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2117 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2119 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2126 /* Concatenate all elements of LIST into one vector. LIST is a list
2127 of font-entity vectors. */
2130 font_vconcat_entity_vectors (Lisp_Object list
)
2132 int nargs
= XINT (Flength (list
));
2133 Lisp_Object
*args
= alloca (word_size
* nargs
);
2136 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2137 args
[i
] = XCAR (list
);
2138 return Fvconcat (nargs
, args
);
2142 /* The structure for elements being sorted by qsort. */
2143 struct font_sort_data
2146 int font_driver_preference
;
2151 /* The comparison function for qsort. */
2154 font_compare (const void *d1
, const void *d2
)
2156 const struct font_sort_data
*data1
= d1
;
2157 const struct font_sort_data
*data2
= d2
;
2159 if (data1
->score
< data2
->score
)
2161 else if (data1
->score
> data2
->score
)
2163 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2167 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2168 If PREFER specifies a point-size, calculate the corresponding
2169 pixel-size from QCdpi property of PREFER or from the Y-resolution
2170 of FRAME before sorting.
2172 If BEST-ONLY is nonzero, return the best matching entity (that
2173 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2174 if BEST-ONLY is negative). Otherwise, return the sorted result as
2175 a single vector of font-entities.
2177 This function does no optimization for the case that the total
2178 number of elements is 1. The caller should avoid calling this in
2182 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2184 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2186 struct font_sort_data
*data
;
2187 unsigned best_score
;
2188 Lisp_Object best_entity
;
2189 struct frame
*f
= XFRAME (frame
);
2190 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2193 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2194 prefer_prop
[i
] = AREF (prefer
, i
);
2195 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2196 prefer_prop
[FONT_SIZE_INDEX
]
2197 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2199 if (NILP (XCDR (list
)))
2201 /* What we have to take care of is this single vector. */
2203 maxlen
= ASIZE (vec
);
2207 /* We don't have to perform sort, so there's no need of creating
2208 a single vector. But, we must find the length of the longest
2211 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2212 if (maxlen
< ASIZE (XCAR (tail
)))
2213 maxlen
= ASIZE (XCAR (tail
));
2217 /* We have to create a single vector to sort it. */
2218 vec
= font_vconcat_entity_vectors (list
);
2219 maxlen
= ASIZE (vec
);
2222 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2223 best_score
= 0xFFFFFFFF;
2226 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2228 int font_driver_preference
= 0;
2229 Lisp_Object current_font_driver
;
2235 /* We are sure that the length of VEC > 0. */
2236 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2237 /* Score the elements. */
2238 for (i
= 0; i
< len
; i
++)
2240 data
[i
].entity
= AREF (vec
, i
);
2242 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2244 ? font_score (data
[i
].entity
, prefer_prop
)
2246 if (best_only
&& best_score
> data
[i
].score
)
2248 best_score
= data
[i
].score
;
2249 best_entity
= data
[i
].entity
;
2250 if (best_score
== 0)
2253 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2255 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2256 font_driver_preference
++;
2258 data
[i
].font_driver_preference
= font_driver_preference
;
2261 /* Sort if necessary. */
2264 qsort (data
, len
, sizeof *data
, font_compare
);
2265 for (i
= 0; i
< len
; i
++)
2266 ASET (vec
, i
, data
[i
].entity
);
2275 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2280 /* API of Font Service Layer. */
2282 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2283 sort_shift_bits. Finternal_set_font_selection_order calls this
2284 function with font_sort_order after setting up it. */
2287 font_update_sort_order (int *order
)
2291 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2293 int xlfd_idx
= order
[i
];
2295 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2296 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2297 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2298 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2299 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2300 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2302 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2307 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2308 Lisp_Object features
, Lisp_Object table
)
2313 table
= assq_no_quit (script
, table
);
2316 table
= XCDR (table
);
2317 if (! NILP (langsys
))
2319 table
= assq_no_quit (langsys
, table
);
2325 val
= assq_no_quit (Qnil
, table
);
2327 table
= XCAR (table
);
2331 table
= XCDR (table
);
2332 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2334 if (NILP (XCAR (features
)))
2339 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2345 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2348 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2350 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2352 script
= XCAR (spec
);
2356 langsys
= XCAR (spec
);
2367 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2368 XCAR (otf_capability
)))
2370 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2371 XCDR (otf_capability
)))
2378 /* Check if FONT (font-entity or font-object) matches with the font
2379 specification SPEC. */
2382 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2384 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2385 Lisp_Object extra
, font_extra
;
2388 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2389 if (! NILP (AREF (spec
, i
))
2390 && ! NILP (AREF (font
, i
))
2391 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2393 props
= XFONT_SPEC (spec
)->props
;
2394 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2396 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2397 prop
[i
] = AREF (spec
, i
);
2398 prop
[FONT_SIZE_INDEX
]
2399 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2403 if (font_score (font
, props
) > 0)
2405 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2406 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2407 for (; CONSP (extra
); extra
= XCDR (extra
))
2409 Lisp_Object key
= XCAR (XCAR (extra
));
2410 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2412 if (EQ (key
, QClang
))
2414 val2
= assq_no_quit (key
, font_extra
);
2423 if (NILP (Fmemq (val
, val2
)))
2428 ? NILP (Fmemq (val
, XCDR (val2
)))
2432 else if (EQ (key
, QCscript
))
2434 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2440 /* All characters in the list must be supported. */
2441 for (; CONSP (val2
); val2
= XCDR (val2
))
2443 if (! CHARACTERP (XCAR (val2
)))
2445 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2446 == FONT_INVALID_CODE
)
2450 else if (VECTORP (val2
))
2452 /* At most one character in the vector must be supported. */
2453 for (i
= 0; i
< ASIZE (val2
); i
++)
2455 if (! CHARACTERP (AREF (val2
, i
)))
2457 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2458 != FONT_INVALID_CODE
)
2461 if (i
== ASIZE (val2
))
2466 else if (EQ (key
, QCotf
))
2470 if (! FONT_OBJECT_P (font
))
2472 fontp
= XFONT_OBJECT (font
);
2473 if (! fontp
->driver
->otf_capability
)
2475 val2
= fontp
->driver
->otf_capability (fontp
);
2476 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2487 Each font backend has the callback function get_cache, and it
2488 returns a cons cell of which cdr part can be freely used for
2489 caching fonts. The cons cell may be shared by multiple frames
2490 and/or multiple font drivers. So, we arrange the cdr part as this:
2492 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2494 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2495 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2496 cons (FONT-SPEC FONT-ENTITY ...). */
2498 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2499 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2500 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2501 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2502 struct font_driver
*);
2505 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2507 Lisp_Object cache
, val
;
2509 cache
= driver
->get_cache (f
);
2511 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2515 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2516 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2520 val
= XCDR (XCAR (val
));
2521 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2527 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2529 Lisp_Object cache
, val
, tmp
;
2532 cache
= driver
->get_cache (f
);
2534 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2535 cache
= val
, val
= XCDR (val
);
2536 eassert (! NILP (val
));
2537 tmp
= XCDR (XCAR (val
));
2538 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2539 if (XINT (XCAR (tmp
)) == 0)
2541 font_clear_cache (f
, XCAR (val
), driver
);
2542 XSETCDR (cache
, XCDR (val
));
2548 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2550 Lisp_Object val
= driver
->get_cache (f
);
2551 Lisp_Object type
= driver
->type
;
2553 eassert (CONSP (val
));
2554 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2555 eassert (CONSP (val
));
2556 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2557 val
= XCDR (XCAR (val
));
2561 static int num_fonts
;
2564 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2566 Lisp_Object tail
, elt
;
2567 Lisp_Object tail2
, entity
;
2569 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2570 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2573 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2574 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2576 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2578 entity
= XCAR (tail2
);
2580 if (FONT_ENTITY_P (entity
)
2581 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2583 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2585 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2587 Lisp_Object val
= XCAR (objlist
);
2588 struct font
*font
= XFONT_OBJECT (val
);
2590 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2592 eassert (font
&& driver
== font
->driver
);
2593 driver
->close (f
, font
);
2597 if (driver
->free_entity
)
2598 driver
->free_entity (entity
);
2603 XSETCDR (cache
, Qnil
);
2607 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2609 /* Check each font-entity in VEC, and return a list of font-entities
2610 that satisfy these conditions:
2611 (1) matches with SPEC and SIZE if SPEC is not nil, and
2612 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2616 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2618 Lisp_Object entity
, val
;
2619 enum font_property_index prop
;
2622 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2624 entity
= AREF (vec
, i
);
2625 if (! NILP (Vface_ignored_fonts
))
2629 Lisp_Object tail
, regexp
;
2631 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2634 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2636 regexp
= XCAR (tail
);
2637 if (STRINGP (regexp
)
2638 && fast_c_string_match_ignore_case (regexp
, name
,
2648 val
= Fcons (entity
, val
);
2651 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2652 if (INTEGERP (AREF (spec
, prop
))
2653 && ((XINT (AREF (spec
, prop
)) >> 8)
2654 != (XINT (AREF (entity
, prop
)) >> 8)))
2655 prop
= FONT_SPEC_MAX
;
2656 if (prop
< FONT_SPEC_MAX
2658 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2660 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2663 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2664 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2665 prop
= FONT_SPEC_MAX
;
2667 if (prop
< FONT_SPEC_MAX
2668 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2669 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2670 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2671 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2672 prop
= FONT_SPEC_MAX
;
2673 if (prop
< FONT_SPEC_MAX
2674 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2675 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2676 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2677 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2678 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2679 prop
= FONT_SPEC_MAX
;
2680 if (prop
< FONT_SPEC_MAX
)
2681 val
= Fcons (entity
, val
);
2683 return (Fvconcat (1, &val
));
2687 /* Return a list of vectors of font-entities matching with SPEC on
2688 FRAME. Each elements in the list is a vector of entities from the
2689 same font-driver. */
2692 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2694 FRAME_PTR f
= XFRAME (frame
);
2695 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2696 Lisp_Object ftype
, val
;
2697 Lisp_Object list
= Qnil
;
2699 bool need_filtering
= 0;
2702 eassert (FONT_SPEC_P (spec
));
2704 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2705 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2706 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2707 size
= font_pixel_size (f
, spec
);
2711 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2712 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2713 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2714 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2715 if (i
!= FONT_SPACING_INDEX
)
2717 ASET (scratch_font_spec
, i
, Qnil
);
2718 if (! NILP (AREF (spec
, i
)))
2721 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2722 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2724 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2726 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2728 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2730 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2731 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2738 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2742 val
= Fvconcat (1, &val
);
2743 copy
= copy_font_spec (scratch_font_spec
);
2744 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2745 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2749 || ! NILP (Vface_ignored_fonts
)))
2750 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2751 if (ASIZE (val
) > 0)
2752 list
= Fcons (val
, list
);
2755 list
= Fnreverse (list
);
2756 FONT_ADD_LOG ("list", spec
, list
);
2761 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2762 nil, is an array of face's attributes, which specifies preferred
2763 font-related attributes. */
2766 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2768 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2769 Lisp_Object ftype
, size
, entity
;
2771 Lisp_Object work
= copy_font_spec (spec
);
2773 XSETFRAME (frame
, f
);
2774 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2775 size
= AREF (spec
, FONT_SIZE_INDEX
);
2778 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2779 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2780 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2781 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2784 for (; driver_list
; driver_list
= driver_list
->next
)
2786 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2788 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2791 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2792 entity
= assoc_no_quit (work
, XCDR (cache
));
2794 entity
= XCDR (entity
);
2797 entity
= driver_list
->driver
->match (frame
, work
);
2798 copy
= copy_font_spec (work
);
2799 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2800 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2802 if (! NILP (entity
))
2805 FONT_ADD_LOG ("match", work
, entity
);
2810 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2811 opened font object. */
2814 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2816 struct font_driver_list
*driver_list
;
2817 Lisp_Object objlist
, size
, val
, font_object
;
2819 int min_width
, height
;
2820 int scaled_pixel_size
= pixel_size
;
2822 eassert (FONT_ENTITY_P (entity
));
2823 size
= AREF (entity
, FONT_SIZE_INDEX
);
2824 if (XINT (size
) != 0)
2825 scaled_pixel_size
= pixel_size
= XINT (size
);
2826 else if (CONSP (Vface_font_rescale_alist
))
2827 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2829 val
= AREF (entity
, FONT_TYPE_INDEX
);
2830 for (driver_list
= f
->font_driver_list
;
2831 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2832 driver_list
= driver_list
->next
);
2836 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2837 objlist
= XCDR (objlist
))
2839 Lisp_Object fn
= XCAR (objlist
);
2840 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2841 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2843 if (driver_list
->driver
->cached_font_ok
== NULL
2844 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2849 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2850 if (!NILP (font_object
))
2851 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2852 FONT_ADD_LOG ("open", entity
, font_object
);
2853 if (NILP (font_object
))
2855 ASET (entity
, FONT_OBJLIST_INDEX
,
2856 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2859 font
= XFONT_OBJECT (font_object
);
2860 min_width
= (font
->min_width
? font
->min_width
2861 : font
->average_width
? font
->average_width
2862 : font
->space_width
? font
->space_width
2864 height
= (font
->height
? font
->height
: 1);
2865 #ifdef HAVE_WINDOW_SYSTEM
2866 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2867 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2869 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2870 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2871 fonts_changed_p
= 1;
2875 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2876 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2877 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2878 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2886 /* Close FONT_OBJECT that is opened on frame F. */
2889 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2891 struct font
*font
= XFONT_OBJECT (font_object
);
2893 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2894 /* Already closed. */
2896 FONT_ADD_LOG ("close", font_object
, Qnil
);
2897 font
->driver
->close (f
, font
);
2898 #ifdef HAVE_WINDOW_SYSTEM
2899 eassert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2900 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2906 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2907 FONT is a font-entity and it must be opened to check. */
2910 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2914 if (FONT_ENTITY_P (font
))
2916 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2917 struct font_driver_list
*driver_list
;
2919 for (driver_list
= f
->font_driver_list
;
2920 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2921 driver_list
= driver_list
->next
);
2924 if (! driver_list
->driver
->has_char
)
2926 return driver_list
->driver
->has_char (font
, c
);
2929 eassert (FONT_OBJECT_P (font
));
2930 fontp
= XFONT_OBJECT (font
);
2931 if (fontp
->driver
->has_char
)
2933 int result
= fontp
->driver
->has_char (font
, c
);
2938 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2942 /* Return the glyph ID of FONT_OBJECT for character C. */
2945 font_encode_char (Lisp_Object font_object
, int c
)
2949 eassert (FONT_OBJECT_P (font_object
));
2950 font
= XFONT_OBJECT (font_object
);
2951 return font
->driver
->encode_char (font
, c
);
2955 /* Return the name of FONT_OBJECT. */
2958 font_get_name (Lisp_Object font_object
)
2960 eassert (FONT_OBJECT_P (font_object
));
2961 return AREF (font_object
, FONT_NAME_INDEX
);
2965 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2966 could not be parsed by font_parse_name, return Qnil. */
2969 font_spec_from_name (Lisp_Object font_name
)
2971 Lisp_Object spec
= Ffont_spec (0, NULL
);
2973 CHECK_STRING (font_name
);
2974 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2976 font_put_extra (spec
, QCname
, font_name
);
2977 font_put_extra (spec
, QCuser_spec
, font_name
);
2983 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2985 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2990 if (! NILP (Ffont_get (font
, QCname
)))
2992 font
= copy_font_spec (font
);
2993 font_put_extra (font
, QCname
, Qnil
);
2996 if (NILP (AREF (font
, prop
))
2997 && prop
!= FONT_FAMILY_INDEX
2998 && prop
!= FONT_FOUNDRY_INDEX
2999 && prop
!= FONT_WIDTH_INDEX
3000 && prop
!= FONT_SIZE_INDEX
)
3002 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3003 font
= copy_font_spec (font
);
3004 ASET (font
, prop
, Qnil
);
3005 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3007 if (prop
== FONT_FAMILY_INDEX
)
3009 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3010 /* If we are setting the font family, we must also clear
3011 FONT_WIDTH_INDEX to avoid rejecting families that lack
3012 support for some widths. */
3013 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3015 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3016 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3017 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3018 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3019 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3020 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3022 else if (prop
== FONT_SIZE_INDEX
)
3024 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3025 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3026 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3028 else if (prop
== FONT_WIDTH_INDEX
)
3029 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3030 attrs
[LFACE_FONT_INDEX
] = font
;
3033 /* Select a font from ENTITIES (list of font-entity vectors) that
3034 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3037 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3039 Lisp_Object font_entity
;
3042 FRAME_PTR f
= XFRAME (frame
);
3044 if (NILP (XCDR (entities
))
3045 && ASIZE (XCAR (entities
)) == 1)
3047 font_entity
= AREF (XCAR (entities
), 0);
3048 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3053 /* Sort fonts by properties specified in ATTRS. */
3054 prefer
= scratch_font_prefer
;
3056 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3057 ASET (prefer
, i
, Qnil
);
3058 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3060 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3062 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3063 ASET (prefer
, i
, AREF (face_font
, i
));
3065 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3066 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3067 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3068 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3069 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3070 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3071 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3073 return font_sort_entities (entities
, prefer
, frame
, c
);
3076 /* Return a font-entity that satisfies SPEC and is the best match for
3077 face's font related attributes in ATTRS. C, if not negative, is a
3078 character that the entity must support. */
3081 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3084 Lisp_Object frame
, entities
, val
;
3085 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3090 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3091 if (NILP (registry
[0]))
3093 registry
[0] = DEFAULT_ENCODING
;
3094 registry
[1] = Qascii_0
;
3095 registry
[2] = zero_vector
;
3098 registry
[1] = zero_vector
;
3100 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3102 struct charset
*encoding
, *repertory
;
3104 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3105 &encoding
, &repertory
) < 0)
3108 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3110 else if (c
> encoding
->max_char
)
3114 work
= copy_font_spec (spec
);
3115 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3116 XSETFRAME (frame
, f
);
3117 pixel_size
= font_pixel_size (f
, spec
);
3118 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3120 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3122 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3124 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3125 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3126 if (! NILP (foundry
[0]))
3127 foundry
[1] = zero_vector
;
3128 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3130 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3131 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3133 foundry
[2] = zero_vector
;
3136 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3138 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3139 if (! NILP (adstyle
[0]))
3140 adstyle
[1] = zero_vector
;
3141 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3143 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3145 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3147 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3149 adstyle
[2] = zero_vector
;
3152 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3155 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3158 val
= AREF (work
, FONT_FAMILY_INDEX
);
3159 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3161 val
= attrs
[LFACE_FAMILY_INDEX
];
3162 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3166 family
= alloca ((sizeof family
[0]) * 2);
3168 family
[1] = zero_vector
; /* terminator. */
3173 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3175 if (! NILP (alters
))
3177 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3178 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3179 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3180 family
[i
] = XCAR (alters
);
3181 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3183 family
[i
] = zero_vector
;
3187 family
= alloca ((sizeof family
[0]) * 3);
3190 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3192 family
[i
] = zero_vector
;
3196 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3198 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3199 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3201 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3202 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3204 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3205 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3207 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3208 entities
= font_list_entities (frame
, work
);
3209 if (! NILP (entities
))
3211 val
= font_select_entity (frame
, entities
,
3212 attrs
, pixel_size
, c
);
3227 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3231 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3232 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3233 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3234 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3235 size
= font_pixel_size (f
, spec
);
3239 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3240 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3243 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3244 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3245 eassert (INTEGERP (height
));
3250 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3254 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3255 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3259 return font_open_entity (f
, entity
, size
);
3263 /* Find a font that satisfies SPEC and is the best match for
3264 face's attributes in ATTRS on FRAME, and return the opened
3268 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3270 Lisp_Object entity
, name
;
3272 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3275 /* No font is listed for SPEC, but each font-backend may have
3276 different criteria about "font matching". So, try it. */
3277 entity
= font_matching_entity (f
, attrs
, spec
);
3281 /* Don't lose the original name that was put in initially. We need
3282 it to re-apply the font when font parameters (like hinting or dpi) have
3284 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3287 name
= Ffont_get (spec
, QCuser_spec
);
3288 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3294 /* Make FACE on frame F ready to use the font opened for FACE. */
3297 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3299 if (face
->font
->driver
->prepare_face
)
3300 face
->font
->driver
->prepare_face (f
, face
);
3304 /* Make FACE on frame F stop using the font opened for FACE. */
3307 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3309 if (face
->font
->driver
->done_face
)
3310 face
->font
->driver
->done_face (f
, face
);
3315 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3316 font is found, return Qnil. */
3319 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3321 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3323 /* We set up the default font-related attributes of a face to prefer
3325 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3326 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3327 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3329 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3331 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3333 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3335 return font_load_for_lface (f
, attrs
, spec
);
3339 /* Open a font that matches NAME on frame F. If no proper font is
3340 found, return Qnil. */
3343 font_open_by_name (FRAME_PTR f
, Lisp_Object name
)
3345 Lisp_Object args
[2];
3346 Lisp_Object spec
, ret
;
3350 spec
= Ffont_spec (2, args
);
3351 ret
= font_open_by_spec (f
, spec
);
3352 /* Do not lose name originally put in. */
3354 font_put_extra (ret
, QCuser_spec
, args
[1]);
3360 /* Register font-driver DRIVER. This function is used in two ways.
3362 The first is with frame F non-NULL. In this case, make DRIVER
3363 available (but not yet activated) on F. All frame creators
3364 (e.g. Fx_create_frame) must call this function at least once with
3365 an available font-driver.
3367 The second is with frame F NULL. In this case, DRIVER is globally
3368 registered in the variable `font_driver_list'. All font-driver
3369 implementations must call this function in its syms_of_XXXX
3370 (e.g. syms_of_xfont). */
3373 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3375 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3376 struct font_driver_list
*prev
, *list
;
3378 if (f
&& ! driver
->draw
)
3379 error ("Unusable font driver for a frame: %s",
3380 SDATA (SYMBOL_NAME (driver
->type
)));
3382 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3383 if (EQ (list
->driver
->type
, driver
->type
))
3384 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3386 list
= xmalloc (sizeof *list
);
3388 list
->driver
= driver
;
3393 f
->font_driver_list
= list
;
3395 font_driver_list
= list
;
3401 free_font_driver_list (FRAME_PTR f
)
3403 struct font_driver_list
*list
, *next
;
3405 for (list
= f
->font_driver_list
; list
; list
= next
)
3410 f
->font_driver_list
= NULL
;
3414 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3415 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3416 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3418 A caller must free all realized faces if any in advance. The
3419 return value is a list of font backends actually made used on
3423 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3425 Lisp_Object active_drivers
= Qnil
;
3426 struct font_driver_list
*list
;
3428 /* At first, turn off non-requested drivers, and turn on requested
3430 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3432 struct font_driver
*driver
= list
->driver
;
3433 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3438 if (driver
->end_for_frame
)
3439 driver
->end_for_frame (f
);
3440 font_finish_cache (f
, driver
);
3445 if (! driver
->start_for_frame
3446 || driver
->start_for_frame (f
) == 0)
3448 font_prepare_cache (f
, driver
);
3455 if (NILP (new_drivers
))
3458 if (! EQ (new_drivers
, Qt
))
3460 /* Re-order the driver list according to new_drivers. */
3461 struct font_driver_list
**list_table
, **next
;
3465 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3466 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3468 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3469 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3472 list_table
[i
++] = list
;
3474 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3476 list_table
[i
++] = list
;
3477 list_table
[i
] = NULL
;
3479 next
= &f
->font_driver_list
;
3480 for (i
= 0; list_table
[i
]; i
++)
3482 *next
= list_table
[i
];
3483 next
= &(*next
)->next
;
3487 if (! f
->font_driver_list
->on
)
3488 { /* None of the drivers is enabled: enable them all.
3489 Happens if you set the list of drivers to (xft x) in your .emacs
3490 and then use it under w32 or ns. */
3491 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3493 struct font_driver
*driver
= list
->driver
;
3494 eassert (! list
->on
);
3495 if (! driver
->start_for_frame
3496 || driver
->start_for_frame (f
) == 0)
3498 font_prepare_cache (f
, driver
);
3505 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3507 active_drivers
= nconc2 (active_drivers
,
3508 Fcons (list
->driver
->type
, Qnil
));
3509 return active_drivers
;
3513 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3515 struct font_data_list
*list
, *prev
;
3517 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3518 prev
= list
, list
= list
->next
)
3519 if (list
->driver
== driver
)
3526 prev
->next
= list
->next
;
3528 f
->font_data_list
= list
->next
;
3536 list
= xmalloc (sizeof *list
);
3537 list
->driver
= driver
;
3538 list
->next
= f
->font_data_list
;
3539 f
->font_data_list
= list
;
3547 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3549 struct font_data_list
*list
;
3551 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3552 if (list
->driver
== driver
)
3560 /* Sets attributes on a font. Any properties that appear in ALIST and
3561 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3562 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3563 arrays of strings. This function is intended for use by the font
3564 drivers to implement their specific font_filter_properties. */
3566 font_filter_properties (Lisp_Object font
,
3568 const char *const boolean_properties
[],
3569 const char *const non_boolean_properties
[])
3574 /* Set boolean values to Qt or Qnil */
3575 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3576 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3578 Lisp_Object key
= XCAR (XCAR (it
));
3579 Lisp_Object val
= XCDR (XCAR (it
));
3580 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3582 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3584 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3585 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3588 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3589 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3590 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3591 || strcmp ("Off", str
) == 0)
3596 Ffont_put (font
, key
, val
);
3600 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3601 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3603 Lisp_Object key
= XCAR (XCAR (it
));
3604 Lisp_Object val
= XCDR (XCAR (it
));
3605 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3606 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3607 Ffont_put (font
, key
, val
);
3612 /* Return the font used to draw character C by FACE at buffer position
3613 POS in window W. If STRING is non-nil, it is a string containing C
3614 at index POS. If C is negative, get C from the current buffer or
3618 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3623 Lisp_Object font_object
;
3625 multibyte
= (NILP (string
)
3626 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3627 : STRING_MULTIBYTE (string
));
3634 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3636 c
= FETCH_CHAR (pos_byte
);
3639 c
= FETCH_BYTE (pos
);
3645 multibyte
= STRING_MULTIBYTE (string
);
3648 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3650 str
= SDATA (string
) + pos_byte
;
3651 c
= STRING_CHAR (str
);
3654 c
= SDATA (string
)[pos
];
3658 f
= XFRAME (w
->frame
);
3659 if (! FRAME_WINDOW_P (f
))
3666 if (STRINGP (string
))
3667 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3668 DEFAULT_FACE_ID
, 0);
3670 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3672 face
= FACE_FROM_ID (f
, face_id
);
3676 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3677 face
= FACE_FROM_ID (f
, face_id
);
3682 XSETFONT (font_object
, face
->font
);
3687 #ifdef HAVE_WINDOW_SYSTEM
3689 /* Check how many characters after POS (at most to *LIMIT) can be
3690 displayed by the same font in the window W. FACE, if non-NULL, is
3691 the face selected for the character at POS. If STRING is not nil,
3692 it is the string to check instead of the current buffer. In that
3693 case, FACE must be not NULL.
3695 The return value is the font-object for the character at POS.
3696 *LIMIT is set to the position where that font can't be used.
3698 It is assured that the current buffer (or STRING) is multibyte. */
3701 font_range (ptrdiff_t pos
, ptrdiff_t *limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3703 ptrdiff_t pos_byte
, ignore
;
3705 Lisp_Object font_object
= Qnil
;
3709 pos_byte
= CHAR_TO_BYTE (pos
);
3714 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3716 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3722 pos_byte
= string_char_to_byte (string
, pos
);
3725 while (pos
< *limit
)
3727 Lisp_Object category
;
3730 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3732 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3733 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3734 if (INTEGERP (category
)
3735 && (XINT (category
) == UNICODE_CATEGORY_Cf
3736 || CHAR_VARIATION_SELECTOR_P (c
)))
3738 if (NILP (font_object
))
3740 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3741 if (NILP (font_object
))
3745 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3755 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3756 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3757 Return nil otherwise.
3758 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3759 which kind of font it is. It must be one of `font-spec', `font-entity',
3761 (Lisp_Object object
, Lisp_Object extra_type
)
3763 if (NILP (extra_type
))
3764 return (FONTP (object
) ? Qt
: Qnil
);
3765 if (EQ (extra_type
, Qfont_spec
))
3766 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3767 if (EQ (extra_type
, Qfont_entity
))
3768 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3769 if (EQ (extra_type
, Qfont_object
))
3770 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3771 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3774 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3775 doc
: /* Return a newly created font-spec with arguments as properties.
3777 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3778 valid font property name listed below:
3780 `:family', `:weight', `:slant', `:width'
3782 They are the same as face attributes of the same name. See
3783 `set-face-attribute'.
3787 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3791 VALUE must be a string or a symbol specifying the additional
3792 typographic style information of a font, e.g. ``sans''.
3796 VALUE must be a string or a symbol specifying the charset registry and
3797 encoding of a font, e.g. ``iso8859-1''.
3801 VALUE must be a non-negative integer or a floating point number
3802 specifying the font size. It specifies the font size in pixels (if
3803 VALUE is an integer), or in points (if VALUE is a float).
3807 VALUE must be a string of XLFD-style or fontconfig-style font name.
3811 VALUE must be a symbol representing a script that the font must
3812 support. It may be a symbol representing a subgroup of a script
3813 listed in the variable `script-representative-chars'.
3817 VALUE must be a symbol of two-letter ISO-639 language names,
3822 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3823 required OpenType features.
3825 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3826 LANGSYS-TAG: OpenType language system tag symbol,
3827 or nil for the default language system.
3828 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3829 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3831 GSUB and GPOS may contain `nil' element. In such a case, the font
3832 must not have any of the remaining elements.
3834 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3835 be an OpenType font whose GPOS table of `thai' script's default
3836 language system must contain `mark' feature.
3838 usage: (font-spec ARGS...) */)
3839 (ptrdiff_t nargs
, Lisp_Object
*args
)
3841 Lisp_Object spec
= font_make_spec ();
3844 for (i
= 0; i
< nargs
; i
+= 2)
3846 Lisp_Object key
= args
[i
], val
;
3850 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3853 if (EQ (key
, QCname
))
3856 font_parse_name (SSDATA (val
), SBYTES (val
), spec
);
3857 font_put_extra (spec
, key
, val
);
3861 int idx
= get_font_prop_index (key
);
3865 val
= font_prop_validate (idx
, Qnil
, val
);
3866 if (idx
< FONT_EXTRA_INDEX
)
3867 ASET (spec
, idx
, val
);
3869 font_put_extra (spec
, key
, val
);
3872 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3878 /* Return a copy of FONT as a font-spec. */
3880 copy_font_spec (Lisp_Object font
)
3882 Lisp_Object new_spec
, tail
, prev
, extra
;
3886 new_spec
= font_make_spec ();
3887 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3888 ASET (new_spec
, i
, AREF (font
, i
));
3889 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3890 /* We must remove :font-entity property. */
3891 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3892 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3895 extra
= XCDR (extra
);
3897 XSETCDR (prev
, XCDR (tail
));
3900 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3904 /* Merge font-specs FROM and TO, and return a new font-spec.
3905 Every specified property in FROM overrides the corresponding
3908 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3910 Lisp_Object extra
, tail
;
3915 to
= copy_font_spec (to
);
3916 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3917 ASET (to
, i
, AREF (from
, i
));
3918 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3919 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3920 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3922 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3925 XSETCDR (slot
, XCDR (XCAR (tail
)));
3927 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3929 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3933 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3934 doc
: /* Return the value of FONT's property KEY.
3935 FONT is a font-spec, a font-entity, or a font-object.
3936 KEY is any symbol, but these are reserved for specific meanings:
3937 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3938 :size, :name, :script, :otf
3939 See the documentation of `font-spec' for their meanings.
3940 In addition, if FONT is a font-entity or a font-object, values of
3941 :script and :otf are different from those of a font-spec as below:
3943 The value of :script may be a list of scripts that are supported by the font.
3945 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3946 representing the OpenType features supported by the font by this form:
3947 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3948 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3950 (Lisp_Object font
, Lisp_Object key
)
3958 idx
= get_font_prop_index (key
);
3959 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3960 return font_style_symbolic (font
, idx
, 0);
3961 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3962 return AREF (font
, idx
);
3963 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3964 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3966 struct font
*fontp
= XFONT_OBJECT (font
);
3968 if (fontp
->driver
->otf_capability
)
3969 val
= fontp
->driver
->otf_capability (fontp
);
3971 val
= Fcons (Qnil
, Qnil
);
3978 #ifdef HAVE_WINDOW_SYSTEM
3980 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3981 doc
: /* Return a plist of face attributes generated by FONT.
3982 FONT is a font name, a font-spec, a font-entity, or a font-object.
3983 The return value is a list of the form
3985 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3987 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3988 compatible with `set-face-attribute'. Some of these key-attribute pairs
3989 may be omitted from the list if they are not specified by FONT.
3991 The optional argument FRAME specifies the frame that the face attributes
3992 are to be displayed on. If omitted, the selected frame is used. */)
3993 (Lisp_Object font
, Lisp_Object frame
)
3996 Lisp_Object plist
[10];
4001 frame
= selected_frame
;
4002 CHECK_LIVE_FRAME (frame
);
4007 int fontset
= fs_query_fontset (font
, 0);
4008 Lisp_Object name
= font
;
4010 font
= fontset_ascii (fontset
);
4011 font
= font_spec_from_name (name
);
4013 signal_error ("Invalid font name", name
);
4015 else if (! FONTP (font
))
4016 signal_error ("Invalid font object", font
);
4018 val
= AREF (font
, FONT_FAMILY_INDEX
);
4021 plist
[n
++] = QCfamily
;
4022 plist
[n
++] = SYMBOL_NAME (val
);
4025 val
= AREF (font
, FONT_SIZE_INDEX
);
4028 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4029 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4030 plist
[n
++] = QCheight
;
4031 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4033 else if (FLOATP (val
))
4035 plist
[n
++] = QCheight
;
4036 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4039 val
= FONT_WEIGHT_FOR_FACE (font
);
4042 plist
[n
++] = QCweight
;
4046 val
= FONT_SLANT_FOR_FACE (font
);
4049 plist
[n
++] = QCslant
;
4053 val
= FONT_WIDTH_FOR_FACE (font
);
4056 plist
[n
++] = QCwidth
;
4060 return Flist (n
, plist
);
4065 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4066 doc
: /* Set one property of FONT: give property KEY value VAL.
4067 FONT is a font-spec, a font-entity, or a font-object.
4069 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4070 accepted by the function `font-spec' (which see), VAL must be what
4071 allowed in `font-spec'.
4073 If FONT is a font-entity or a font-object, KEY must not be the one
4074 accepted by `font-spec'. */)
4075 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4079 idx
= get_font_prop_index (prop
);
4080 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4082 CHECK_FONT_SPEC (font
);
4083 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4087 if (EQ (prop
, QCname
)
4088 || EQ (prop
, QCscript
)
4089 || EQ (prop
, QClang
)
4090 || EQ (prop
, QCotf
))
4091 CHECK_FONT_SPEC (font
);
4094 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4099 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4100 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4101 Optional 2nd argument FRAME specifies the target frame.
4102 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4103 Optional 4th argument PREFER, if non-nil, is a font-spec to
4104 control the order of the returned list. Fonts are sorted by
4105 how close they are to PREFER. */)
4106 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4108 Lisp_Object vec
, list
;
4112 frame
= selected_frame
;
4113 CHECK_LIVE_FRAME (frame
);
4114 CHECK_FONT_SPEC (font_spec
);
4122 if (! NILP (prefer
))
4123 CHECK_FONT_SPEC (prefer
);
4125 list
= font_list_entities (frame
, font_spec
);
4128 if (NILP (XCDR (list
))
4129 && ASIZE (XCAR (list
)) == 1)
4130 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4132 if (! NILP (prefer
))
4133 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4135 vec
= font_vconcat_entity_vectors (list
);
4136 if (n
== 0 || n
>= ASIZE (vec
))
4138 Lisp_Object args
[2];
4142 list
= Fappend (2, args
);
4146 for (list
= Qnil
, n
--; n
>= 0; n
--)
4147 list
= Fcons (AREF (vec
, n
), list
);
4152 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4153 doc
: /* List available font families on the current frame.
4154 Optional argument FRAME, if non-nil, specifies the target frame. */)
4158 struct font_driver_list
*driver_list
;
4162 frame
= selected_frame
;
4163 CHECK_LIVE_FRAME (frame
);
4166 for (driver_list
= f
->font_driver_list
; driver_list
;
4167 driver_list
= driver_list
->next
)
4168 if (driver_list
->driver
->list_family
)
4170 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4171 Lisp_Object tail
= list
;
4173 for (; CONSP (val
); val
= XCDR (val
))
4174 if (NILP (Fmemq (XCAR (val
), tail
))
4175 && SYMBOLP (XCAR (val
)))
4176 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4181 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4182 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4183 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4184 (Lisp_Object font_spec
, Lisp_Object frame
)
4186 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4193 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4194 doc
: /* Return XLFD name of FONT.
4195 FONT is a font-spec, font-entity, or font-object.
4196 If the name is too long for XLFD (maximum 255 chars), return nil.
4197 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4198 the consecutive wildcards are folded into one. */)
4199 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4202 int namelen
, pixel_size
= 0;
4206 if (FONT_OBJECT_P (font
))
4208 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4210 if (STRINGP (font_name
)
4211 && SDATA (font_name
)[0] == '-')
4213 if (NILP (fold_wildcards
))
4215 strcpy (name
, SSDATA (font_name
));
4216 namelen
= SBYTES (font_name
);
4219 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4221 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4225 if (! NILP (fold_wildcards
))
4227 char *p0
= name
, *p1
;
4229 while ((p1
= strstr (p0
, "-*-*")))
4231 strcpy (p1
, p1
+ 2);
4237 return make_string (name
, namelen
);
4240 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4241 doc
: /* Clear font cache. */)
4244 Lisp_Object list
, frame
;
4246 FOR_EACH_FRAME (list
, frame
)
4248 FRAME_PTR f
= XFRAME (frame
);
4249 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4251 for (; driver_list
; driver_list
= driver_list
->next
)
4252 if (driver_list
->on
)
4254 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4255 Lisp_Object val
, tmp
;
4259 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4261 eassert (! NILP (val
));
4262 tmp
= XCDR (XCAR (val
));
4263 if (XINT (XCAR (tmp
)) == 0)
4265 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4266 XSETCDR (cache
, XCDR (val
));
4276 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4278 struct font
*font
= XFONT_OBJECT (font_object
);
4279 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4280 struct font_metrics metrics
;
4282 LGLYPH_SET_CODE (glyph
, code
);
4283 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4284 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4285 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4286 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4287 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4288 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4292 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4293 doc
: /* Shape the glyph-string GSTRING.
4294 Shaping means substituting glyphs and/or adjusting positions of glyphs
4295 to get the correct visual image of character sequences set in the
4296 header of the glyph-string.
4298 If the shaping was successful, the value is GSTRING itself or a newly
4299 created glyph-string. Otherwise, the value is nil. */)
4300 (Lisp_Object gstring
)
4303 Lisp_Object font_object
, n
, glyph
;
4304 ptrdiff_t i
, j
, from
, to
;
4306 if (! composition_gstring_p (gstring
))
4307 signal_error ("Invalid glyph-string: ", gstring
);
4308 if (! NILP (LGSTRING_ID (gstring
)))
4310 font_object
= LGSTRING_FONT (gstring
);
4311 CHECK_FONT_OBJECT (font_object
);
4312 font
= XFONT_OBJECT (font_object
);
4313 if (! font
->driver
->shape
)
4316 /* Try at most three times with larger gstring each time. */
4317 for (i
= 0; i
< 3; i
++)
4319 n
= font
->driver
->shape (gstring
);
4322 gstring
= larger_vector (gstring
,
4323 LGSTRING_GLYPH_LEN (gstring
), -1);
4325 if (i
== 3 || XINT (n
) == 0)
4327 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4328 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4330 glyph
= LGSTRING_GLYPH (gstring
, 0);
4331 from
= LGLYPH_FROM (glyph
);
4332 to
= LGLYPH_TO (glyph
);
4333 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4335 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4339 if (NILP (LGLYPH_ADJUSTMENT (this)))
4344 glyph
= LGSTRING_GLYPH (gstring
, j
);
4345 LGLYPH_SET_FROM (glyph
, from
);
4346 LGLYPH_SET_TO (glyph
, to
);
4348 from
= LGLYPH_FROM (this);
4349 to
= LGLYPH_TO (this);
4354 if (from
> LGLYPH_FROM (this))
4355 from
= LGLYPH_FROM (this);
4356 if (to
< LGLYPH_TO (this))
4357 to
= LGLYPH_TO (this);
4363 glyph
= LGSTRING_GLYPH (gstring
, j
);
4364 LGLYPH_SET_FROM (glyph
, from
);
4365 LGLYPH_SET_TO (glyph
, to
);
4367 return composition_gstring_put_cache (gstring
, XINT (n
));
4370 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4372 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4373 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4375 VARIATION-SELECTOR is a character code of variation selection
4376 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4377 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4378 (Lisp_Object font_object
, Lisp_Object character
)
4380 unsigned variations
[256];
4385 CHECK_FONT_OBJECT (font_object
);
4386 CHECK_CHARACTER (character
);
4387 font
= XFONT_OBJECT (font_object
);
4388 if (! font
->driver
->get_variation_glyphs
)
4390 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4394 for (i
= 0; i
< 255; i
++)
4397 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4398 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4399 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4406 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4407 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4408 OTF-FEATURES specifies which features to apply in this format:
4409 (SCRIPT LANGSYS GSUB GPOS)
4411 SCRIPT is a symbol specifying a script tag of OpenType,
4412 LANGSYS is a symbol specifying a langsys tag of OpenType,
4413 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4415 If LANGYS is nil, the default langsys is selected.
4417 The features are applied in the order they appear in the list. The
4418 symbol `*' means to apply all available features not present in this
4419 list, and the remaining features are ignored. For instance, (vatu
4420 pstf * haln) is to apply vatu and pstf in this order, then to apply
4421 all available features other than vatu, pstf, and haln.
4423 The features are applied to the glyphs in the range FROM and TO of
4424 the glyph-string GSTRING-IN.
4426 If some feature is actually applicable, the resulting glyphs are
4427 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4428 this case, the value is the number of produced glyphs.
4430 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4433 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4434 produced in GSTRING-OUT, and the value is nil.
4436 See the documentation of `composition-get-gstring' for the format of
4438 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4440 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4445 check_otf_features (otf_features
);
4446 CHECK_FONT_OBJECT (font_object
);
4447 font
= XFONT_OBJECT (font_object
);
4448 if (! font
->driver
->otf_drive
)
4449 error ("Font backend %s can't drive OpenType GSUB table",
4450 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4451 CHECK_CONS (otf_features
);
4452 CHECK_SYMBOL (XCAR (otf_features
));
4453 val
= XCDR (otf_features
);
4454 CHECK_SYMBOL (XCAR (val
));
4455 val
= XCDR (otf_features
);
4458 len
= check_gstring (gstring_in
);
4459 CHECK_VECTOR (gstring_out
);
4460 CHECK_NATNUM (from
);
4462 CHECK_NATNUM (index
);
4464 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4465 args_out_of_range_3 (from
, to
, make_number (len
));
4466 if (XINT (index
) >= ASIZE (gstring_out
))
4467 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4468 num
= font
->driver
->otf_drive (font
, otf_features
,
4469 gstring_in
, XINT (from
), XINT (to
),
4470 gstring_out
, XINT (index
), 0);
4473 return make_number (num
);
4476 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4478 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4479 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4481 (SCRIPT LANGSYS FEATURE ...)
4482 See the documentation of `font-drive-otf' for more detail.
4484 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4485 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4486 character code corresponding to the glyph or nil if there's no
4487 corresponding character. */)
4488 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4491 Lisp_Object gstring_in
, gstring_out
, g
;
4492 Lisp_Object alternates
;
4495 CHECK_FONT_GET_OBJECT (font_object
, font
);
4496 if (! font
->driver
->otf_drive
)
4497 error ("Font backend %s can't drive OpenType GSUB table",
4498 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4499 CHECK_CHARACTER (character
);
4500 CHECK_CONS (otf_features
);
4502 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4503 g
= LGSTRING_GLYPH (gstring_in
, 0);
4504 LGLYPH_SET_CHAR (g
, XINT (character
));
4505 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4506 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4507 gstring_out
, 0, 1)) < 0)
4508 gstring_out
= Ffont_make_gstring (font_object
,
4509 make_number (ASIZE (gstring_out
) * 2));
4511 for (i
= 0; i
< num
; i
++)
4513 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4514 int c
= LGLYPH_CHAR (g
);
4515 unsigned code
= LGLYPH_CODE (g
);
4517 alternates
= Fcons (Fcons (make_number (code
),
4518 c
> 0 ? make_number (c
) : Qnil
),
4521 return Fnreverse (alternates
);
4527 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4528 doc
: /* Open FONT-ENTITY. */)
4529 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4533 CHECK_FONT_ENTITY (font_entity
);
4535 frame
= selected_frame
;
4536 CHECK_LIVE_FRAME (frame
);
4539 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4542 CHECK_NUMBER_OR_FLOAT (size
);
4544 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4546 isize
= XINT (size
);
4547 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4548 args_out_of_range (font_entity
, size
);
4552 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4555 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4556 doc
: /* Close FONT-OBJECT. */)
4557 (Lisp_Object font_object
, Lisp_Object frame
)
4559 CHECK_FONT_OBJECT (font_object
);
4561 frame
= selected_frame
;
4562 CHECK_LIVE_FRAME (frame
);
4563 font_close_object (XFRAME (frame
), font_object
);
4567 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4568 doc
: /* Return information about FONT-OBJECT.
4569 The value is a vector:
4570 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4573 NAME is the font name, a string (or nil if the font backend doesn't
4576 FILENAME is the font file name, a string (or nil if the font backend
4577 doesn't provide a file name).
4579 PIXEL-SIZE is a pixel size by which the font is opened.
4581 SIZE is a maximum advance width of the font in pixels.
4583 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4586 CAPABILITY is a list whose first element is a symbol representing the
4587 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4588 remaining elements describe the details of the font capability.
4590 If the font is OpenType font, the form of the list is
4591 \(opentype GSUB GPOS)
4592 where GSUB shows which "GSUB" features the font supports, and GPOS
4593 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4594 lists of the format:
4595 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4597 If the font is not OpenType font, currently the length of the form is
4600 SCRIPT is a symbol representing OpenType script tag.
4602 LANGSYS is a symbol representing OpenType langsys tag, or nil
4603 representing the default langsys.
4605 FEATURE is a symbol representing OpenType feature tag.
4607 If the font is not OpenType font, CAPABILITY is nil. */)
4608 (Lisp_Object font_object
)
4613 CHECK_FONT_GET_OBJECT (font_object
, font
);
4615 val
= Fmake_vector (make_number (9), Qnil
);
4616 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4617 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4618 ASET (val
, 2, make_number (font
->pixel_size
));
4619 ASET (val
, 3, make_number (font
->max_width
));
4620 ASET (val
, 4, make_number (font
->ascent
));
4621 ASET (val
, 5, make_number (font
->descent
));
4622 ASET (val
, 6, make_number (font
->space_width
));
4623 ASET (val
, 7, make_number (font
->average_width
));
4624 if (font
->driver
->otf_capability
)
4625 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4629 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4631 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4632 FROM and TO are positions (integers or markers) specifying a region
4633 of the current buffer.
4634 If the optional fourth arg OBJECT is not nil, it is a string or a
4635 vector containing the target characters.
4637 Each element is a vector containing information of a glyph in this format:
4638 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4640 FROM is an index numbers of a character the glyph corresponds to.
4641 TO is the same as FROM.
4642 C is the character of the glyph.
4643 CODE is the glyph-code of C in FONT-OBJECT.
4644 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4645 ADJUSTMENT is always nil.
4646 If FONT-OBJECT doesn't have a glyph for a character,
4647 the corresponding element is nil. */)
4648 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4653 Lisp_Object
*chars
, vec
;
4656 CHECK_FONT_GET_OBJECT (font_object
, font
);
4659 ptrdiff_t charpos
, bytepos
;
4661 validate_region (&from
, &to
);
4664 len
= XFASTINT (to
) - XFASTINT (from
);
4665 SAFE_ALLOCA_LISP (chars
, len
);
4666 charpos
= XFASTINT (from
);
4667 bytepos
= CHAR_TO_BYTE (charpos
);
4668 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4671 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4672 chars
[i
] = make_number (c
);
4675 else if (STRINGP (object
))
4677 const unsigned char *p
;
4679 CHECK_NUMBER (from
);
4681 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4682 || XINT (to
) > SCHARS (object
))
4683 args_out_of_range_3 (object
, from
, to
);
4686 len
= XFASTINT (to
) - XFASTINT (from
);
4687 SAFE_ALLOCA_LISP (chars
, len
);
4689 if (STRING_MULTIBYTE (object
))
4690 for (i
= 0; i
< len
; i
++)
4692 int c
= STRING_CHAR_ADVANCE (p
);
4693 chars
[i
] = make_number (c
);
4696 for (i
= 0; i
< len
; i
++)
4697 chars
[i
] = make_number (p
[i
]);
4701 CHECK_VECTOR (object
);
4702 CHECK_NUMBER (from
);
4704 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4705 || XINT (to
) > ASIZE (object
))
4706 args_out_of_range_3 (object
, from
, to
);
4709 len
= XFASTINT (to
) - XFASTINT (from
);
4710 for (i
= 0; i
< len
; i
++)
4712 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4713 CHECK_CHARACTER (elt
);
4715 chars
= aref_addr (object
, XFASTINT (from
));
4718 vec
= Fmake_vector (make_number (len
), Qnil
);
4719 for (i
= 0; i
< len
; i
++)
4722 int c
= XFASTINT (chars
[i
]);
4724 struct font_metrics metrics
;
4726 code
= font
->driver
->encode_char (font
, c
);
4727 if (code
== FONT_INVALID_CODE
)
4729 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4730 LGLYPH_SET_FROM (g
, i
);
4731 LGLYPH_SET_TO (g
, i
);
4732 LGLYPH_SET_CHAR (g
, c
);
4733 LGLYPH_SET_CODE (g
, code
);
4734 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4735 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4736 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4737 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4738 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4739 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4742 if (! VECTORP (object
))
4747 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4748 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4749 FONT is a font-spec, font-entity, or font-object. */)
4750 (Lisp_Object spec
, Lisp_Object font
)
4752 CHECK_FONT_SPEC (spec
);
4755 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4758 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4759 doc
: /* Return a font-object for displaying a character at POSITION.
4760 Optional second arg WINDOW, if non-nil, is a window displaying
4761 the current buffer. It defaults to the currently selected window. */)
4762 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4769 CHECK_NUMBER_COERCE_MARKER (position
);
4770 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4771 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4772 pos
= XINT (position
);
4776 CHECK_NUMBER (position
);
4777 CHECK_STRING (string
);
4778 if (! (0 < XINT (position
) && XINT (position
) < SCHARS (string
)))
4779 args_out_of_range (string
, position
);
4780 pos
= XINT (position
);
4783 window
= selected_window
;
4784 CHECK_LIVE_WINDOW (window
);
4785 w
= XWINDOW (window
);
4787 return font_at (-1, pos
, NULL
, w
, string
);
4791 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4792 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4793 The value is a number of glyphs drawn.
4794 Type C-l to recover what previously shown. */)
4795 (Lisp_Object font_object
, Lisp_Object string
)
4797 Lisp_Object frame
= selected_frame
;
4798 FRAME_PTR f
= XFRAME (frame
);
4804 CHECK_FONT_GET_OBJECT (font_object
, font
);
4805 CHECK_STRING (string
);
4806 len
= SCHARS (string
);
4807 code
= alloca (sizeof (unsigned) * len
);
4808 for (i
= 0; i
< len
; i
++)
4810 Lisp_Object ch
= Faref (string
, make_number (i
));
4814 code
[i
] = font
->driver
->encode_char (font
, c
);
4815 if (code
[i
] == FONT_INVALID_CODE
)
4818 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4820 if (font
->driver
->prepare_face
)
4821 font
->driver
->prepare_face (f
, face
);
4822 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4823 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4824 if (font
->driver
->done_face
)
4825 font
->driver
->done_face (f
, face
);
4827 return make_number (len
);
4831 #endif /* FONT_DEBUG */
4833 #ifdef HAVE_WINDOW_SYSTEM
4835 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4836 doc
: /* Return information about a font named NAME on frame FRAME.
4837 If FRAME is omitted or nil, use the selected frame.
4838 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4839 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4841 OPENED-NAME is the name used for opening the font,
4842 FULL-NAME is the full name of the font,
4843 SIZE is the pixelsize of the font,
4844 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4845 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4846 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4847 how to compose characters.
4848 If the named font is not yet loaded, return nil. */)
4849 (Lisp_Object name
, Lisp_Object frame
)
4854 Lisp_Object font_object
;
4856 (*check_window_system_func
) ();
4859 CHECK_STRING (name
);
4861 frame
= selected_frame
;
4862 CHECK_LIVE_FRAME (frame
);
4867 int fontset
= fs_query_fontset (name
, 0);
4870 name
= fontset_ascii (fontset
);
4871 font_object
= font_open_by_name (f
, name
);
4873 else if (FONT_OBJECT_P (name
))
4875 else if (FONT_ENTITY_P (name
))
4876 font_object
= font_open_entity (f
, name
, 0);
4879 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4880 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4882 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4884 if (NILP (font_object
))
4886 font
= XFONT_OBJECT (font_object
);
4888 info
= Fmake_vector (make_number (7), Qnil
);
4889 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4890 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4891 ASET (info
, 2, make_number (font
->pixel_size
));
4892 ASET (info
, 3, make_number (font
->height
));
4893 ASET (info
, 4, make_number (font
->baseline_offset
));
4894 ASET (info
, 5, make_number (font
->relative_compose
));
4895 ASET (info
, 6, make_number (font
->default_ascent
));
4898 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4899 close it now. Perhaps, we should manage font-objects
4900 by `reference-count'. */
4901 font_close_object (f
, font_object
);
4908 #define BUILD_STYLE_TABLE(TBL) \
4909 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4912 build_style_table (const struct table_entry
*entry
, int nelement
)
4915 Lisp_Object table
, elt
;
4917 table
= Fmake_vector (make_number (nelement
), Qnil
);
4918 for (i
= 0; i
< nelement
; i
++)
4920 for (j
= 0; entry
[i
].names
[j
]; j
++);
4921 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4922 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4923 for (j
= 0; entry
[i
].names
[j
]; j
++)
4924 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4925 ASET (table
, i
, elt
);
4930 /* The deferred font-log data of the form [ACTION ARG RESULT].
4931 If ACTION is not nil, that is added to the log when font_add_log is
4932 called next time. At that time, ACTION is set back to nil. */
4933 static Lisp_Object Vfont_log_deferred
;
4935 /* Prepend the font-related logging data in Vfont_log if it is not
4936 `t'. ACTION describes a kind of font-related action (e.g. listing,
4937 opening), ARG is the argument for the action, and RESULT is the
4938 result of the action. */
4940 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4945 if (EQ (Vfont_log
, Qt
))
4947 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4949 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4951 ASET (Vfont_log_deferred
, 0, Qnil
);
4952 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4953 AREF (Vfont_log_deferred
, 2));
4958 Lisp_Object tail
, elt
;
4959 Lisp_Object equalstr
= build_string ("=");
4961 val
= Ffont_xlfd_name (arg
, Qt
);
4962 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4966 if (EQ (XCAR (elt
), QCscript
)
4967 && SYMBOLP (XCDR (elt
)))
4968 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4969 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4970 else if (EQ (XCAR (elt
), QClang
)
4971 && SYMBOLP (XCDR (elt
)))
4972 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4973 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4974 else if (EQ (XCAR (elt
), QCotf
)
4975 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4976 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4978 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4984 && VECTORP (XCAR (result
))
4985 && ASIZE (XCAR (result
)) > 0
4986 && FONTP (AREF (XCAR (result
), 0)))
4987 result
= font_vconcat_entity_vectors (result
);
4990 val
= Ffont_xlfd_name (result
, Qt
);
4991 if (! FONT_SPEC_P (result
))
4992 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4993 build_string (":"), val
);
4996 else if (CONSP (result
))
4999 result
= Fcopy_sequence (result
);
5000 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5004 val
= Ffont_xlfd_name (val
, Qt
);
5005 XSETCAR (tail
, val
);
5008 else if (VECTORP (result
))
5010 result
= Fcopy_sequence (result
);
5011 for (i
= 0; i
< ASIZE (result
); i
++)
5013 val
= AREF (result
, i
);
5015 val
= Ffont_xlfd_name (val
, Qt
);
5016 ASET (result
, i
, val
);
5019 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5022 /* Record a font-related logging data to be added to Vfont_log when
5023 font_add_log is called next time. ACTION, ARG, RESULT are the same
5027 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5029 if (EQ (Vfont_log
, Qt
))
5031 ASET (Vfont_log_deferred
, 0, build_string (action
));
5032 ASET (Vfont_log_deferred
, 1, arg
);
5033 ASET (Vfont_log_deferred
, 2, result
);
5039 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5040 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5041 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5042 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5043 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5044 /* Note that the other elements in sort_shift_bits are not used. */
5046 staticpro (&font_charset_alist
);
5047 font_charset_alist
= Qnil
;
5049 DEFSYM (Qopentype
, "opentype");
5051 DEFSYM (Qascii_0
, "ascii-0");
5052 DEFSYM (Qiso8859_1
, "iso8859-1");
5053 DEFSYM (Qiso10646_1
, "iso10646-1");
5054 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5055 DEFSYM (Qunicode_sip
, "unicode-sip");
5059 DEFSYM (QCotf
, ":otf");
5060 DEFSYM (QClang
, ":lang");
5061 DEFSYM (QCscript
, ":script");
5062 DEFSYM (QCantialias
, ":antialias");
5064 DEFSYM (QCfoundry
, ":foundry");
5065 DEFSYM (QCadstyle
, ":adstyle");
5066 DEFSYM (QCregistry
, ":registry");
5067 DEFSYM (QCspacing
, ":spacing");
5068 DEFSYM (QCdpi
, ":dpi");
5069 DEFSYM (QCscalable
, ":scalable");
5070 DEFSYM (QCavgwidth
, ":avgwidth");
5071 DEFSYM (QCfont_entity
, ":font-entity");
5072 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5082 DEFSYM (QCuser_spec
, "user-spec");
5084 staticpro (&scratch_font_spec
);
5085 scratch_font_spec
= Ffont_spec (0, NULL
);
5086 staticpro (&scratch_font_prefer
);
5087 scratch_font_prefer
= Ffont_spec (0, NULL
);
5089 staticpro (&Vfont_log_deferred
);
5090 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5094 staticpro (&otf_list
);
5096 #endif /* HAVE_LIBOTF */
5100 defsubr (&Sfont_spec
);
5101 defsubr (&Sfont_get
);
5102 #ifdef HAVE_WINDOW_SYSTEM
5103 defsubr (&Sfont_face_attributes
);
5105 defsubr (&Sfont_put
);
5106 defsubr (&Slist_fonts
);
5107 defsubr (&Sfont_family_list
);
5108 defsubr (&Sfind_font
);
5109 defsubr (&Sfont_xlfd_name
);
5110 defsubr (&Sclear_font_cache
);
5111 defsubr (&Sfont_shape_gstring
);
5112 defsubr (&Sfont_variation_glyphs
);
5114 defsubr (&Sfont_drive_otf
);
5115 defsubr (&Sfont_otf_alternates
);
5119 defsubr (&Sopen_font
);
5120 defsubr (&Sclose_font
);
5121 defsubr (&Squery_font
);
5122 defsubr (&Sfont_get_glyphs
);
5123 defsubr (&Sfont_match_p
);
5124 defsubr (&Sfont_at
);
5126 defsubr (&Sdraw_string
);
5128 #endif /* FONT_DEBUG */
5129 #ifdef HAVE_WINDOW_SYSTEM
5130 defsubr (&Sfont_info
);
5133 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5135 Alist of fontname patterns vs the corresponding encoding and repertory info.
5136 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5137 where ENCODING is a charset or a char-table,
5138 and REPERTORY is a charset, a char-table, or nil.
5140 If ENCODING and REPERTORY are the same, the element can have the form
5141 \(REGEXP . ENCODING).
5143 ENCODING is for converting a character to a glyph code of the font.
5144 If ENCODING is a charset, encoding a character by the charset gives
5145 the corresponding glyph code. If ENCODING is a char-table, looking up
5146 the table by a character gives the corresponding glyph code.
5148 REPERTORY specifies a repertory of characters supported by the font.
5149 If REPERTORY is a charset, all characters belonging to the charset are
5150 supported. If REPERTORY is a char-table, all characters who have a
5151 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5152 gets the repertory information by an opened font and ENCODING. */);
5153 Vfont_encoding_alist
= Qnil
;
5155 /* FIXME: These 3 vars are not quite what they appear: setq on them
5156 won't have any effect other than disconnect them from the style
5157 table used by the font display code. So we make them read-only,
5158 to avoid this confusing situation. */
5160 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5161 doc
: /* Vector of valid font weight values.
5162 Each element has the form:
5163 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5164 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5165 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5166 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5168 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5169 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5170 See `font-weight-table' for the format of the vector. */);
5171 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5172 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5174 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5175 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5176 See `font-weight-table' for the format of the vector. */);
5177 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5178 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5180 staticpro (&font_style_table
);
5181 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5182 ASET (font_style_table
, 0, Vfont_weight_table
);
5183 ASET (font_style_table
, 1, Vfont_slant_table
);
5184 ASET (font_style_table
, 2, Vfont_width_table
);
5186 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5187 *Logging list of font related actions and results.
5188 The value t means to suppress the logging.
5189 The initial value is set to nil if the environment variable
5190 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5193 #ifdef HAVE_WINDOW_SYSTEM
5194 #ifdef HAVE_FREETYPE
5196 #ifdef HAVE_X_WINDOWS
5201 #endif /* HAVE_XFT */
5202 #endif /* HAVE_X_WINDOWS */
5203 #else /* not HAVE_FREETYPE */
5204 #ifdef HAVE_X_WINDOWS
5206 #endif /* HAVE_X_WINDOWS */
5207 #endif /* not HAVE_FREETYPE */
5210 #endif /* HAVE_BDFFONT */
5213 #endif /* WINDOWSNT */
5216 #endif /* HAVE_NS */
5217 #endif /* HAVE_WINDOW_SYSTEM */
5223 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;