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"
43 #endif /* HAVE_X_WINDOWS */
47 #endif /* HAVE_NTGUI */
53 Lisp_Object Qopentype
;
55 /* Important character set strings. */
56 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
58 #define DEFAULT_ENCODING Qiso8859_1
60 /* Unicode category `Cf'. */
61 static Lisp_Object QCf
;
63 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
64 static Lisp_Object font_style_table
;
66 /* Structure used for tables mapping weight, slant, and width numeric
67 values and their names. */
72 /* The first one is a valid name as a face attribute.
73 The second one (if any) is a typical name in XLFD field. */
77 /* Table of weight numeric values and their names. This table must be
78 sorted by numeric values in ascending order. */
80 static const struct table_entry weight_table
[] =
83 { 20, { "ultra-light", "ultralight" }},
84 { 40, { "extra-light", "extralight" }},
86 { 75, { "semi-light", "semilight", "demilight", "book" }},
87 { 100, { "normal", "medium", "regular", "unspecified" }},
88 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
90 { 205, { "extra-bold", "extrabold" }},
91 { 210, { "ultra-bold", "ultrabold", "black" }}
94 /* Table of slant numeric values and their names. This table must be
95 sorted by numeric values in ascending order. */
97 static const struct table_entry slant_table
[] =
99 { 0, { "reverse-oblique", "ro" }},
100 { 10, { "reverse-italic", "ri" }},
101 { 100, { "normal", "r", "unspecified" }},
102 { 200, { "italic" ,"i", "ot" }},
103 { 210, { "oblique", "o" }}
106 /* Table of width numeric values and their names. This table must be
107 sorted by numeric values in ascending order. */
109 static const struct table_entry width_table
[] =
111 { 50, { "ultra-condensed", "ultracondensed" }},
112 { 63, { "extra-condensed", "extracondensed" }},
113 { 75, { "condensed", "compressed", "narrow" }},
114 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
115 { 100, { "normal", "medium", "regular", "unspecified" }},
116 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
117 { 125, { "expanded" }},
118 { 150, { "extra-expanded", "extraexpanded" }},
119 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
122 Lisp_Object QCfoundry
;
123 static Lisp_Object QCadstyle
, QCregistry
;
124 /* Symbols representing keys of font extra info. */
125 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
126 Lisp_Object QCantialias
, QCfont_entity
;
127 static Lisp_Object QCfc_unknown_spec
;
128 /* Symbols representing values of font spacing property. */
129 static Lisp_Object Qc
, Qm
, Qd
;
131 /* Special ADSTYLE properties to avoid fonts used for Latin
132 characters; used in xfont.c and ftfont.c. */
133 Lisp_Object Qja
, Qko
;
135 static Lisp_Object QCuser_spec
;
137 /* Alist of font registry symbols and the corresponding charset
138 information. The information is retrieved from
139 Vfont_encoding_alist on demand.
141 Eash element has the form:
142 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
146 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
147 encodes a character code to a glyph code of a font, and
148 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
149 character is supported by a font.
151 The latter form means that the information for REGISTRY couldn't be
153 static Lisp_Object font_charset_alist
;
155 /* List of all font drivers. Each font-backend (XXXfont.c) calls
156 register_font_driver in syms_of_XXXfont to register its font-driver
158 static struct font_driver_list
*font_driver_list
;
162 /* Creators of font-related Lisp object. */
165 font_make_spec (void)
167 Lisp_Object font_spec
;
168 struct font_spec
*spec
169 = ((struct font_spec
*)
170 allocate_pseudovector (VECSIZE (struct font_spec
),
171 FONT_SPEC_MAX
, PVEC_FONT
));
172 XSETFONT (font_spec
, spec
);
177 font_make_entity (void)
179 Lisp_Object font_entity
;
180 struct font_entity
*entity
181 = ((struct font_entity
*)
182 allocate_pseudovector (VECSIZE (struct font_entity
),
183 FONT_ENTITY_MAX
, PVEC_FONT
));
184 XSETFONT (font_entity
, entity
);
188 /* Create a font-object whose structure size is SIZE. If ENTITY is
189 not nil, copy properties from ENTITY to the font-object. If
190 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
192 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
194 Lisp_Object font_object
;
196 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
199 XSETFONT (font_object
, font
);
203 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
204 font
->props
[i
] = AREF (entity
, i
);
205 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
206 font
->props
[FONT_EXTRA_INDEX
]
207 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
210 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
216 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
217 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
218 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
220 static unsigned font_encode_char (Lisp_Object
, int);
222 /* Number of registered font drivers. */
223 static int num_font_drivers
;
226 /* Return a Lispy value of a font property value at STR and LEN bytes.
227 If STR is "*", return nil.
228 If FORCE_SYMBOL is zero and all characters in STR are digits,
229 return an integer. Otherwise, return a symbol interned from
233 font_intern_prop (const char *str
, ptrdiff_t len
, int force_symbol
)
238 ptrdiff_t nbytes
, nchars
;
240 if (len
== 1 && *str
== '*')
242 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
244 for (i
= 1; i
< len
; i
++)
245 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
252 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
255 return make_number (n
);
256 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
260 xsignal1 (Qoverflow_error
, make_string (str
, len
));
264 /* This code is similar to intern function from lread.c. */
265 obarray
= check_obarray (Vobarray
);
266 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
267 tem
= oblookup (obarray
, str
,
268 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
272 if (len
== nchars
|| len
!= nbytes
)
273 tem
= make_unibyte_string (str
, len
);
275 tem
= make_multibyte_string (str
, nchars
, len
);
276 return Fintern (tem
, obarray
);
279 /* Return a pixel size of font-spec SPEC on frame F. */
282 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
284 #ifdef HAVE_WINDOW_SYSTEM
285 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
294 eassert (FLOATP (size
));
295 point_size
= XFLOAT_DATA (size
);
296 val
= AREF (spec
, FONT_DPI_INDEX
);
301 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
309 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
310 font vector. If VAL is not valid (i.e. not registered in
311 font_style_table), return -1 if NOERROR is zero, and return a
312 proper index if NOERROR is nonzero. In that case, register VAL in
313 font_style_table if VAL is a symbol, and return the closest index if
314 VAL is an integer. */
317 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
319 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
322 CHECK_VECTOR (table
);
329 Lisp_Object args
[2], elt
;
331 /* At first try exact match. */
332 for (i
= 0; i
< len
; i
++)
334 CHECK_VECTOR (AREF (table
, i
));
335 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
336 if (EQ (val
, AREF (AREF (table
, i
), j
)))
338 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
339 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
340 | (i
<< 4) | (j
- 1));
343 /* Try also with case-folding match. */
344 s
= SSDATA (SYMBOL_NAME (val
));
345 for (i
= 0; i
< len
; i
++)
346 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
348 elt
= AREF (AREF (table
, i
), j
);
349 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
351 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
352 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
353 | (i
<< 4) | (j
- 1));
359 elt
= Fmake_vector (make_number (2), make_number (100));
362 args
[1] = Fmake_vector (make_number (1), elt
);
363 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
364 return (100 << 8) | (i
<< 4);
369 EMACS_INT numeric
= XINT (val
);
371 for (i
= 0, last_n
= -1; i
< len
; i
++)
375 CHECK_VECTOR (AREF (table
, i
));
376 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
377 n
= XINT (AREF (AREF (table
, i
), 0));
379 return (n
<< 8) | (i
<< 4);
384 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
385 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
391 return ((last_n
<< 8) | ((i
- 1) << 4));
396 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
398 Lisp_Object val
= AREF (font
, prop
);
399 Lisp_Object table
, elt
;
404 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
405 CHECK_VECTOR (table
);
406 i
= XINT (val
) & 0xFF;
407 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
408 elt
= AREF (table
, ((i
>> 4) & 0xF));
410 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
411 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
416 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
417 FONTNAME. ENCODING is a charset symbol that specifies the encoding
418 of the font. REPERTORY is a charset symbol or nil. */
421 find_font_encoding (Lisp_Object fontname
)
423 Lisp_Object tail
, elt
;
425 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
429 && STRINGP (XCAR (elt
))
430 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
431 && (SYMBOLP (XCDR (elt
))
432 ? CHARSETP (XCDR (elt
))
433 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
439 /* Return encoding charset and repertory charset for REGISTRY in
440 ENCODING and REPERTORY correspondingly. If correct information for
441 REGISTRY is available, return 0. Otherwise return -1. */
444 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
447 int encoding_id
, repertory_id
;
449 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
455 encoding_id
= XINT (XCAR (val
));
456 repertory_id
= XINT (XCDR (val
));
460 val
= find_font_encoding (SYMBOL_NAME (registry
));
461 if (SYMBOLP (val
) && CHARSETP (val
))
463 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
465 else if (CONSP (val
))
467 if (! CHARSETP (XCAR (val
)))
469 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
470 if (NILP (XCDR (val
)))
474 if (! CHARSETP (XCDR (val
)))
476 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
481 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
483 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
487 *encoding
= CHARSET_FROM_ID (encoding_id
);
489 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
494 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
499 /* Font property value validators. See the comment of
500 font_property_table for the meaning of the arguments. */
502 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
503 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
504 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
505 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
506 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
507 static int get_font_prop_index (Lisp_Object
);
510 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
513 val
= Fintern (val
, Qnil
);
516 else if (EQ (prop
, QCregistry
))
517 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
523 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
525 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
526 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
530 EMACS_INT n
= XINT (val
);
531 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
533 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
537 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
540 if ((n
& 0xF) + 1 >= ASIZE (elt
))
544 CHECK_NUMBER (AREF (elt
, 0));
545 if (XINT (AREF (elt
, 0)) != (n
>> 8))
550 else if (SYMBOLP (val
))
552 int n
= font_style_to_value (prop
, val
, 0);
554 val
= n
>= 0 ? make_number (n
) : Qerror
;
562 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
564 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
569 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
571 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
573 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
575 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
577 if (spacing
== 'c' || spacing
== 'C')
578 return make_number (FONT_SPACING_CHARCELL
);
579 if (spacing
== 'm' || spacing
== 'M')
580 return make_number (FONT_SPACING_MONO
);
581 if (spacing
== 'p' || spacing
== 'P')
582 return make_number (FONT_SPACING_PROPORTIONAL
);
583 if (spacing
== 'd' || spacing
== 'D')
584 return make_number (FONT_SPACING_DUAL
);
590 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
592 Lisp_Object tail
, tmp
;
595 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
596 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
597 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
600 if (! SYMBOLP (XCAR (val
)))
605 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
607 for (i
= 0; i
< 2; i
++)
614 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
615 if (! SYMBOLP (XCAR (tmp
)))
623 /* Structure of known font property keys and validator of the
627 /* Pointer to the key symbol. */
629 /* Function to validate PROP's value VAL, or NULL if any value is
630 ok. The value is VAL or its regularized value if VAL is valid,
631 and Qerror if not. */
632 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
633 } font_property_table
[] =
634 { { &QCtype
, font_prop_validate_symbol
},
635 { &QCfoundry
, font_prop_validate_symbol
},
636 { &QCfamily
, font_prop_validate_symbol
},
637 { &QCadstyle
, font_prop_validate_symbol
},
638 { &QCregistry
, font_prop_validate_symbol
},
639 { &QCweight
, font_prop_validate_style
},
640 { &QCslant
, font_prop_validate_style
},
641 { &QCwidth
, font_prop_validate_style
},
642 { &QCsize
, font_prop_validate_non_neg
},
643 { &QCdpi
, font_prop_validate_non_neg
},
644 { &QCspacing
, font_prop_validate_spacing
},
645 { &QCavgwidth
, font_prop_validate_non_neg
},
646 /* The order of the above entries must match with enum
647 font_property_index. */
648 { &QClang
, font_prop_validate_symbol
},
649 { &QCscript
, font_prop_validate_symbol
},
650 { &QCotf
, font_prop_validate_otf
}
653 /* Size (number of elements) of the above table. */
654 #define FONT_PROPERTY_TABLE_SIZE \
655 ((sizeof font_property_table) / (sizeof *font_property_table))
657 /* Return an index number of font property KEY or -1 if KEY is not an
658 already known property. */
661 get_font_prop_index (Lisp_Object key
)
665 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
666 if (EQ (key
, *font_property_table
[i
].key
))
671 /* Validate the font property. The property key is specified by the
672 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
673 signal an error. The value is VAL or the regularized one. */
676 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
678 Lisp_Object validated
;
683 prop
= *font_property_table
[idx
].key
;
686 idx
= get_font_prop_index (prop
);
690 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
691 if (EQ (validated
, Qerror
))
692 signal_error ("invalid font property", Fcons (prop
, val
));
697 /* Store VAL as a value of extra font property PROP in FONT while
698 keeping the sorting order. Don't check the validity of VAL. */
701 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
703 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
704 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
708 Lisp_Object prev
= Qnil
;
711 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
712 prev
= extra
, extra
= XCDR (extra
);
715 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
717 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
723 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
728 /* Font name parser and unparser */
730 static int parse_matrix (const char *);
731 static int font_expand_wildcards (Lisp_Object
*, int);
732 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
734 /* An enumerator for each field of an XLFD font name. */
735 enum xlfd_field_index
754 /* An enumerator for mask bit corresponding to each XLFD field. */
757 XLFD_FOUNDRY_MASK
= 0x0001,
758 XLFD_FAMILY_MASK
= 0x0002,
759 XLFD_WEIGHT_MASK
= 0x0004,
760 XLFD_SLANT_MASK
= 0x0008,
761 XLFD_SWIDTH_MASK
= 0x0010,
762 XLFD_ADSTYLE_MASK
= 0x0020,
763 XLFD_PIXEL_MASK
= 0x0040,
764 XLFD_POINT_MASK
= 0x0080,
765 XLFD_RESX_MASK
= 0x0100,
766 XLFD_RESY_MASK
= 0x0200,
767 XLFD_SPACING_MASK
= 0x0400,
768 XLFD_AVGWIDTH_MASK
= 0x0800,
769 XLFD_REGISTRY_MASK
= 0x1000,
770 XLFD_ENCODING_MASK
= 0x2000
774 /* Parse P pointing to the pixel/point size field of the form
775 `[A B C D]' which specifies a transformation matrix:
781 by which all glyphs of the font are transformed. The spec says
782 that scalar value N for the pixel/point size is equivalent to:
783 A = N * resx/resy, B = C = 0, D = N.
785 Return the scalar value N if the form is valid. Otherwise return
789 parse_matrix (const char *p
)
795 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
798 matrix
[i
] = - strtod (p
+ 1, &end
);
800 matrix
[i
] = strtod (p
, &end
);
803 return (i
== 4 ? (int) matrix
[3] : -1);
806 /* Expand a wildcard field in FIELD (the first N fields are filled) to
807 multiple fields to fill in all 14 XLFD fields while restricting a
808 field position by its contents. */
811 font_expand_wildcards (Lisp_Object
*field
, int n
)
814 Lisp_Object tmp
[XLFD_LAST_INDEX
];
815 /* Array of information about where this element can go. Nth
816 element is for Nth element of FIELD. */
818 /* Minimum possible field. */
820 /* Maximum possible field. */
822 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
824 } range
[XLFD_LAST_INDEX
];
826 int range_from
, range_to
;
829 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
830 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
831 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
832 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
833 | XLFD_AVGWIDTH_MASK)
834 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
836 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
837 field. The value is shifted to left one bit by one in the
839 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
840 range_mask
= (range_mask
<< 1) | 1;
842 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
843 position-based restriction for FIELD[I]. */
844 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
845 i
++, range_from
++, range_to
++, range_mask
<<= 1)
847 Lisp_Object val
= field
[i
];
853 range
[i
].from
= range_from
;
854 range
[i
].to
= range_to
;
855 range
[i
].mask
= range_mask
;
859 /* The triplet FROM, TO, and MASK is a value-based
860 restriction for FIELD[I]. */
866 EMACS_INT numeric
= XINT (val
);
869 from
= to
= XLFD_ENCODING_INDEX
,
870 mask
= XLFD_ENCODING_MASK
;
871 else if (numeric
== 0)
872 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
873 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
874 else if (numeric
<= 48)
875 from
= to
= XLFD_PIXEL_INDEX
,
876 mask
= XLFD_PIXEL_MASK
;
878 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
879 mask
= XLFD_LARGENUM_MASK
;
881 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
882 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
883 mask
= XLFD_NULL_MASK
;
885 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
888 Lisp_Object name
= SYMBOL_NAME (val
);
890 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
891 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
892 mask
= XLFD_REGENC_MASK
;
894 from
= to
= XLFD_ENCODING_INDEX
,
895 mask
= XLFD_ENCODING_MASK
;
897 else if (range_from
<= XLFD_WEIGHT_INDEX
898 && range_to
>= XLFD_WEIGHT_INDEX
899 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
900 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
901 else if (range_from
<= XLFD_SLANT_INDEX
902 && range_to
>= XLFD_SLANT_INDEX
903 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
904 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
905 else if (range_from
<= XLFD_SWIDTH_INDEX
906 && range_to
>= XLFD_SWIDTH_INDEX
907 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
908 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
911 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
912 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
914 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
915 mask
= XLFD_SYMBOL_MASK
;
918 /* Merge position-based and value-based restrictions. */
920 while (from
< range_from
)
921 mask
&= ~(1 << from
++);
922 while (from
< 14 && ! (mask
& (1 << from
)))
924 while (to
> range_to
)
925 mask
&= ~(1 << to
--);
926 while (to
>= 0 && ! (mask
& (1 << to
)))
930 range
[i
].from
= from
;
932 range
[i
].mask
= mask
;
934 if (from
> range_from
|| to
< range_to
)
936 /* The range is narrowed by value-based restrictions.
937 Reflect it to the other fields. */
939 /* Following fields should be after FROM. */
941 /* Preceding fields should be before TO. */
942 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
944 /* Check FROM for non-wildcard field. */
945 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
947 while (range
[j
].from
< from
)
948 range
[j
].mask
&= ~(1 << range
[j
].from
++);
949 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
951 range
[j
].from
= from
;
954 from
= range
[j
].from
;
955 if (range
[j
].to
> to
)
957 while (range
[j
].to
> to
)
958 range
[j
].mask
&= ~(1 << range
[j
].to
--);
959 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
972 /* Decide all fields from restrictions in RANGE. */
973 for (i
= j
= 0; i
< n
; i
++)
975 if (j
< range
[i
].from
)
977 if (i
== 0 || ! NILP (tmp
[i
- 1]))
978 /* None of TMP[X] corresponds to Jth field. */
980 for (; j
< range
[i
].from
; j
++)
985 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
987 for (; j
< XLFD_LAST_INDEX
; j
++)
989 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
990 field
[XLFD_ENCODING_INDEX
]
991 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
996 /* Parse NAME (null terminated) as XLFD and store information in FONT
997 (font-spec or font-entity). Size property of FONT is set as
999 specified XLFD fields FONT property
1000 --------------------- -------------
1001 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1002 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1003 POINT_SIZE POINT_SIZE/10 (Lisp float)
1005 If NAME is successfully parsed, return 0. Otherwise return -1.
1007 FONT is usually a font-spec, but when this function is called from
1008 X font backend driver, it is a font-entity. In that case, NAME is
1009 a fully specified XLFD. */
1012 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1015 char *f
[XLFD_LAST_INDEX
+ 1];
1019 if (len
> 255 || !len
)
1020 /* Maximum XLFD name length is 255. */
1022 /* Accept "*-.." as a fully specified XLFD. */
1023 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1024 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1027 for (p
= name
+ i
; *p
; p
++)
1031 if (i
== XLFD_LAST_INDEX
)
1036 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1037 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1039 if (i
== XLFD_LAST_INDEX
)
1041 /* Fully specified XLFD. */
1044 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1045 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1046 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1047 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1049 val
= INTERN_FIELD_SYM (i
);
1052 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1054 ASET (font
, j
, make_number (n
));
1057 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1058 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1059 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1061 ASET (font
, FONT_REGISTRY_INDEX
,
1062 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1063 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1065 p
= f
[XLFD_PIXEL_INDEX
];
1066 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1067 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1070 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1072 ASET (font
, FONT_SIZE_INDEX
, val
);
1073 else if (FONT_ENTITY_P (font
))
1077 double point_size
= -1;
1079 eassert (FONT_SPEC_P (font
));
1080 p
= f
[XLFD_POINT_INDEX
];
1082 point_size
= parse_matrix (p
);
1083 else if (c_isdigit (*p
))
1084 point_size
= atoi (p
), point_size
/= 10;
1085 if (point_size
>= 0)
1086 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1090 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1091 if (! NILP (val
) && ! INTEGERP (val
))
1093 ASET (font
, FONT_DPI_INDEX
, val
);
1094 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1097 val
= font_prop_validate_spacing (QCspacing
, val
);
1098 if (! INTEGERP (val
))
1100 ASET (font
, FONT_SPACING_INDEX
, val
);
1102 p
= f
[XLFD_AVGWIDTH_INDEX
];
1105 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1106 if (! NILP (val
) && ! INTEGERP (val
))
1108 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1112 int wild_card_found
= 0;
1113 Lisp_Object prop
[XLFD_LAST_INDEX
];
1115 if (FONT_ENTITY_P (font
))
1117 for (j
= 0; j
< i
; j
++)
1121 if (f
[j
][1] && f
[j
][1] != '-')
1124 wild_card_found
= 1;
1127 prop
[j
] = INTERN_FIELD (j
);
1129 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1131 if (! wild_card_found
)
1133 if (font_expand_wildcards (prop
, i
) < 0)
1136 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1137 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1138 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1139 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1140 if (! NILP (prop
[i
]))
1142 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1144 ASET (font
, j
, make_number (n
));
1146 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1147 val
= prop
[XLFD_REGISTRY_INDEX
];
1150 val
= prop
[XLFD_ENCODING_INDEX
];
1152 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1154 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1155 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1157 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1158 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1160 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1162 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1163 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1164 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1166 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1168 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1171 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1172 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1173 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1175 val
= font_prop_validate_spacing (QCspacing
,
1176 prop
[XLFD_SPACING_INDEX
]);
1177 if (! INTEGERP (val
))
1179 ASET (font
, FONT_SPACING_INDEX
, val
);
1181 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1182 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1188 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1189 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1190 0, use PIXEL_SIZE instead. */
1193 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1196 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1200 eassert (FONTP (font
));
1202 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1205 if (i
== FONT_ADSTYLE_INDEX
)
1206 j
= XLFD_ADSTYLE_INDEX
;
1207 else if (i
== FONT_REGISTRY_INDEX
)
1208 j
= XLFD_REGISTRY_INDEX
;
1209 val
= AREF (font
, i
);
1212 if (j
== XLFD_REGISTRY_INDEX
)
1220 val
= SYMBOL_NAME (val
);
1221 if (j
== XLFD_REGISTRY_INDEX
1222 && ! strchr (SSDATA (val
), '-'))
1224 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1225 ptrdiff_t alloc
= SBYTES (val
) + 4;
1226 if (nbytes
<= alloc
)
1228 f
[j
] = p
= alloca (alloc
);
1229 sprintf (p
, "%s%s-*", SDATA (val
),
1230 "*" + (SDATA (val
)[SBYTES (val
) - 1] == '*'));
1233 f
[j
] = SSDATA (val
);
1237 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1240 val
= font_style_symbolic (font
, i
, 0);
1245 val
= SYMBOL_NAME (val
);
1246 f
[j
] = SSDATA (val
);
1250 val
= AREF (font
, FONT_SIZE_INDEX
);
1251 eassert (NUMBERP (val
) || NILP (val
));
1254 EMACS_INT v
= XINT (val
);
1259 f
[XLFD_PIXEL_INDEX
] = p
=
1260 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1261 sprintf (p
, "%"pI
"d-*", v
);
1264 f
[XLFD_PIXEL_INDEX
] = "*-*";
1266 else if (FLOATP (val
))
1268 double v
= XFLOAT_DATA (val
) * 10;
1269 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1270 sprintf (p
, "*-%.0f", v
);
1273 f
[XLFD_PIXEL_INDEX
] = "*-*";
1275 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1277 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1278 f
[XLFD_RESX_INDEX
] = p
=
1279 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1280 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1283 f
[XLFD_RESX_INDEX
] = "*-*";
1284 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1286 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1288 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1289 : spacing
<= FONT_SPACING_DUAL
? "d"
1290 : spacing
<= FONT_SPACING_MONO
? "m"
1294 f
[XLFD_SPACING_INDEX
] = "*";
1295 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1297 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1298 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1301 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1302 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1303 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1304 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1305 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1306 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1307 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1308 f
[XLFD_REGISTRY_INDEX
]);
1309 return len
< nbytes
? len
: -1;
1312 /* Parse NAME (null terminated) and store information in FONT
1313 (font-spec or font-entity). NAME is supplied in either the
1314 Fontconfig or GTK font name format. If NAME is successfully
1315 parsed, return 0. Otherwise return -1.
1317 The fontconfig format is
1319 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1323 FAMILY [PROPS...] [SIZE]
1325 This function tries to guess which format it is. */
1328 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1331 char *size_beg
= NULL
, *size_end
= NULL
;
1332 char *props_beg
= NULL
, *family_end
= NULL
;
1337 for (p
= name
; *p
; p
++)
1339 if (*p
== '\\' && p
[1])
1343 props_beg
= family_end
= p
;
1348 int decimal
= 0, size_found
= 1;
1349 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1350 if (! c_isdigit (*q
))
1352 if (*q
!= '.' || decimal
)
1371 Lisp_Object extra_props
= Qnil
;
1373 /* A fontconfig name with size and/or property data. */
1374 if (family_end
> name
)
1377 family
= font_intern_prop (name
, family_end
- name
, 1);
1378 ASET (font
, FONT_FAMILY_INDEX
, family
);
1382 double point_size
= strtod (size_beg
, &size_end
);
1383 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1384 if (*size_end
== ':' && size_end
[1])
1385 props_beg
= size_end
;
1389 /* Now parse ":KEY=VAL" patterns. */
1392 for (p
= props_beg
; *p
; p
= q
)
1394 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1397 /* Must be an enumerated value. */
1401 val
= font_intern_prop (p
, q
- p
, 1);
1403 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1404 && memcmp (p, STR, strlen (STR)) == 0)
1406 if (PROP_MATCH ("light")
1407 || PROP_MATCH ("medium")
1408 || PROP_MATCH ("demibold")
1409 || PROP_MATCH ("bold")
1410 || PROP_MATCH ("black"))
1411 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1412 else if (PROP_MATCH ("roman")
1413 || PROP_MATCH ("italic")
1414 || PROP_MATCH ("oblique"))
1415 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1416 else if (PROP_MATCH ("charcell"))
1417 ASET (font
, FONT_SPACING_INDEX
,
1418 make_number (FONT_SPACING_CHARCELL
));
1419 else if (PROP_MATCH ("mono"))
1420 ASET (font
, FONT_SPACING_INDEX
,
1421 make_number (FONT_SPACING_MONO
));
1422 else if (PROP_MATCH ("proportional"))
1423 ASET (font
, FONT_SPACING_INDEX
,
1424 make_number (FONT_SPACING_PROPORTIONAL
));
1433 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1434 prop
= FONT_SIZE_INDEX
;
1437 key
= font_intern_prop (p
, q
- p
, 1);
1438 prop
= get_font_prop_index (key
);
1442 for (q
= p
; *q
&& *q
!= ':'; q
++);
1443 val
= font_intern_prop (p
, q
- p
, 0);
1445 if (prop
>= FONT_FOUNDRY_INDEX
1446 && prop
< FONT_EXTRA_INDEX
)
1447 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1450 extra_props
= nconc2 (extra_props
,
1451 Fcons (Fcons (key
, val
), Qnil
));
1458 if (! NILP (extra_props
))
1460 struct font_driver_list
*driver_list
= font_driver_list
;
1461 for ( ; driver_list
; driver_list
= driver_list
->next
)
1462 if (driver_list
->driver
->filter_properties
)
1463 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1469 /* Either a fontconfig-style name with no size and property
1470 data, or a GTK-style name. */
1471 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1472 Lisp_Object width
= Qnil
, size
= Qnil
;
1476 /* Scan backwards from the end, looking for a size. */
1477 for (p
= name
+ len
- 1; p
>= name
; p
--)
1478 if (!c_isdigit (*p
))
1481 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1482 /* Found a font size. */
1483 size
= make_float (strtod (p
+ 1, NULL
));
1487 /* Now P points to the termination of the string, sans size.
1488 Scan backwards, looking for font properties. */
1489 for (; p
> name
; p
= q
)
1491 for (q
= p
- 1; q
>= name
; q
--)
1493 if (q
> name
&& *(q
-1) == '\\')
1494 --q
; /* Skip quoting backslashes. */
1500 word_len
= p
- word_start
;
1502 #define PROP_MATCH(STR) \
1503 (word_len == strlen (STR) \
1504 && memcmp (word_start, STR, strlen (STR)) == 0)
1505 #define PROP_SAVE(VAR, STR) \
1506 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1508 if (PROP_MATCH ("Ultra-Light"))
1509 PROP_SAVE (weight
, "ultra-light");
1510 else if (PROP_MATCH ("Light"))
1511 PROP_SAVE (weight
, "light");
1512 else if (PROP_MATCH ("Book"))
1513 PROP_SAVE (weight
, "book");
1514 else if (PROP_MATCH ("Medium"))
1515 PROP_SAVE (weight
, "medium");
1516 else if (PROP_MATCH ("Semi-Bold"))
1517 PROP_SAVE (weight
, "semi-bold");
1518 else if (PROP_MATCH ("Bold"))
1519 PROP_SAVE (weight
, "bold");
1520 else if (PROP_MATCH ("Italic"))
1521 PROP_SAVE (slant
, "italic");
1522 else if (PROP_MATCH ("Oblique"))
1523 PROP_SAVE (slant
, "oblique");
1524 else if (PROP_MATCH ("Semi-Condensed"))
1525 PROP_SAVE (width
, "semi-condensed");
1526 else if (PROP_MATCH ("Condensed"))
1527 PROP_SAVE (width
, "condensed");
1528 /* An unknown word must be part of the font name. */
1539 ASET (font
, FONT_FAMILY_INDEX
,
1540 font_intern_prop (name
, family_end
- name
, 1));
1542 ASET (font
, FONT_SIZE_INDEX
, size
);
1544 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1546 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1548 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1554 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1555 NAME (NBYTES length), and return the name length. If
1556 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1559 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1561 Lisp_Object family
, foundry
;
1567 Lisp_Object styles
[3];
1568 const char *style_names
[3] = { "weight", "slant", "width" };
1570 family
= AREF (font
, FONT_FAMILY_INDEX
);
1571 if (! NILP (family
))
1573 if (SYMBOLP (family
))
1574 family
= SYMBOL_NAME (family
);
1579 val
= AREF (font
, FONT_SIZE_INDEX
);
1582 if (XINT (val
) != 0)
1583 pixel_size
= XINT (val
);
1588 eassert (FLOATP (val
));
1590 point_size
= (int) XFLOAT_DATA (val
);
1593 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1594 if (! NILP (foundry
))
1596 if (SYMBOLP (foundry
))
1597 foundry
= SYMBOL_NAME (foundry
);
1602 for (i
= 0; i
< 3; i
++)
1603 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1606 lim
= name
+ nbytes
;
1607 if (! NILP (family
))
1609 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1610 if (! (0 <= len
&& len
< lim
- p
))
1616 int len
= snprintf (p
, lim
- p
, "-%d" + (p
== name
), point_size
);
1617 if (! (0 <= len
&& len
< lim
- p
))
1621 else if (pixel_size
> 0)
1623 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1624 if (! (0 <= len
&& len
< lim
- p
))
1628 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1630 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1631 SSDATA (SYMBOL_NAME (AREF (font
,
1632 FONT_FOUNDRY_INDEX
))));
1633 if (! (0 <= len
&& len
< lim
- p
))
1637 for (i
= 0; i
< 3; i
++)
1638 if (! NILP (styles
[i
]))
1640 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1641 SSDATA (SYMBOL_NAME (styles
[i
])));
1642 if (! (0 <= len
&& len
< lim
- p
))
1647 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1649 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1650 XINT (AREF (font
, FONT_DPI_INDEX
)));
1651 if (! (0 <= len
&& len
< lim
- p
))
1656 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1658 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1659 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1660 if (! (0 <= len
&& len
< lim
- p
))
1665 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1667 int len
= snprintf (p
, lim
- p
,
1668 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1670 : ":scalable=false"));
1671 if (! (0 <= len
&& len
< lim
- p
))
1679 /* Parse NAME (null terminated) and store information in FONT
1680 (font-spec or font-entity). If NAME is successfully parsed, return
1681 0. Otherwise return -1. */
1684 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1686 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1687 return font_parse_xlfd (name
, namelen
, font
);
1688 return font_parse_fcname (name
, namelen
, font
);
1692 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1693 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1697 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1703 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1705 CHECK_STRING (family
);
1706 len
= SBYTES (family
);
1707 p0
= SSDATA (family
);
1708 p1
= strchr (p0
, '-');
1711 if ((*p0
!= '*' && p1
- p0
> 0)
1712 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1713 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1716 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1719 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1721 if (! NILP (registry
))
1723 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1724 CHECK_STRING (registry
);
1725 len
= SBYTES (registry
);
1726 p0
= SSDATA (registry
);
1727 p1
= strchr (p0
, '-');
1730 if (SDATA (registry
)[len
- 1] == '*')
1731 registry
= concat2 (registry
, build_string ("-*"));
1733 registry
= concat2 (registry
, build_string ("*-*"));
1735 registry
= Fdowncase (registry
);
1736 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1741 /* This part (through the next ^L) is still experimental and not
1742 tested much. We may drastically change codes. */
1748 #define LGSTRING_HEADER_SIZE 6
1749 #define LGSTRING_GLYPH_SIZE 8
1752 check_gstring (Lisp_Object gstring
)
1758 CHECK_VECTOR (gstring
);
1759 val
= AREF (gstring
, 0);
1761 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1763 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1764 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1765 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1766 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1767 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1768 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1769 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1770 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1771 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1772 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1773 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1775 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1777 val
= LGSTRING_GLYPH (gstring
, i
);
1779 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1781 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1783 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1784 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1785 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1786 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1787 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1788 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1789 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1790 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1792 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1794 if (ASIZE (val
) < 3)
1796 for (j
= 0; j
< 3; j
++)
1797 CHECK_NUMBER (AREF (val
, j
));
1802 error ("Invalid glyph-string format");
1807 check_otf_features (Lisp_Object otf_features
)
1811 CHECK_CONS (otf_features
);
1812 CHECK_SYMBOL (XCAR (otf_features
));
1813 otf_features
= XCDR (otf_features
);
1814 CHECK_CONS (otf_features
);
1815 CHECK_SYMBOL (XCAR (otf_features
));
1816 otf_features
= XCDR (otf_features
);
1817 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1819 CHECK_SYMBOL (XCAR (val
));
1820 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1821 error ("Invalid OTF GSUB feature: %s",
1822 SDATA (SYMBOL_NAME (XCAR (val
))));
1824 otf_features
= XCDR (otf_features
);
1825 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1827 CHECK_SYMBOL (XCAR (val
));
1828 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1829 error ("Invalid OTF GPOS feature: %s",
1830 SDATA (SYMBOL_NAME (XCAR (val
))));
1837 Lisp_Object otf_list
;
1840 otf_tag_symbol (OTF_Tag tag
)
1844 OTF_tag_name (tag
, name
);
1845 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1849 otf_open (Lisp_Object file
)
1851 Lisp_Object val
= Fassoc (file
, otf_list
);
1855 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1858 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1859 val
= make_save_value (otf
, 0);
1860 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1866 /* Return a list describing which scripts/languages FONT supports by
1867 which GSUB/GPOS features of OpenType tables. See the comment of
1868 (struct font_driver).otf_capability. */
1871 font_otf_capability (struct font
*font
)
1874 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1877 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1880 for (i
= 0; i
< 2; i
++)
1882 OTF_GSUB_GPOS
*gsub_gpos
;
1883 Lisp_Object script_list
= Qnil
;
1886 if (OTF_get_features (otf
, i
== 0) < 0)
1888 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1889 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1891 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1892 Lisp_Object langsys_list
= Qnil
;
1893 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1896 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1898 OTF_LangSys
*langsys
;
1899 Lisp_Object feature_list
= Qnil
;
1900 Lisp_Object langsys_tag
;
1903 if (k
== script
->LangSysCount
)
1905 langsys
= &script
->DefaultLangSys
;
1910 langsys
= script
->LangSys
+ k
;
1912 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1914 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1916 OTF_Feature
*feature
1917 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1918 Lisp_Object feature_tag
1919 = otf_tag_symbol (feature
->FeatureTag
);
1921 feature_list
= Fcons (feature_tag
, feature_list
);
1923 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1926 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1931 XSETCAR (capability
, script_list
);
1933 XSETCDR (capability
, script_list
);
1939 /* Parse OTF features in SPEC and write a proper features spec string
1940 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1941 assured that the sufficient memory has already allocated for
1945 generate_otf_features (Lisp_Object spec
, char *features
)
1953 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1959 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1964 else if (! asterisk
)
1966 val
= SYMBOL_NAME (val
);
1967 p
+= esprintf (p
, "%s", SDATA (val
));
1971 val
= SYMBOL_NAME (val
);
1972 p
+= esprintf (p
, "~%s", SDATA (val
));
1976 error ("OTF spec too long");
1980 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1982 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1984 return Fcons (make_number (len
),
1985 make_unibyte_string (device_table
->DeltaValue
, len
));
1989 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
1991 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1993 if (value_format
& OTF_XPlacement
)
1994 ASET (val
, 0, make_number (value_record
->XPlacement
));
1995 if (value_format
& OTF_YPlacement
)
1996 ASET (val
, 1, make_number (value_record
->YPlacement
));
1997 if (value_format
& OTF_XAdvance
)
1998 ASET (val
, 2, make_number (value_record
->XAdvance
));
1999 if (value_format
& OTF_YAdvance
)
2000 ASET (val
, 3, make_number (value_record
->YAdvance
));
2001 if (value_format
& OTF_XPlaDevice
)
2002 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2003 if (value_format
& OTF_YPlaDevice
)
2004 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2005 if (value_format
& OTF_XAdvDevice
)
2006 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2007 if (value_format
& OTF_YAdvDevice
)
2008 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2013 font_otf_Anchor (OTF_Anchor
*anchor
)
2017 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2018 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2019 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2020 if (anchor
->AnchorFormat
== 2)
2021 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2024 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2025 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2029 #endif /* HAVE_LIBOTF */
2035 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2036 static int font_compare (const void *, const void *);
2037 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2041 font_rescale_ratio (Lisp_Object font_entity
)
2043 Lisp_Object tail
, elt
;
2044 Lisp_Object name
= Qnil
;
2046 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2049 if (FLOATP (XCDR (elt
)))
2051 if (STRINGP (XCAR (elt
)))
2054 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2055 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2056 return XFLOAT_DATA (XCDR (elt
));
2058 else if (FONT_SPEC_P (XCAR (elt
)))
2060 if (font_match_p (XCAR (elt
), font_entity
))
2061 return XFLOAT_DATA (XCDR (elt
));
2068 /* We sort fonts by scoring each of them against a specified
2069 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2070 the value is, the closer the font is to the font-spec.
2072 The lowest 2 bits of the score are used for driver type. The font
2073 available by the most preferred font driver is 0.
2075 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2076 WEIGHT, SLANT, WIDTH, and SIZE. */
2078 /* How many bits to shift to store the difference value of each font
2079 property in a score. Note that floats for FONT_TYPE_INDEX and
2080 FONT_REGISTRY_INDEX are not used. */
2081 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2083 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2084 The return value indicates how different ENTITY is compared with
2088 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2093 /* Score three style numeric fields. Maximum difference is 127. */
2094 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2095 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2097 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2098 - (XINT (spec_prop
[i
]) >> 8));
2101 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2104 /* Score the size. Maximum difference is 127. */
2105 i
= FONT_SIZE_INDEX
;
2106 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2107 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2109 /* We use the higher 6-bit for the actual size difference. The
2110 lowest bit is set if the DPI is different. */
2112 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2114 if (CONSP (Vface_font_rescale_alist
))
2115 pixel_size
*= font_rescale_ratio (entity
);
2116 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2120 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2121 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2123 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2124 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2126 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2133 /* Concatenate all elements of LIST into one vector. LIST is a list
2134 of font-entity vectors. */
2137 font_vconcat_entity_vectors (Lisp_Object list
)
2139 int nargs
= XINT (Flength (list
));
2140 Lisp_Object
*args
= alloca (word_size
* nargs
);
2143 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2144 args
[i
] = XCAR (list
);
2145 return Fvconcat (nargs
, args
);
2149 /* The structure for elements being sorted by qsort. */
2150 struct font_sort_data
2153 int font_driver_preference
;
2158 /* The comparison function for qsort. */
2161 font_compare (const void *d1
, const void *d2
)
2163 const struct font_sort_data
*data1
= d1
;
2164 const struct font_sort_data
*data2
= d2
;
2166 if (data1
->score
< data2
->score
)
2168 else if (data1
->score
> data2
->score
)
2170 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2174 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2175 If PREFER specifies a point-size, calculate the corresponding
2176 pixel-size from QCdpi property of PREFER or from the Y-resolution
2177 of FRAME before sorting.
2179 If BEST-ONLY is nonzero, return the best matching entity (that
2180 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2181 if BEST-ONLY is negative). Otherwise, return the sorted result as
2182 a single vector of font-entities.
2184 This function does no optimization for the case that the total
2185 number of elements is 1. The caller should avoid calling this in
2189 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2191 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2193 struct font_sort_data
*data
;
2194 unsigned best_score
;
2195 Lisp_Object best_entity
;
2196 struct frame
*f
= XFRAME (frame
);
2197 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2200 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2201 prefer_prop
[i
] = AREF (prefer
, i
);
2202 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2203 prefer_prop
[FONT_SIZE_INDEX
]
2204 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2206 if (NILP (XCDR (list
)))
2208 /* What we have to take care of is this single vector. */
2210 maxlen
= ASIZE (vec
);
2214 /* We don't have to perform sort, so there's no need of creating
2215 a single vector. But, we must find the length of the longest
2218 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2219 if (maxlen
< ASIZE (XCAR (tail
)))
2220 maxlen
= ASIZE (XCAR (tail
));
2224 /* We have to create a single vector to sort it. */
2225 vec
= font_vconcat_entity_vectors (list
);
2226 maxlen
= ASIZE (vec
);
2229 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2230 best_score
= 0xFFFFFFFF;
2233 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2235 int font_driver_preference
= 0;
2236 Lisp_Object current_font_driver
;
2242 /* We are sure that the length of VEC > 0. */
2243 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2244 /* Score the elements. */
2245 for (i
= 0; i
< len
; i
++)
2247 data
[i
].entity
= AREF (vec
, i
);
2249 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2251 ? font_score (data
[i
].entity
, prefer_prop
)
2253 if (best_only
&& best_score
> data
[i
].score
)
2255 best_score
= data
[i
].score
;
2256 best_entity
= data
[i
].entity
;
2257 if (best_score
== 0)
2260 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2262 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2263 font_driver_preference
++;
2265 data
[i
].font_driver_preference
= font_driver_preference
;
2268 /* Sort if necessary. */
2271 qsort (data
, len
, sizeof *data
, font_compare
);
2272 for (i
= 0; i
< len
; i
++)
2273 ASET (vec
, i
, data
[i
].entity
);
2282 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2287 /* API of Font Service Layer. */
2289 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2290 sort_shift_bits. Finternal_set_font_selection_order calls this
2291 function with font_sort_order after setting up it. */
2294 font_update_sort_order (int *order
)
2298 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2300 int xlfd_idx
= order
[i
];
2302 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2303 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2304 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2305 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2306 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2307 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2309 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2314 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2319 table
= assq_no_quit (script
, table
);
2322 table
= XCDR (table
);
2323 if (! NILP (langsys
))
2325 table
= assq_no_quit (langsys
, table
);
2331 val
= assq_no_quit (Qnil
, table
);
2333 table
= XCAR (table
);
2337 table
= XCDR (table
);
2338 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2340 if (NILP (XCAR (features
)))
2345 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2351 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2354 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2356 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2358 script
= XCAR (spec
);
2362 langsys
= XCAR (spec
);
2373 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2374 XCAR (otf_capability
)))
2376 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2377 XCDR (otf_capability
)))
2384 /* Check if FONT (font-entity or font-object) matches with the font
2385 specification SPEC. */
2388 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2390 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2391 Lisp_Object extra
, font_extra
;
2394 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2395 if (! NILP (AREF (spec
, i
))
2396 && ! NILP (AREF (font
, i
))
2397 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2399 props
= XFONT_SPEC (spec
)->props
;
2400 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2402 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2403 prop
[i
] = AREF (spec
, i
);
2404 prop
[FONT_SIZE_INDEX
]
2405 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2409 if (font_score (font
, props
) > 0)
2411 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2412 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2413 for (; CONSP (extra
); extra
= XCDR (extra
))
2415 Lisp_Object key
= XCAR (XCAR (extra
));
2416 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2418 if (EQ (key
, QClang
))
2420 val2
= assq_no_quit (key
, font_extra
);
2429 if (NILP (Fmemq (val
, val2
)))
2434 ? NILP (Fmemq (val
, XCDR (val2
)))
2438 else if (EQ (key
, QCscript
))
2440 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2446 /* All characters in the list must be supported. */
2447 for (; CONSP (val2
); val2
= XCDR (val2
))
2449 if (! CHARACTERP (XCAR (val2
)))
2451 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2452 == FONT_INVALID_CODE
)
2456 else if (VECTORP (val2
))
2458 /* At most one character in the vector must be supported. */
2459 for (i
= 0; i
< ASIZE (val2
); i
++)
2461 if (! CHARACTERP (AREF (val2
, i
)))
2463 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2464 != FONT_INVALID_CODE
)
2467 if (i
== ASIZE (val2
))
2472 else if (EQ (key
, QCotf
))
2476 if (! FONT_OBJECT_P (font
))
2478 fontp
= XFONT_OBJECT (font
);
2479 if (! fontp
->driver
->otf_capability
)
2481 val2
= fontp
->driver
->otf_capability (fontp
);
2482 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2493 Each font backend has the callback function get_cache, and it
2494 returns a cons cell of which cdr part can be freely used for
2495 caching fonts. The cons cell may be shared by multiple frames
2496 and/or multiple font drivers. So, we arrange the cdr part as this:
2498 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2500 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2501 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2502 cons (FONT-SPEC FONT-ENTITY ...). */
2504 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2505 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2506 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2507 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2508 struct font_driver
*);
2511 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2513 Lisp_Object cache
, val
;
2515 cache
= driver
->get_cache (f
);
2517 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2521 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2522 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2526 val
= XCDR (XCAR (val
));
2527 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2533 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2535 Lisp_Object cache
, val
, tmp
;
2538 cache
= driver
->get_cache (f
);
2540 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2541 cache
= val
, val
= XCDR (val
);
2542 eassert (! NILP (val
));
2543 tmp
= XCDR (XCAR (val
));
2544 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2545 if (XINT (XCAR (tmp
)) == 0)
2547 font_clear_cache (f
, XCAR (val
), driver
);
2548 XSETCDR (cache
, XCDR (val
));
2554 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2556 Lisp_Object val
= driver
->get_cache (f
);
2557 Lisp_Object type
= driver
->type
;
2559 eassert (CONSP (val
));
2560 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2561 eassert (CONSP (val
));
2562 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2563 val
= XCDR (XCAR (val
));
2567 static int num_fonts
;
2570 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2572 Lisp_Object tail
, elt
;
2573 Lisp_Object tail2
, entity
;
2575 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2576 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2579 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2580 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2582 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2584 entity
= XCAR (tail2
);
2586 if (FONT_ENTITY_P (entity
)
2587 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2589 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2591 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2593 Lisp_Object val
= XCAR (objlist
);
2594 struct font
*font
= XFONT_OBJECT (val
);
2596 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2598 eassert (font
&& driver
== font
->driver
);
2599 driver
->close (f
, font
);
2603 if (driver
->free_entity
)
2604 driver
->free_entity (entity
);
2609 XSETCDR (cache
, Qnil
);
2613 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2615 /* Check each font-entity in VEC, and return a list of font-entities
2616 that satisfy these conditions:
2617 (1) matches with SPEC and SIZE if SPEC is not nil, and
2618 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2622 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2624 Lisp_Object entity
, val
;
2625 enum font_property_index prop
;
2628 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2630 entity
= AREF (vec
, i
);
2631 if (! NILP (Vface_ignored_fonts
))
2635 Lisp_Object tail
, regexp
;
2637 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2640 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2642 regexp
= XCAR (tail
);
2643 if (STRINGP (regexp
)
2644 && fast_c_string_match_ignore_case (regexp
, name
,
2654 val
= Fcons (entity
, val
);
2657 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2658 if (INTEGERP (AREF (spec
, prop
))
2659 && ((XINT (AREF (spec
, prop
)) >> 8)
2660 != (XINT (AREF (entity
, prop
)) >> 8)))
2661 prop
= FONT_SPEC_MAX
;
2662 if (prop
< FONT_SPEC_MAX
2664 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2666 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2669 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2670 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2671 prop
= FONT_SPEC_MAX
;
2673 if (prop
< FONT_SPEC_MAX
2674 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2675 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2676 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2677 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2678 prop
= FONT_SPEC_MAX
;
2679 if (prop
< FONT_SPEC_MAX
2680 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2681 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2682 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2683 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2684 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2685 prop
= FONT_SPEC_MAX
;
2686 if (prop
< FONT_SPEC_MAX
)
2687 val
= Fcons (entity
, val
);
2689 return (Fvconcat (1, &val
));
2693 /* Return a list of vectors of font-entities matching with SPEC on
2694 FRAME. Each elements in the list is a vector of entities from the
2695 same font-driver. */
2698 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2700 FRAME_PTR f
= XFRAME (frame
);
2701 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2702 Lisp_Object ftype
, val
;
2703 Lisp_Object list
= Qnil
;
2705 int need_filtering
= 0;
2708 eassert (FONT_SPEC_P (spec
));
2710 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2711 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2712 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2713 size
= font_pixel_size (f
, spec
);
2717 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2718 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2719 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2720 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2721 if (i
!= FONT_SPACING_INDEX
)
2723 ASET (scratch_font_spec
, i
, Qnil
);
2724 if (! NILP (AREF (spec
, i
)))
2727 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2728 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2730 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2732 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2734 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2736 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2737 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2744 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2748 val
= Fvconcat (1, &val
);
2749 copy
= copy_font_spec (scratch_font_spec
);
2750 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2751 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2755 || ! NILP (Vface_ignored_fonts
)))
2756 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2757 if (ASIZE (val
) > 0)
2758 list
= Fcons (val
, list
);
2761 list
= Fnreverse (list
);
2762 FONT_ADD_LOG ("list", spec
, list
);
2767 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2768 nil, is an array of face's attributes, which specifies preferred
2769 font-related attributes. */
2772 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2774 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2775 Lisp_Object ftype
, size
, entity
;
2777 Lisp_Object work
= copy_font_spec (spec
);
2779 XSETFRAME (frame
, f
);
2780 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2781 size
= AREF (spec
, FONT_SIZE_INDEX
);
2784 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2785 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2786 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2787 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2790 for (; driver_list
; driver_list
= driver_list
->next
)
2792 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2794 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2797 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2798 entity
= assoc_no_quit (work
, XCDR (cache
));
2800 entity
= XCDR (entity
);
2803 entity
= driver_list
->driver
->match (frame
, work
);
2804 copy
= copy_font_spec (work
);
2805 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2806 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2808 if (! NILP (entity
))
2811 FONT_ADD_LOG ("match", work
, entity
);
2816 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2817 opened font object. */
2820 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2822 struct font_driver_list
*driver_list
;
2823 Lisp_Object objlist
, size
, val
, font_object
;
2825 int min_width
, height
;
2826 int scaled_pixel_size
= pixel_size
;
2828 eassert (FONT_ENTITY_P (entity
));
2829 size
= AREF (entity
, FONT_SIZE_INDEX
);
2830 if (XINT (size
) != 0)
2831 scaled_pixel_size
= pixel_size
= XINT (size
);
2832 else if (CONSP (Vface_font_rescale_alist
))
2833 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2835 val
= AREF (entity
, FONT_TYPE_INDEX
);
2836 for (driver_list
= f
->font_driver_list
;
2837 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2838 driver_list
= driver_list
->next
);
2842 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2843 objlist
= XCDR (objlist
))
2845 Lisp_Object fn
= XCAR (objlist
);
2846 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2847 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2849 if (driver_list
->driver
->cached_font_ok
== NULL
2850 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2855 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2856 if (!NILP (font_object
))
2857 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2858 FONT_ADD_LOG ("open", entity
, font_object
);
2859 if (NILP (font_object
))
2861 ASET (entity
, FONT_OBJLIST_INDEX
,
2862 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2865 font
= XFONT_OBJECT (font_object
);
2866 min_width
= (font
->min_width
? font
->min_width
2867 : font
->average_width
? font
->average_width
2868 : font
->space_width
? font
->space_width
2870 height
= (font
->height
? font
->height
: 1);
2871 #ifdef HAVE_WINDOW_SYSTEM
2872 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2873 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2875 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2876 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2877 fonts_changed_p
= 1;
2881 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2882 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2883 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2884 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2892 /* Close FONT_OBJECT that is opened on frame F. */
2895 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2897 struct font
*font
= XFONT_OBJECT (font_object
);
2899 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2900 /* Already closed. */
2902 FONT_ADD_LOG ("close", font_object
, Qnil
);
2903 font
->driver
->close (f
, font
);
2904 #ifdef HAVE_WINDOW_SYSTEM
2905 eassert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2906 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2912 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2913 FONT is a font-entity and it must be opened to check. */
2916 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2920 if (FONT_ENTITY_P (font
))
2922 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2923 struct font_driver_list
*driver_list
;
2925 for (driver_list
= f
->font_driver_list
;
2926 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2927 driver_list
= driver_list
->next
);
2930 if (! driver_list
->driver
->has_char
)
2932 return driver_list
->driver
->has_char (font
, c
);
2935 eassert (FONT_OBJECT_P (font
));
2936 fontp
= XFONT_OBJECT (font
);
2937 if (fontp
->driver
->has_char
)
2939 int result
= fontp
->driver
->has_char (font
, c
);
2944 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2948 /* Return the glyph ID of FONT_OBJECT for character C. */
2951 font_encode_char (Lisp_Object font_object
, int c
)
2955 eassert (FONT_OBJECT_P (font_object
));
2956 font
= XFONT_OBJECT (font_object
);
2957 return font
->driver
->encode_char (font
, c
);
2961 /* Return the name of FONT_OBJECT. */
2964 font_get_name (Lisp_Object font_object
)
2966 eassert (FONT_OBJECT_P (font_object
));
2967 return AREF (font_object
, FONT_NAME_INDEX
);
2971 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2972 could not be parsed by font_parse_name, return Qnil. */
2975 font_spec_from_name (Lisp_Object font_name
)
2977 Lisp_Object spec
= Ffont_spec (0, NULL
);
2979 CHECK_STRING (font_name
);
2980 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2982 font_put_extra (spec
, QCname
, font_name
);
2983 font_put_extra (spec
, QCuser_spec
, font_name
);
2989 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2991 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2996 if (! NILP (Ffont_get (font
, QCname
)))
2998 font
= copy_font_spec (font
);
2999 font_put_extra (font
, QCname
, Qnil
);
3002 if (NILP (AREF (font
, prop
))
3003 && prop
!= FONT_FAMILY_INDEX
3004 && prop
!= FONT_FOUNDRY_INDEX
3005 && prop
!= FONT_WIDTH_INDEX
3006 && prop
!= FONT_SIZE_INDEX
)
3008 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3009 font
= copy_font_spec (font
);
3010 ASET (font
, prop
, Qnil
);
3011 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3013 if (prop
== FONT_FAMILY_INDEX
)
3015 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3016 /* If we are setting the font family, we must also clear
3017 FONT_WIDTH_INDEX to avoid rejecting families that lack
3018 support for some widths. */
3019 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3021 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3022 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3023 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
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_SIZE_INDEX
)
3030 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3031 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3032 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3034 else if (prop
== FONT_WIDTH_INDEX
)
3035 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3036 attrs
[LFACE_FONT_INDEX
] = font
;
3039 /* Select a font from ENTITIES (list of font-entity vectors) that
3040 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3043 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3045 Lisp_Object font_entity
;
3048 FRAME_PTR f
= XFRAME (frame
);
3050 if (NILP (XCDR (entities
))
3051 && ASIZE (XCAR (entities
)) == 1)
3053 font_entity
= AREF (XCAR (entities
), 0);
3055 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3060 /* Sort fonts by properties specified in ATTRS. */
3061 prefer
= scratch_font_prefer
;
3063 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3064 ASET (prefer
, i
, Qnil
);
3065 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3067 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3069 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3070 ASET (prefer
, i
, AREF (face_font
, i
));
3072 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3073 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3074 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3075 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3076 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3077 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3078 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3080 return font_sort_entities (entities
, prefer
, frame
, c
);
3083 /* Return a font-entity that satisfies SPEC and is the best match for
3084 face's font related attributes in ATTRS. C, if not negative, is a
3085 character that the entity must support. */
3088 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3091 Lisp_Object frame
, entities
, val
;
3092 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3097 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3098 if (NILP (registry
[0]))
3100 registry
[0] = DEFAULT_ENCODING
;
3101 registry
[1] = Qascii_0
;
3102 registry
[2] = zero_vector
;
3105 registry
[1] = zero_vector
;
3107 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3109 struct charset
*encoding
, *repertory
;
3111 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3112 &encoding
, &repertory
) < 0)
3115 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3117 else if (c
> encoding
->max_char
)
3121 work
= copy_font_spec (spec
);
3122 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3123 XSETFRAME (frame
, f
);
3124 pixel_size
= font_pixel_size (f
, spec
);
3125 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3127 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3129 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3131 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3132 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3133 if (! NILP (foundry
[0]))
3134 foundry
[1] = zero_vector
;
3135 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3137 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3138 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3140 foundry
[2] = zero_vector
;
3143 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3145 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3146 if (! NILP (adstyle
[0]))
3147 adstyle
[1] = zero_vector
;
3148 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3150 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3152 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3154 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3156 adstyle
[2] = zero_vector
;
3159 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3162 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3165 val
= AREF (work
, FONT_FAMILY_INDEX
);
3166 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3168 val
= attrs
[LFACE_FAMILY_INDEX
];
3169 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3173 family
= alloca ((sizeof family
[0]) * 2);
3175 family
[1] = zero_vector
; /* terminator. */
3180 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3182 if (! NILP (alters
))
3184 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3185 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3186 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3187 family
[i
] = XCAR (alters
);
3188 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3190 family
[i
] = zero_vector
;
3194 family
= alloca ((sizeof family
[0]) * 3);
3197 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3199 family
[i
] = zero_vector
;
3203 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3205 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3206 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3208 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3209 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3211 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3212 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3214 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3215 entities
= font_list_entities (frame
, work
);
3216 if (! NILP (entities
))
3218 val
= font_select_entity (frame
, entities
,
3219 attrs
, pixel_size
, c
);
3234 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3238 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3239 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3240 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3241 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3242 size
= font_pixel_size (f
, spec
);
3246 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3247 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3250 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3251 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3252 eassert (INTEGERP (height
));
3257 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3261 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3262 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3266 return font_open_entity (f
, entity
, size
);
3270 /* Find a font that satisfies SPEC and is the best match for
3271 face's attributes in ATTRS on FRAME, and return the opened
3275 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3277 Lisp_Object entity
, name
;
3279 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3282 /* No font is listed for SPEC, but each font-backend may have
3283 different criteria about "font matching". So, try it. */
3284 entity
= font_matching_entity (f
, attrs
, spec
);
3288 /* Don't lose the original name that was put in initially. We need
3289 it to re-apply the font when font parameters (like hinting or dpi) have
3291 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3294 name
= Ffont_get (spec
, QCuser_spec
);
3295 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3301 /* Make FACE on frame F ready to use the font opened for FACE. */
3304 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3306 if (face
->font
->driver
->prepare_face
)
3307 face
->font
->driver
->prepare_face (f
, face
);
3311 /* Make FACE on frame F stop using the font opened for FACE. */
3314 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3316 if (face
->font
->driver
->done_face
)
3317 face
->font
->driver
->done_face (f
, face
);
3322 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3323 font is found, return Qnil. */
3326 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3328 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3330 /* We set up the default font-related attributes of a face to prefer
3332 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3333 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3334 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3336 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3338 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3340 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3342 return font_load_for_lface (f
, attrs
, spec
);
3346 /* Open a font that matches NAME on frame F. If no proper font is
3347 found, return Qnil. */
3350 font_open_by_name (FRAME_PTR f
, Lisp_Object name
)
3352 Lisp_Object args
[2];
3353 Lisp_Object spec
, ret
;
3357 spec
= Ffont_spec (2, args
);
3358 ret
= font_open_by_spec (f
, spec
);
3359 /* Do not lose name originally put in. */
3361 font_put_extra (ret
, QCuser_spec
, args
[1]);
3367 /* Register font-driver DRIVER. This function is used in two ways.
3369 The first is with frame F non-NULL. In this case, make DRIVER
3370 available (but not yet activated) on F. All frame creators
3371 (e.g. Fx_create_frame) must call this function at least once with
3372 an available font-driver.
3374 The second is with frame F NULL. In this case, DRIVER is globally
3375 registered in the variable `font_driver_list'. All font-driver
3376 implementations must call this function in its syms_of_XXXX
3377 (e.g. syms_of_xfont). */
3380 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3382 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3383 struct font_driver_list
*prev
, *list
;
3385 if (f
&& ! driver
->draw
)
3386 error ("Unusable font driver for a frame: %s",
3387 SDATA (SYMBOL_NAME (driver
->type
)));
3389 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3390 if (EQ (list
->driver
->type
, driver
->type
))
3391 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3393 list
= xmalloc (sizeof *list
);
3395 list
->driver
= driver
;
3400 f
->font_driver_list
= list
;
3402 font_driver_list
= list
;
3408 free_font_driver_list (FRAME_PTR f
)
3410 struct font_driver_list
*list
, *next
;
3412 for (list
= f
->font_driver_list
; list
; list
= next
)
3417 f
->font_driver_list
= NULL
;
3421 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3422 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3423 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3425 A caller must free all realized faces if any in advance. The
3426 return value is a list of font backends actually made used on
3430 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3432 Lisp_Object active_drivers
= Qnil
;
3433 struct font_driver_list
*list
;
3435 /* At first, turn off non-requested drivers, and turn on requested
3437 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3439 struct font_driver
*driver
= list
->driver
;
3440 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3445 if (driver
->end_for_frame
)
3446 driver
->end_for_frame (f
);
3447 font_finish_cache (f
, driver
);
3452 if (! driver
->start_for_frame
3453 || driver
->start_for_frame (f
) == 0)
3455 font_prepare_cache (f
, driver
);
3462 if (NILP (new_drivers
))
3465 if (! EQ (new_drivers
, Qt
))
3467 /* Re-order the driver list according to new_drivers. */
3468 struct font_driver_list
**list_table
, **next
;
3472 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3473 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3475 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3476 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3479 list_table
[i
++] = list
;
3481 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3483 list_table
[i
++] = list
;
3484 list_table
[i
] = NULL
;
3486 next
= &f
->font_driver_list
;
3487 for (i
= 0; list_table
[i
]; i
++)
3489 *next
= list_table
[i
];
3490 next
= &(*next
)->next
;
3494 if (! f
->font_driver_list
->on
)
3495 { /* None of the drivers is enabled: enable them all.
3496 Happens if you set the list of drivers to (xft x) in your .emacs
3497 and then use it under w32 or ns. */
3498 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3500 struct font_driver
*driver
= list
->driver
;
3501 eassert (! list
->on
);
3502 if (! driver
->start_for_frame
3503 || driver
->start_for_frame (f
) == 0)
3505 font_prepare_cache (f
, driver
);
3512 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3514 active_drivers
= nconc2 (active_drivers
,
3515 Fcons (list
->driver
->type
, Qnil
));
3516 return active_drivers
;
3520 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3522 struct font_data_list
*list
, *prev
;
3524 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3525 prev
= list
, list
= list
->next
)
3526 if (list
->driver
== driver
)
3533 prev
->next
= list
->next
;
3535 f
->font_data_list
= list
->next
;
3543 list
= xmalloc (sizeof *list
);
3544 list
->driver
= driver
;
3545 list
->next
= f
->font_data_list
;
3546 f
->font_data_list
= list
;
3554 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3556 struct font_data_list
*list
;
3558 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3559 if (list
->driver
== driver
)
3567 /* Sets attributes on a font. Any properties that appear in ALIST and
3568 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3569 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3570 arrays of strings. This function is intended for use by the font
3571 drivers to implement their specific font_filter_properties. */
3573 font_filter_properties (Lisp_Object font
,
3575 const char *const boolean_properties
[],
3576 const char *const non_boolean_properties
[])
3581 /* Set boolean values to Qt or Qnil */
3582 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3583 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3585 Lisp_Object key
= XCAR (XCAR (it
));
3586 Lisp_Object val
= XCDR (XCAR (it
));
3587 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3589 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3591 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3592 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3595 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3596 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3597 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3598 || strcmp ("Off", str
) == 0)
3603 Ffont_put (font
, key
, val
);
3607 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3608 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3610 Lisp_Object key
= XCAR (XCAR (it
));
3611 Lisp_Object val
= XCDR (XCAR (it
));
3612 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3613 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3614 Ffont_put (font
, key
, val
);
3619 /* Return the font used to draw character C by FACE at buffer position
3620 POS in window W. If STRING is non-nil, it is a string containing C
3621 at index POS. If C is negative, get C from the current buffer or
3625 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3630 Lisp_Object font_object
;
3632 multibyte
= (NILP (string
)
3633 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3634 : STRING_MULTIBYTE (string
));
3641 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3643 c
= FETCH_CHAR (pos_byte
);
3646 c
= FETCH_BYTE (pos
);
3652 multibyte
= STRING_MULTIBYTE (string
);
3655 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3657 str
= SDATA (string
) + pos_byte
;
3658 c
= STRING_CHAR (str
);
3661 c
= SDATA (string
)[pos
];
3665 f
= XFRAME (w
->frame
);
3666 if (! FRAME_WINDOW_P (f
))
3673 if (STRINGP (string
))
3674 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3675 DEFAULT_FACE_ID
, 0);
3677 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3679 face
= FACE_FROM_ID (f
, face_id
);
3683 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3684 face
= FACE_FROM_ID (f
, face_id
);
3689 XSETFONT (font_object
, face
->font
);
3694 #ifdef HAVE_WINDOW_SYSTEM
3696 /* Check how many characters after POS (at most to *LIMIT) can be
3697 displayed by the same font in the window W. FACE, if non-NULL, is
3698 the face selected for the character at POS. If STRING is not nil,
3699 it is the string to check instead of the current buffer. In that
3700 case, FACE must be not NULL.
3702 The return value is the font-object for the character at POS.
3703 *LIMIT is set to the position where that font can't be used.
3705 It is assured that the current buffer (or STRING) is multibyte. */
3708 font_range (ptrdiff_t pos
, ptrdiff_t *limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3710 ptrdiff_t pos_byte
, ignore
;
3712 Lisp_Object font_object
= Qnil
;
3716 pos_byte
= CHAR_TO_BYTE (pos
);
3721 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3723 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3729 pos_byte
= string_char_to_byte (string
, pos
);
3732 while (pos
< *limit
)
3734 Lisp_Object category
;
3737 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3739 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3740 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3741 if (INTEGERP (category
)
3742 && (XINT (category
) == UNICODE_CATEGORY_Cf
3743 || CHAR_VARIATION_SELECTOR_P (c
)))
3745 if (NILP (font_object
))
3747 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3748 if (NILP (font_object
))
3752 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3762 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3763 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3764 Return nil otherwise.
3765 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3766 which kind of font it is. It must be one of `font-spec', `font-entity',
3768 (Lisp_Object object
, Lisp_Object extra_type
)
3770 if (NILP (extra_type
))
3771 return (FONTP (object
) ? Qt
: Qnil
);
3772 if (EQ (extra_type
, Qfont_spec
))
3773 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3774 if (EQ (extra_type
, Qfont_entity
))
3775 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3776 if (EQ (extra_type
, Qfont_object
))
3777 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3778 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3781 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3782 doc
: /* Return a newly created font-spec with arguments as properties.
3784 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3785 valid font property name listed below:
3787 `:family', `:weight', `:slant', `:width'
3789 They are the same as face attributes of the same name. See
3790 `set-face-attribute'.
3794 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3798 VALUE must be a string or a symbol specifying the additional
3799 typographic style information of a font, e.g. ``sans''.
3803 VALUE must be a string or a symbol specifying the charset registry and
3804 encoding of a font, e.g. ``iso8859-1''.
3808 VALUE must be a non-negative integer or a floating point number
3809 specifying the font size. It specifies the font size in pixels (if
3810 VALUE is an integer), or in points (if VALUE is a float).
3814 VALUE must be a string of XLFD-style or fontconfig-style font name.
3818 VALUE must be a symbol representing a script that the font must
3819 support. It may be a symbol representing a subgroup of a script
3820 listed in the variable `script-representative-chars'.
3824 VALUE must be a symbol of two-letter ISO-639 language names,
3829 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3830 required OpenType features.
3832 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3833 LANGSYS-TAG: OpenType language system tag symbol,
3834 or nil for the default language system.
3835 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3836 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3838 GSUB and GPOS may contain `nil' element. In such a case, the font
3839 must not have any of the remaining elements.
3841 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3842 be an OpenType font whose GPOS table of `thai' script's default
3843 language system must contain `mark' feature.
3845 usage: (font-spec ARGS...) */)
3846 (ptrdiff_t nargs
, Lisp_Object
*args
)
3848 Lisp_Object spec
= font_make_spec ();
3851 for (i
= 0; i
< nargs
; i
+= 2)
3853 Lisp_Object key
= args
[i
], val
;
3857 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3860 if (EQ (key
, QCname
))
3863 font_parse_name (SSDATA (val
), SBYTES (val
), spec
);
3864 font_put_extra (spec
, key
, val
);
3868 int idx
= get_font_prop_index (key
);
3872 val
= font_prop_validate (idx
, Qnil
, val
);
3873 if (idx
< FONT_EXTRA_INDEX
)
3874 ASET (spec
, idx
, val
);
3876 font_put_extra (spec
, key
, val
);
3879 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3885 /* Return a copy of FONT as a font-spec. */
3887 copy_font_spec (Lisp_Object font
)
3889 Lisp_Object new_spec
, tail
, prev
, extra
;
3893 new_spec
= font_make_spec ();
3894 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3895 ASET (new_spec
, i
, AREF (font
, i
));
3896 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3897 /* We must remove :font-entity property. */
3898 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3899 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3902 extra
= XCDR (extra
);
3904 XSETCDR (prev
, XCDR (tail
));
3907 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3911 /* Merge font-specs FROM and TO, and return a new font-spec.
3912 Every specified property in FROM overrides the corresponding
3915 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3917 Lisp_Object extra
, tail
;
3922 to
= copy_font_spec (to
);
3923 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3924 ASET (to
, i
, AREF (from
, i
));
3925 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3926 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3927 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3929 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3932 XSETCDR (slot
, XCDR (XCAR (tail
)));
3934 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3936 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3940 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3941 doc
: /* Return the value of FONT's property KEY.
3942 FONT is a font-spec, a font-entity, or a font-object.
3943 KEY is any symbol, but these are reserved for specific meanings:
3944 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3945 :size, :name, :script, :otf
3946 See the documentation of `font-spec' for their meanings.
3947 In addition, if FONT is a font-entity or a font-object, values of
3948 :script and :otf are different from those of a font-spec as below:
3950 The value of :script may be a list of scripts that are supported by the font.
3952 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3953 representing the OpenType features supported by the font by this form:
3954 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3955 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3957 (Lisp_Object font
, Lisp_Object key
)
3965 idx
= get_font_prop_index (key
);
3966 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3967 return font_style_symbolic (font
, idx
, 0);
3968 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3969 return AREF (font
, idx
);
3970 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3971 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3973 struct font
*fontp
= XFONT_OBJECT (font
);
3975 if (fontp
->driver
->otf_capability
)
3976 val
= fontp
->driver
->otf_capability (fontp
);
3978 val
= Fcons (Qnil
, Qnil
);
3985 #ifdef HAVE_WINDOW_SYSTEM
3987 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3988 doc
: /* Return a plist of face attributes generated by FONT.
3989 FONT is a font name, a font-spec, a font-entity, or a font-object.
3990 The return value is a list of the form
3992 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3994 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3995 compatible with `set-face-attribute'. Some of these key-attribute pairs
3996 may be omitted from the list if they are not specified by FONT.
3998 The optional argument FRAME specifies the frame that the face attributes
3999 are to be displayed on. If omitted, the selected frame is used. */)
4000 (Lisp_Object font
, Lisp_Object frame
)
4003 Lisp_Object plist
[10];
4008 frame
= selected_frame
;
4009 CHECK_LIVE_FRAME (frame
);
4014 int fontset
= fs_query_fontset (font
, 0);
4015 Lisp_Object name
= font
;
4017 font
= fontset_ascii (fontset
);
4018 font
= font_spec_from_name (name
);
4020 signal_error ("Invalid font name", name
);
4022 else if (! FONTP (font
))
4023 signal_error ("Invalid font object", font
);
4025 val
= AREF (font
, FONT_FAMILY_INDEX
);
4028 plist
[n
++] = QCfamily
;
4029 plist
[n
++] = SYMBOL_NAME (val
);
4032 val
= AREF (font
, FONT_SIZE_INDEX
);
4035 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4036 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4037 plist
[n
++] = QCheight
;
4038 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4040 else if (FLOATP (val
))
4042 plist
[n
++] = QCheight
;
4043 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4046 val
= FONT_WEIGHT_FOR_FACE (font
);
4049 plist
[n
++] = QCweight
;
4053 val
= FONT_SLANT_FOR_FACE (font
);
4056 plist
[n
++] = QCslant
;
4060 val
= FONT_WIDTH_FOR_FACE (font
);
4063 plist
[n
++] = QCwidth
;
4067 return Flist (n
, plist
);
4072 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4073 doc
: /* Set one property of FONT: give property KEY value VAL.
4074 FONT is a font-spec, a font-entity, or a font-object.
4076 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4077 accepted by the function `font-spec' (which see), VAL must be what
4078 allowed in `font-spec'.
4080 If FONT is a font-entity or a font-object, KEY must not be the one
4081 accepted by `font-spec'. */)
4082 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4086 idx
= get_font_prop_index (prop
);
4087 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4089 CHECK_FONT_SPEC (font
);
4090 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4094 if (EQ (prop
, QCname
)
4095 || EQ (prop
, QCscript
)
4096 || EQ (prop
, QClang
)
4097 || EQ (prop
, QCotf
))
4098 CHECK_FONT_SPEC (font
);
4101 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4106 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4107 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4108 Optional 2nd argument FRAME specifies the target frame.
4109 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4110 Optional 4th argument PREFER, if non-nil, is a font-spec to
4111 control the order of the returned list. Fonts are sorted by
4112 how close they are to PREFER. */)
4113 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4115 Lisp_Object vec
, list
;
4119 frame
= selected_frame
;
4120 CHECK_LIVE_FRAME (frame
);
4121 CHECK_FONT_SPEC (font_spec
);
4129 if (! NILP (prefer
))
4130 CHECK_FONT_SPEC (prefer
);
4132 list
= font_list_entities (frame
, font_spec
);
4135 if (NILP (XCDR (list
))
4136 && ASIZE (XCAR (list
)) == 1)
4137 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4139 if (! NILP (prefer
))
4140 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4142 vec
= font_vconcat_entity_vectors (list
);
4143 if (n
== 0 || n
>= ASIZE (vec
))
4145 Lisp_Object args
[2];
4149 list
= Fappend (2, args
);
4153 for (list
= Qnil
, n
--; n
>= 0; n
--)
4154 list
= Fcons (AREF (vec
, n
), list
);
4159 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4160 doc
: /* List available font families on the current frame.
4161 Optional argument FRAME, if non-nil, specifies the target frame. */)
4165 struct font_driver_list
*driver_list
;
4169 frame
= selected_frame
;
4170 CHECK_LIVE_FRAME (frame
);
4173 for (driver_list
= f
->font_driver_list
; driver_list
;
4174 driver_list
= driver_list
->next
)
4175 if (driver_list
->driver
->list_family
)
4177 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4178 Lisp_Object tail
= list
;
4180 for (; CONSP (val
); val
= XCDR (val
))
4181 if (NILP (Fmemq (XCAR (val
), tail
))
4182 && SYMBOLP (XCAR (val
)))
4183 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4188 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4189 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4190 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4191 (Lisp_Object font_spec
, Lisp_Object frame
)
4193 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4200 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4201 doc
: /* Return XLFD name of FONT.
4202 FONT is a font-spec, font-entity, or font-object.
4203 If the name is too long for XLFD (maximum 255 chars), return nil.
4204 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4205 the consecutive wildcards are folded into one. */)
4206 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4209 int namelen
, pixel_size
= 0;
4213 if (FONT_OBJECT_P (font
))
4215 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4217 if (STRINGP (font_name
)
4218 && SDATA (font_name
)[0] == '-')
4220 if (NILP (fold_wildcards
))
4222 strcpy (name
, SSDATA (font_name
));
4223 namelen
= SBYTES (font_name
);
4226 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4228 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4232 if (! NILP (fold_wildcards
))
4234 char *p0
= name
, *p1
;
4236 while ((p1
= strstr (p0
, "-*-*")))
4238 strcpy (p1
, p1
+ 2);
4244 return make_string (name
, namelen
);
4247 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4248 doc
: /* Clear font cache. */)
4251 Lisp_Object list
, frame
;
4253 FOR_EACH_FRAME (list
, frame
)
4255 FRAME_PTR f
= XFRAME (frame
);
4256 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4258 for (; driver_list
; driver_list
= driver_list
->next
)
4259 if (driver_list
->on
)
4261 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4262 Lisp_Object val
, tmp
;
4266 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4268 eassert (! NILP (val
));
4269 tmp
= XCDR (XCAR (val
));
4270 if (XINT (XCAR (tmp
)) == 0)
4272 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4273 XSETCDR (cache
, XCDR (val
));
4283 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4285 struct font
*font
= XFONT_OBJECT (font_object
);
4286 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4287 struct font_metrics metrics
;
4289 LGLYPH_SET_CODE (glyph
, code
);
4290 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4291 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4292 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4293 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4294 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4295 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4299 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4300 doc
: /* Shape the glyph-string GSTRING.
4301 Shaping means substituting glyphs and/or adjusting positions of glyphs
4302 to get the correct visual image of character sequences set in the
4303 header of the glyph-string.
4305 If the shaping was successful, the value is GSTRING itself or a newly
4306 created glyph-string. Otherwise, the value is nil. */)
4307 (Lisp_Object gstring
)
4310 Lisp_Object font_object
, n
, glyph
;
4311 ptrdiff_t i
, j
, from
, to
;
4313 if (! composition_gstring_p (gstring
))
4314 signal_error ("Invalid glyph-string: ", gstring
);
4315 if (! NILP (LGSTRING_ID (gstring
)))
4317 font_object
= LGSTRING_FONT (gstring
);
4318 CHECK_FONT_OBJECT (font_object
);
4319 font
= XFONT_OBJECT (font_object
);
4320 if (! font
->driver
->shape
)
4323 /* Try at most three times with larger gstring each time. */
4324 for (i
= 0; i
< 3; i
++)
4326 n
= font
->driver
->shape (gstring
);
4329 gstring
= larger_vector (gstring
,
4330 LGSTRING_GLYPH_LEN (gstring
), -1);
4332 if (i
== 3 || XINT (n
) == 0)
4334 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4335 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4337 glyph
= LGSTRING_GLYPH (gstring
, 0);
4338 from
= LGLYPH_FROM (glyph
);
4339 to
= LGLYPH_TO (glyph
);
4340 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4342 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4346 if (NILP (LGLYPH_ADJUSTMENT (this)))
4351 glyph
= LGSTRING_GLYPH (gstring
, j
);
4352 LGLYPH_SET_FROM (glyph
, from
);
4353 LGLYPH_SET_TO (glyph
, to
);
4355 from
= LGLYPH_FROM (this);
4356 to
= LGLYPH_TO (this);
4361 if (from
> LGLYPH_FROM (this))
4362 from
= LGLYPH_FROM (this);
4363 if (to
< LGLYPH_TO (this))
4364 to
= LGLYPH_TO (this);
4370 glyph
= LGSTRING_GLYPH (gstring
, j
);
4371 LGLYPH_SET_FROM (glyph
, from
);
4372 LGLYPH_SET_TO (glyph
, to
);
4374 return composition_gstring_put_cache (gstring
, XINT (n
));
4377 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4379 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4380 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4382 VARIATION-SELECTOR is a character code of variation selection
4383 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4384 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4385 (Lisp_Object font_object
, Lisp_Object character
)
4387 unsigned variations
[256];
4392 CHECK_FONT_OBJECT (font_object
);
4393 CHECK_CHARACTER (character
);
4394 font
= XFONT_OBJECT (font_object
);
4395 if (! font
->driver
->get_variation_glyphs
)
4397 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4401 for (i
= 0; i
< 255; i
++)
4404 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4405 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4406 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4413 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4414 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4415 OTF-FEATURES specifies which features to apply in this format:
4416 (SCRIPT LANGSYS GSUB GPOS)
4418 SCRIPT is a symbol specifying a script tag of OpenType,
4419 LANGSYS is a symbol specifying a langsys tag of OpenType,
4420 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4422 If LANGYS is nil, the default langsys is selected.
4424 The features are applied in the order they appear in the list. The
4425 symbol `*' means to apply all available features not present in this
4426 list, and the remaining features are ignored. For instance, (vatu
4427 pstf * haln) is to apply vatu and pstf in this order, then to apply
4428 all available features other than vatu, pstf, and haln.
4430 The features are applied to the glyphs in the range FROM and TO of
4431 the glyph-string GSTRING-IN.
4433 If some feature is actually applicable, the resulting glyphs are
4434 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4435 this case, the value is the number of produced glyphs.
4437 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4440 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4441 produced in GSTRING-OUT, and the value is nil.
4443 See the documentation of `composition-get-gstring' for the format of
4445 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4447 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4452 check_otf_features (otf_features
);
4453 CHECK_FONT_OBJECT (font_object
);
4454 font
= XFONT_OBJECT (font_object
);
4455 if (! font
->driver
->otf_drive
)
4456 error ("Font backend %s can't drive OpenType GSUB table",
4457 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4458 CHECK_CONS (otf_features
);
4459 CHECK_SYMBOL (XCAR (otf_features
));
4460 val
= XCDR (otf_features
);
4461 CHECK_SYMBOL (XCAR (val
));
4462 val
= XCDR (otf_features
);
4465 len
= check_gstring (gstring_in
);
4466 CHECK_VECTOR (gstring_out
);
4467 CHECK_NATNUM (from
);
4469 CHECK_NATNUM (index
);
4471 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4472 args_out_of_range_3 (from
, to
, make_number (len
));
4473 if (XINT (index
) >= ASIZE (gstring_out
))
4474 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4475 num
= font
->driver
->otf_drive (font
, otf_features
,
4476 gstring_in
, XINT (from
), XINT (to
),
4477 gstring_out
, XINT (index
), 0);
4480 return make_number (num
);
4483 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4485 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4486 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4488 (SCRIPT LANGSYS FEATURE ...)
4489 See the documentation of `font-drive-otf' for more detail.
4491 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4492 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4493 character code corresponding to the glyph or nil if there's no
4494 corresponding character. */)
4495 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4498 Lisp_Object gstring_in
, gstring_out
, g
;
4499 Lisp_Object alternates
;
4502 CHECK_FONT_GET_OBJECT (font_object
, font
);
4503 if (! font
->driver
->otf_drive
)
4504 error ("Font backend %s can't drive OpenType GSUB table",
4505 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4506 CHECK_CHARACTER (character
);
4507 CHECK_CONS (otf_features
);
4509 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4510 g
= LGSTRING_GLYPH (gstring_in
, 0);
4511 LGLYPH_SET_CHAR (g
, XINT (character
));
4512 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4513 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4514 gstring_out
, 0, 1)) < 0)
4515 gstring_out
= Ffont_make_gstring (font_object
,
4516 make_number (ASIZE (gstring_out
) * 2));
4518 for (i
= 0; i
< num
; i
++)
4520 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4521 int c
= LGLYPH_CHAR (g
);
4522 unsigned code
= LGLYPH_CODE (g
);
4524 alternates
= Fcons (Fcons (make_number (code
),
4525 c
> 0 ? make_number (c
) : Qnil
),
4528 return Fnreverse (alternates
);
4534 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4535 doc
: /* Open FONT-ENTITY. */)
4536 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4540 CHECK_FONT_ENTITY (font_entity
);
4542 frame
= selected_frame
;
4543 CHECK_LIVE_FRAME (frame
);
4546 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4549 CHECK_NUMBER_OR_FLOAT (size
);
4551 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4553 isize
= XINT (size
);
4554 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4555 args_out_of_range (font_entity
, size
);
4559 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4562 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4563 doc
: /* Close FONT-OBJECT. */)
4564 (Lisp_Object font_object
, Lisp_Object frame
)
4566 CHECK_FONT_OBJECT (font_object
);
4568 frame
= selected_frame
;
4569 CHECK_LIVE_FRAME (frame
);
4570 font_close_object (XFRAME (frame
), font_object
);
4574 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4575 doc
: /* Return information about FONT-OBJECT.
4576 The value is a vector:
4577 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4580 NAME is the font name, a string (or nil if the font backend doesn't
4583 FILENAME is the font file name, a string (or nil if the font backend
4584 doesn't provide a file name).
4586 PIXEL-SIZE is a pixel size by which the font is opened.
4588 SIZE is a maximum advance width of the font in pixels.
4590 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4593 CAPABILITY is a list whose first element is a symbol representing the
4594 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4595 remaining elements describe the details of the font capability.
4597 If the font is OpenType font, the form of the list is
4598 \(opentype GSUB GPOS)
4599 where GSUB shows which "GSUB" features the font supports, and GPOS
4600 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4601 lists of the format:
4602 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4604 If the font is not OpenType font, currently the length of the form is
4607 SCRIPT is a symbol representing OpenType script tag.
4609 LANGSYS is a symbol representing OpenType langsys tag, or nil
4610 representing the default langsys.
4612 FEATURE is a symbol representing OpenType feature tag.
4614 If the font is not OpenType font, CAPABILITY is nil. */)
4615 (Lisp_Object font_object
)
4620 CHECK_FONT_GET_OBJECT (font_object
, font
);
4622 val
= Fmake_vector (make_number (9), Qnil
);
4623 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4624 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4625 ASET (val
, 2, make_number (font
->pixel_size
));
4626 ASET (val
, 3, make_number (font
->max_width
));
4627 ASET (val
, 4, make_number (font
->ascent
));
4628 ASET (val
, 5, make_number (font
->descent
));
4629 ASET (val
, 6, make_number (font
->space_width
));
4630 ASET (val
, 7, make_number (font
->average_width
));
4631 if (font
->driver
->otf_capability
)
4632 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4636 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4638 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4639 FROM and TO are positions (integers or markers) specifying a region
4640 of the current buffer.
4641 If the optional fourth arg OBJECT is not nil, it is a string or a
4642 vector containing the target characters.
4644 Each element is a vector containing information of a glyph in this format:
4645 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4647 FROM is an index numbers of a character the glyph corresponds to.
4648 TO is the same as FROM.
4649 C is the character of the glyph.
4650 CODE is the glyph-code of C in FONT-OBJECT.
4651 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4652 ADJUSTMENT is always nil.
4653 If FONT-OBJECT doesn't have a glyph for a character,
4654 the corresponding element is nil. */)
4655 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4660 Lisp_Object
*chars
, vec
;
4663 CHECK_FONT_GET_OBJECT (font_object
, font
);
4666 ptrdiff_t charpos
, bytepos
;
4668 validate_region (&from
, &to
);
4671 len
= XFASTINT (to
) - XFASTINT (from
);
4672 SAFE_ALLOCA_LISP (chars
, len
);
4673 charpos
= XFASTINT (from
);
4674 bytepos
= CHAR_TO_BYTE (charpos
);
4675 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4678 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4679 chars
[i
] = make_number (c
);
4682 else if (STRINGP (object
))
4684 const unsigned char *p
;
4686 CHECK_NUMBER (from
);
4688 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4689 || XINT (to
) > SCHARS (object
))
4690 args_out_of_range_3 (object
, from
, to
);
4693 len
= XFASTINT (to
) - XFASTINT (from
);
4694 SAFE_ALLOCA_LISP (chars
, len
);
4696 if (STRING_MULTIBYTE (object
))
4697 for (i
= 0; i
< len
; i
++)
4699 int c
= STRING_CHAR_ADVANCE (p
);
4700 chars
[i
] = make_number (c
);
4703 for (i
= 0; i
< len
; i
++)
4704 chars
[i
] = make_number (p
[i
]);
4708 CHECK_VECTOR (object
);
4709 CHECK_NUMBER (from
);
4711 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4712 || XINT (to
) > ASIZE (object
))
4713 args_out_of_range_3 (object
, from
, to
);
4716 len
= XFASTINT (to
) - XFASTINT (from
);
4717 for (i
= 0; i
< len
; i
++)
4719 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4720 CHECK_CHARACTER (elt
);
4722 chars
= aref_addr (object
, XFASTINT (from
));
4725 vec
= Fmake_vector (make_number (len
), Qnil
);
4726 for (i
= 0; i
< len
; i
++)
4729 int c
= XFASTINT (chars
[i
]);
4731 struct font_metrics metrics
;
4733 code
= font
->driver
->encode_char (font
, c
);
4734 if (code
== FONT_INVALID_CODE
)
4736 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4737 LGLYPH_SET_FROM (g
, i
);
4738 LGLYPH_SET_TO (g
, i
);
4739 LGLYPH_SET_CHAR (g
, c
);
4740 LGLYPH_SET_CODE (g
, code
);
4741 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4742 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4743 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4744 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4745 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4746 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4749 if (! VECTORP (object
))
4754 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4755 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4756 FONT is a font-spec, font-entity, or font-object. */)
4757 (Lisp_Object spec
, Lisp_Object font
)
4759 CHECK_FONT_SPEC (spec
);
4762 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4765 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4766 doc
: /* Return a font-object for displaying a character at POSITION.
4767 Optional second arg WINDOW, if non-nil, is a window displaying
4768 the current buffer. It defaults to the currently selected window. */)
4769 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4776 CHECK_NUMBER_COERCE_MARKER (position
);
4777 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4778 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4779 pos
= XINT (position
);
4783 CHECK_NUMBER (position
);
4784 CHECK_STRING (string
);
4785 if (! (0 < XINT (position
) && XINT (position
) < SCHARS (string
)))
4786 args_out_of_range (string
, position
);
4787 pos
= XINT (position
);
4790 window
= selected_window
;
4791 CHECK_LIVE_WINDOW (window
);
4792 w
= XWINDOW (window
);
4794 return font_at (-1, pos
, NULL
, w
, string
);
4798 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4799 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4800 The value is a number of glyphs drawn.
4801 Type C-l to recover what previously shown. */)
4802 (Lisp_Object font_object
, Lisp_Object string
)
4804 Lisp_Object frame
= selected_frame
;
4805 FRAME_PTR f
= XFRAME (frame
);
4811 CHECK_FONT_GET_OBJECT (font_object
, font
);
4812 CHECK_STRING (string
);
4813 len
= SCHARS (string
);
4814 code
= alloca (sizeof (unsigned) * len
);
4815 for (i
= 0; i
< len
; i
++)
4817 Lisp_Object ch
= Faref (string
, make_number (i
));
4821 code
[i
] = font
->driver
->encode_char (font
, c
);
4822 if (code
[i
] == FONT_INVALID_CODE
)
4825 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4827 if (font
->driver
->prepare_face
)
4828 font
->driver
->prepare_face (f
, face
);
4829 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4830 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4831 if (font
->driver
->done_face
)
4832 font
->driver
->done_face (f
, face
);
4834 return make_number (len
);
4838 #endif /* FONT_DEBUG */
4840 #ifdef HAVE_WINDOW_SYSTEM
4842 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4843 doc
: /* Return information about a font named NAME on frame FRAME.
4844 If FRAME is omitted or nil, use the selected frame.
4845 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4846 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4848 OPENED-NAME is the name used for opening the font,
4849 FULL-NAME is the full name of the font,
4850 SIZE is the pixelsize of the font,
4851 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4852 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4853 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4854 how to compose characters.
4855 If the named font is not yet loaded, return nil. */)
4856 (Lisp_Object name
, Lisp_Object frame
)
4861 Lisp_Object font_object
;
4863 (*check_window_system_func
) ();
4866 CHECK_STRING (name
);
4868 frame
= selected_frame
;
4869 CHECK_LIVE_FRAME (frame
);
4874 int fontset
= fs_query_fontset (name
, 0);
4877 name
= fontset_ascii (fontset
);
4878 font_object
= font_open_by_name (f
, name
);
4880 else if (FONT_OBJECT_P (name
))
4882 else if (FONT_ENTITY_P (name
))
4883 font_object
= font_open_entity (f
, name
, 0);
4886 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4887 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4889 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4891 if (NILP (font_object
))
4893 font
= XFONT_OBJECT (font_object
);
4895 info
= Fmake_vector (make_number (7), Qnil
);
4896 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4897 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4898 ASET (info
, 2, make_number (font
->pixel_size
));
4899 ASET (info
, 3, make_number (font
->height
));
4900 ASET (info
, 4, make_number (font
->baseline_offset
));
4901 ASET (info
, 5, make_number (font
->relative_compose
));
4902 ASET (info
, 6, make_number (font
->default_ascent
));
4905 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4906 close it now. Perhaps, we should manage font-objects
4907 by `reference-count'. */
4908 font_close_object (f
, font_object
);
4915 #define BUILD_STYLE_TABLE(TBL) \
4916 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4919 build_style_table (const struct table_entry
*entry
, int nelement
)
4922 Lisp_Object table
, elt
;
4924 table
= Fmake_vector (make_number (nelement
), Qnil
);
4925 for (i
= 0; i
< nelement
; i
++)
4927 for (j
= 0; entry
[i
].names
[j
]; j
++);
4928 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4929 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4930 for (j
= 0; entry
[i
].names
[j
]; j
++)
4931 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4932 ASET (table
, i
, elt
);
4937 /* The deferred font-log data of the form [ACTION ARG RESULT].
4938 If ACTION is not nil, that is added to the log when font_add_log is
4939 called next time. At that time, ACTION is set back to nil. */
4940 static Lisp_Object Vfont_log_deferred
;
4942 /* Prepend the font-related logging data in Vfont_log if it is not
4943 `t'. ACTION describes a kind of font-related action (e.g. listing,
4944 opening), ARG is the argument for the action, and RESULT is the
4945 result of the action. */
4947 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4952 if (EQ (Vfont_log
, Qt
))
4954 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4956 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4958 ASET (Vfont_log_deferred
, 0, Qnil
);
4959 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4960 AREF (Vfont_log_deferred
, 2));
4965 Lisp_Object tail
, elt
;
4966 Lisp_Object equalstr
= build_string ("=");
4968 val
= Ffont_xlfd_name (arg
, Qt
);
4969 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4973 if (EQ (XCAR (elt
), QCscript
)
4974 && SYMBOLP (XCDR (elt
)))
4975 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4976 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4977 else if (EQ (XCAR (elt
), QClang
)
4978 && SYMBOLP (XCDR (elt
)))
4979 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4980 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4981 else if (EQ (XCAR (elt
), QCotf
)
4982 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4983 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4985 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4991 && VECTORP (XCAR (result
))
4992 && ASIZE (XCAR (result
)) > 0
4993 && FONTP (AREF (XCAR (result
), 0)))
4994 result
= font_vconcat_entity_vectors (result
);
4997 val
= Ffont_xlfd_name (result
, Qt
);
4998 if (! FONT_SPEC_P (result
))
4999 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5000 build_string (":"), val
);
5003 else if (CONSP (result
))
5006 result
= Fcopy_sequence (result
);
5007 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5011 val
= Ffont_xlfd_name (val
, Qt
);
5012 XSETCAR (tail
, val
);
5015 else if (VECTORP (result
))
5017 result
= Fcopy_sequence (result
);
5018 for (i
= 0; i
< ASIZE (result
); i
++)
5020 val
= AREF (result
, i
);
5022 val
= Ffont_xlfd_name (val
, Qt
);
5023 ASET (result
, i
, val
);
5026 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5029 /* Record a font-related logging data to be added to Vfont_log when
5030 font_add_log is called next time. ACTION, ARG, RESULT are the same
5034 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5036 if (EQ (Vfont_log
, Qt
))
5038 ASET (Vfont_log_deferred
, 0, build_string (action
));
5039 ASET (Vfont_log_deferred
, 1, arg
);
5040 ASET (Vfont_log_deferred
, 2, result
);
5046 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5047 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5048 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5049 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5050 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5051 /* Note that the other elements in sort_shift_bits are not used. */
5053 staticpro (&font_charset_alist
);
5054 font_charset_alist
= Qnil
;
5056 DEFSYM (Qopentype
, "opentype");
5058 DEFSYM (Qascii_0
, "ascii-0");
5059 DEFSYM (Qiso8859_1
, "iso8859-1");
5060 DEFSYM (Qiso10646_1
, "iso10646-1");
5061 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5062 DEFSYM (Qunicode_sip
, "unicode-sip");
5066 DEFSYM (QCotf
, ":otf");
5067 DEFSYM (QClang
, ":lang");
5068 DEFSYM (QCscript
, ":script");
5069 DEFSYM (QCantialias
, ":antialias");
5071 DEFSYM (QCfoundry
, ":foundry");
5072 DEFSYM (QCadstyle
, ":adstyle");
5073 DEFSYM (QCregistry
, ":registry");
5074 DEFSYM (QCspacing
, ":spacing");
5075 DEFSYM (QCdpi
, ":dpi");
5076 DEFSYM (QCscalable
, ":scalable");
5077 DEFSYM (QCavgwidth
, ":avgwidth");
5078 DEFSYM (QCfont_entity
, ":font-entity");
5079 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5089 DEFSYM (QCuser_spec
, "user-spec");
5091 staticpro (&scratch_font_spec
);
5092 scratch_font_spec
= Ffont_spec (0, NULL
);
5093 staticpro (&scratch_font_prefer
);
5094 scratch_font_prefer
= Ffont_spec (0, NULL
);
5096 staticpro (&Vfont_log_deferred
);
5097 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5101 staticpro (&otf_list
);
5103 #endif /* HAVE_LIBOTF */
5107 defsubr (&Sfont_spec
);
5108 defsubr (&Sfont_get
);
5109 #ifdef HAVE_WINDOW_SYSTEM
5110 defsubr (&Sfont_face_attributes
);
5112 defsubr (&Sfont_put
);
5113 defsubr (&Slist_fonts
);
5114 defsubr (&Sfont_family_list
);
5115 defsubr (&Sfind_font
);
5116 defsubr (&Sfont_xlfd_name
);
5117 defsubr (&Sclear_font_cache
);
5118 defsubr (&Sfont_shape_gstring
);
5119 defsubr (&Sfont_variation_glyphs
);
5121 defsubr (&Sfont_drive_otf
);
5122 defsubr (&Sfont_otf_alternates
);
5126 defsubr (&Sopen_font
);
5127 defsubr (&Sclose_font
);
5128 defsubr (&Squery_font
);
5129 defsubr (&Sfont_get_glyphs
);
5130 defsubr (&Sfont_match_p
);
5131 defsubr (&Sfont_at
);
5133 defsubr (&Sdraw_string
);
5135 #endif /* FONT_DEBUG */
5136 #ifdef HAVE_WINDOW_SYSTEM
5137 defsubr (&Sfont_info
);
5140 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5142 Alist of fontname patterns vs the corresponding encoding and repertory info.
5143 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5144 where ENCODING is a charset or a char-table,
5145 and REPERTORY is a charset, a char-table, or nil.
5147 If ENCODING and REPERTORY are the same, the element can have the form
5148 \(REGEXP . ENCODING).
5150 ENCODING is for converting a character to a glyph code of the font.
5151 If ENCODING is a charset, encoding a character by the charset gives
5152 the corresponding glyph code. If ENCODING is a char-table, looking up
5153 the table by a character gives the corresponding glyph code.
5155 REPERTORY specifies a repertory of characters supported by the font.
5156 If REPERTORY is a charset, all characters belonging to the charset are
5157 supported. If REPERTORY is a char-table, all characters who have a
5158 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5159 gets the repertory information by an opened font and ENCODING. */);
5160 Vfont_encoding_alist
= Qnil
;
5162 /* FIXME: These 3 vars are not quite what they appear: setq on them
5163 won't have any effect other than disconnect them from the style
5164 table used by the font display code. So we make them read-only,
5165 to avoid this confusing situation. */
5167 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5168 doc
: /* Vector of valid font weight values.
5169 Each element has the form:
5170 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5171 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5172 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5173 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5175 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5176 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5177 See `font-weight-table' for the format of the vector. */);
5178 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5179 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5181 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5182 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5183 See `font-weight-table' for the format of the vector. */);
5184 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5185 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5187 staticpro (&font_style_table
);
5188 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5189 ASET (font_style_table
, 0, Vfont_weight_table
);
5190 ASET (font_style_table
, 1, Vfont_slant_table
);
5191 ASET (font_style_table
, 2, Vfont_width_table
);
5193 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5194 *Logging list of font related actions and results.
5195 The value t means to suppress the logging.
5196 The initial value is set to nil if the environment variable
5197 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5200 #ifdef HAVE_WINDOW_SYSTEM
5201 #ifdef HAVE_FREETYPE
5203 #ifdef HAVE_X_WINDOWS
5208 #endif /* HAVE_XFT */
5209 #endif /* HAVE_X_WINDOWS */
5210 #else /* not HAVE_FREETYPE */
5211 #ifdef HAVE_X_WINDOWS
5213 #endif /* HAVE_X_WINDOWS */
5214 #endif /* not HAVE_FREETYPE */
5217 #endif /* HAVE_BDFFONT */
5220 #endif /* WINDOWSNT */
5223 #endif /* HAVE_NS */
5224 #endif /* HAVE_WINDOW_SYSTEM */
5230 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;