1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2013 Free Software Foundation, Inc.
4 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
30 #include "character.h"
34 #include "dispextern.h"
36 #include "composite.h"
40 #ifdef HAVE_WINDOW_SYSTEM
42 #endif /* HAVE_WINDOW_SYSTEM */
44 Lisp_Object Qopentype
;
46 /* Important character set strings. */
47 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
49 #define DEFAULT_ENCODING Qiso8859_1
51 /* Unicode category `Cf'. */
52 static Lisp_Object QCf
;
54 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
55 static Lisp_Object font_style_table
;
57 /* Structure used for tables mapping weight, slant, and width numeric
58 values and their names. */
63 /* The first one is a valid name as a face attribute.
64 The second one (if any) is a typical name in XLFD field. */
68 /* Table of weight numeric values and their names. This table must be
69 sorted by numeric values in ascending order. */
71 static const struct table_entry weight_table
[] =
74 { 20, { "ultra-light", "ultralight" }},
75 { 40, { "extra-light", "extralight" }},
77 { 75, { "semi-light", "semilight", "demilight", "book" }},
78 { 100, { "normal", "medium", "regular", "unspecified" }},
79 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
81 { 205, { "extra-bold", "extrabold" }},
82 { 210, { "ultra-bold", "ultrabold", "black" }}
85 /* Table of slant numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static const struct table_entry slant_table
[] =
90 { 0, { "reverse-oblique", "ro" }},
91 { 10, { "reverse-italic", "ri" }},
92 { 100, { "normal", "r", "unspecified" }},
93 { 200, { "italic" ,"i", "ot" }},
94 { 210, { "oblique", "o" }}
97 /* Table of width numeric values and their names. This table must be
98 sorted by numeric values in ascending order. */
100 static const struct table_entry width_table
[] =
102 { 50, { "ultra-condensed", "ultracondensed" }},
103 { 63, { "extra-condensed", "extracondensed" }},
104 { 75, { "condensed", "compressed", "narrow" }},
105 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
106 { 100, { "normal", "medium", "regular", "unspecified" }},
107 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
108 { 125, { "expanded" }},
109 { 150, { "extra-expanded", "extraexpanded" }},
110 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
113 Lisp_Object QCfoundry
;
114 static Lisp_Object QCadstyle
, QCregistry
;
115 /* Symbols representing keys of font extra info. */
116 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
117 Lisp_Object QCantialias
, QCfont_entity
;
118 static Lisp_Object QCfc_unknown_spec
;
119 /* Symbols representing values of font spacing property. */
120 static Lisp_Object Qc
, Qm
, Qd
;
122 /* Special ADSTYLE properties to avoid fonts used for Latin
123 characters; used in xfont.c and ftfont.c. */
124 Lisp_Object Qja
, Qko
;
126 static Lisp_Object QCuser_spec
;
128 /* Alist of font registry symbols and the corresponding charset
129 information. The information is retrieved from
130 Vfont_encoding_alist on demand.
132 Eash element has the form:
133 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
137 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
138 encodes a character code to a glyph code of a font, and
139 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
140 character is supported by a font.
142 The latter form means that the information for REGISTRY couldn't be
144 static Lisp_Object font_charset_alist
;
146 /* List of all font drivers. Each font-backend (XXXfont.c) calls
147 register_font_driver in syms_of_XXXfont to register its font-driver
149 static struct font_driver_list
*font_driver_list
;
153 /* Creators of font-related Lisp object. */
156 font_make_spec (void)
158 Lisp_Object font_spec
;
159 struct font_spec
*spec
160 = ((struct font_spec
*)
161 allocate_pseudovector (VECSIZE (struct font_spec
),
162 FONT_SPEC_MAX
, PVEC_FONT
));
163 XSETFONT (font_spec
, spec
);
168 font_make_entity (void)
170 Lisp_Object font_entity
;
171 struct font_entity
*entity
172 = ((struct font_entity
*)
173 allocate_pseudovector (VECSIZE (struct font_entity
),
174 FONT_ENTITY_MAX
, PVEC_FONT
));
175 XSETFONT (font_entity
, entity
);
179 /* Create a font-object whose structure size is SIZE. If ENTITY is
180 not nil, copy properties from ENTITY to the font-object. If
181 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
183 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
185 Lisp_Object font_object
;
187 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
190 XSETFONT (font_object
, font
);
194 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
195 font
->props
[i
] = AREF (entity
, i
);
196 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
197 font
->props
[FONT_EXTRA_INDEX
]
198 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
201 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
207 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
208 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
209 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
211 static unsigned font_encode_char (Lisp_Object
, int);
213 /* Number of registered font drivers. */
214 static int num_font_drivers
;
217 /* Return a Lispy value of a font property value at STR and LEN bytes.
218 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
219 consist entirely of one or more digits, return a symbol interned
220 from STR. Otherwise, return an integer. */
223 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
228 ptrdiff_t nbytes
, nchars
;
230 if (len
== 1 && *str
== '*')
232 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
234 for (i
= 1; i
< len
; i
++)
235 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
242 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
245 return make_number (n
);
246 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
250 xsignal1 (Qoverflow_error
, make_string (str
, len
));
254 /* This code is similar to intern function from lread.c. */
255 obarray
= check_obarray (Vobarray
);
256 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
257 tem
= oblookup (obarray
, str
,
258 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
262 if (len
== nchars
|| len
!= nbytes
)
263 tem
= make_unibyte_string (str
, len
);
265 tem
= make_multibyte_string (str
, nchars
, len
);
266 return Fintern (tem
, obarray
);
269 /* Return a pixel size of font-spec SPEC on frame F. */
272 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
274 #ifdef HAVE_WINDOW_SYSTEM
275 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
284 eassert (FLOATP (size
));
285 point_size
= XFLOAT_DATA (size
);
286 val
= AREF (spec
, FONT_DPI_INDEX
);
290 dpi
= FRAME_RES_Y (f
);
291 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
299 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
300 font vector. If VAL is not valid (i.e. not registered in
301 font_style_table), return -1 if NOERROR is zero, and return a
302 proper index if NOERROR is nonzero. In that case, register VAL in
303 font_style_table if VAL is a symbol, and return the closest index if
304 VAL is an integer. */
307 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
310 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
313 CHECK_VECTOR (table
);
320 Lisp_Object args
[2], elt
;
322 /* At first try exact match. */
323 for (i
= 0; i
< len
; i
++)
325 CHECK_VECTOR (AREF (table
, i
));
326 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
327 if (EQ (val
, AREF (AREF (table
, i
), j
)))
329 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
330 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
331 | (i
<< 4) | (j
- 1));
334 /* Try also with case-folding match. */
335 s
= SSDATA (SYMBOL_NAME (val
));
336 for (i
= 0; i
< len
; i
++)
337 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
339 elt
= AREF (AREF (table
, i
), j
);
340 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
342 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
343 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
344 | (i
<< 4) | (j
- 1));
350 elt
= Fmake_vector (make_number (2), make_number (100));
353 args
[1] = Fmake_vector (make_number (1), elt
);
354 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
355 return (100 << 8) | (i
<< 4);
360 EMACS_INT numeric
= XINT (val
);
362 for (i
= 0, last_n
= -1; i
< len
; i
++)
366 CHECK_VECTOR (AREF (table
, i
));
367 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
368 n
= XINT (AREF (AREF (table
, i
), 0));
370 return (n
<< 8) | (i
<< 4);
375 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
376 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
382 return ((last_n
<< 8) | ((i
- 1) << 4));
387 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
390 Lisp_Object val
= AREF (font
, prop
);
391 Lisp_Object table
, elt
;
396 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
397 CHECK_VECTOR (table
);
398 i
= XINT (val
) & 0xFF;
399 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
400 elt
= AREF (table
, ((i
>> 4) & 0xF));
402 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
403 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
408 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
409 FONTNAME. ENCODING is a charset symbol that specifies the encoding
410 of the font. REPERTORY is a charset symbol or nil. */
413 find_font_encoding (Lisp_Object fontname
)
415 Lisp_Object tail
, elt
;
417 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
421 && STRINGP (XCAR (elt
))
422 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
423 && (SYMBOLP (XCDR (elt
))
424 ? CHARSETP (XCDR (elt
))
425 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
431 /* Return encoding charset and repertory charset for REGISTRY in
432 ENCODING and REPERTORY correspondingly. If correct information for
433 REGISTRY is available, return 0. Otherwise return -1. */
436 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
439 int encoding_id
, repertory_id
;
441 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
447 encoding_id
= XINT (XCAR (val
));
448 repertory_id
= XINT (XCDR (val
));
452 val
= find_font_encoding (SYMBOL_NAME (registry
));
453 if (SYMBOLP (val
) && CHARSETP (val
))
455 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
457 else if (CONSP (val
))
459 if (! CHARSETP (XCAR (val
)))
461 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
462 if (NILP (XCDR (val
)))
466 if (! CHARSETP (XCDR (val
)))
468 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
473 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
475 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
479 *encoding
= CHARSET_FROM_ID (encoding_id
);
481 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
486 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
491 /* Font property value validators. See the comment of
492 font_property_table for the meaning of the arguments. */
494 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
495 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
496 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
497 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
498 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
499 static int get_font_prop_index (Lisp_Object
);
502 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
505 val
= Fintern (val
, Qnil
);
508 else if (EQ (prop
, QCregistry
))
509 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
515 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
517 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
518 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
522 EMACS_INT n
= XINT (val
);
523 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
525 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
529 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
532 if ((n
& 0xF) + 1 >= ASIZE (elt
))
536 CHECK_NUMBER (AREF (elt
, 0));
537 if (XINT (AREF (elt
, 0)) != (n
>> 8))
542 else if (SYMBOLP (val
))
544 int n
= font_style_to_value (prop
, val
, 0);
546 val
= n
>= 0 ? make_number (n
) : Qerror
;
554 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
556 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
561 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
563 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
565 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
567 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
569 if (spacing
== 'c' || spacing
== 'C')
570 return make_number (FONT_SPACING_CHARCELL
);
571 if (spacing
== 'm' || spacing
== 'M')
572 return make_number (FONT_SPACING_MONO
);
573 if (spacing
== 'p' || spacing
== 'P')
574 return make_number (FONT_SPACING_PROPORTIONAL
);
575 if (spacing
== 'd' || spacing
== 'D')
576 return make_number (FONT_SPACING_DUAL
);
582 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
584 Lisp_Object tail
, tmp
;
587 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
588 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
589 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
592 if (! SYMBOLP (XCAR (val
)))
597 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
599 for (i
= 0; i
< 2; i
++)
606 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
607 if (! SYMBOLP (XCAR (tmp
)))
615 /* Structure of known font property keys and validator of the
619 /* Pointer to the key symbol. */
621 /* Function to validate PROP's value VAL, or NULL if any value is
622 ok. The value is VAL or its regularized value if VAL is valid,
623 and Qerror if not. */
624 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
625 } font_property_table
[] =
626 { { &QCtype
, font_prop_validate_symbol
},
627 { &QCfoundry
, font_prop_validate_symbol
},
628 { &QCfamily
, font_prop_validate_symbol
},
629 { &QCadstyle
, font_prop_validate_symbol
},
630 { &QCregistry
, font_prop_validate_symbol
},
631 { &QCweight
, font_prop_validate_style
},
632 { &QCslant
, font_prop_validate_style
},
633 { &QCwidth
, font_prop_validate_style
},
634 { &QCsize
, font_prop_validate_non_neg
},
635 { &QCdpi
, font_prop_validate_non_neg
},
636 { &QCspacing
, font_prop_validate_spacing
},
637 { &QCavgwidth
, font_prop_validate_non_neg
},
638 /* The order of the above entries must match with enum
639 font_property_index. */
640 { &QClang
, font_prop_validate_symbol
},
641 { &QCscript
, font_prop_validate_symbol
},
642 { &QCotf
, font_prop_validate_otf
}
645 /* Size (number of elements) of the above table. */
646 #define FONT_PROPERTY_TABLE_SIZE \
647 ((sizeof font_property_table) / (sizeof *font_property_table))
649 /* Return an index number of font property KEY or -1 if KEY is not an
650 already known property. */
653 get_font_prop_index (Lisp_Object key
)
657 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
658 if (EQ (key
, *font_property_table
[i
].key
))
663 /* Validate the font property. The property key is specified by the
664 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
665 signal an error. The value is VAL or the regularized one. */
668 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
670 Lisp_Object validated
;
675 prop
= *font_property_table
[idx
].key
;
678 idx
= get_font_prop_index (prop
);
682 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
683 if (EQ (validated
, Qerror
))
684 signal_error ("invalid font property", Fcons (prop
, val
));
689 /* Store VAL as a value of extra font property PROP in FONT while
690 keeping the sorting order. Don't check the validity of VAL. */
693 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
695 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
696 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
700 Lisp_Object prev
= Qnil
;
703 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
704 prev
= extra
, extra
= XCDR (extra
);
707 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
709 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
715 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
720 /* Font name parser and unparser. */
722 static int parse_matrix (const char *);
723 static int font_expand_wildcards (Lisp_Object
*, int);
724 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
726 /* An enumerator for each field of an XLFD font name. */
727 enum xlfd_field_index
746 /* An enumerator for mask bit corresponding to each XLFD field. */
749 XLFD_FOUNDRY_MASK
= 0x0001,
750 XLFD_FAMILY_MASK
= 0x0002,
751 XLFD_WEIGHT_MASK
= 0x0004,
752 XLFD_SLANT_MASK
= 0x0008,
753 XLFD_SWIDTH_MASK
= 0x0010,
754 XLFD_ADSTYLE_MASK
= 0x0020,
755 XLFD_PIXEL_MASK
= 0x0040,
756 XLFD_POINT_MASK
= 0x0080,
757 XLFD_RESX_MASK
= 0x0100,
758 XLFD_RESY_MASK
= 0x0200,
759 XLFD_SPACING_MASK
= 0x0400,
760 XLFD_AVGWIDTH_MASK
= 0x0800,
761 XLFD_REGISTRY_MASK
= 0x1000,
762 XLFD_ENCODING_MASK
= 0x2000
766 /* Parse P pointing to the pixel/point size field of the form
767 `[A B C D]' which specifies a transformation matrix:
773 by which all glyphs of the font are transformed. The spec says
774 that scalar value N for the pixel/point size is equivalent to:
775 A = N * resx/resy, B = C = 0, D = N.
777 Return the scalar value N if the form is valid. Otherwise return
781 parse_matrix (const char *p
)
787 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
790 matrix
[i
] = - strtod (p
+ 1, &end
);
792 matrix
[i
] = strtod (p
, &end
);
795 return (i
== 4 ? (int) matrix
[3] : -1);
798 /* Expand a wildcard field in FIELD (the first N fields are filled) to
799 multiple fields to fill in all 14 XLFD fields while restricting a
800 field position by its contents. */
803 font_expand_wildcards (Lisp_Object
*field
, int n
)
806 Lisp_Object tmp
[XLFD_LAST_INDEX
];
807 /* Array of information about where this element can go. Nth
808 element is for Nth element of FIELD. */
810 /* Minimum possible field. */
812 /* Maximum possible field. */
814 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
816 } range
[XLFD_LAST_INDEX
];
818 int range_from
, range_to
;
821 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
822 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
823 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
824 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
825 | XLFD_AVGWIDTH_MASK)
826 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
828 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
829 field. The value is shifted to left one bit by one in the
831 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
832 range_mask
= (range_mask
<< 1) | 1;
834 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
835 position-based restriction for FIELD[I]. */
836 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
837 i
++, range_from
++, range_to
++, range_mask
<<= 1)
839 Lisp_Object val
= field
[i
];
845 range
[i
].from
= range_from
;
846 range
[i
].to
= range_to
;
847 range
[i
].mask
= range_mask
;
851 /* The triplet FROM, TO, and MASK is a value-based
852 restriction for FIELD[I]. */
858 EMACS_INT numeric
= XINT (val
);
861 from
= to
= XLFD_ENCODING_INDEX
,
862 mask
= XLFD_ENCODING_MASK
;
863 else if (numeric
== 0)
864 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
865 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
866 else if (numeric
<= 48)
867 from
= to
= XLFD_PIXEL_INDEX
,
868 mask
= XLFD_PIXEL_MASK
;
870 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
871 mask
= XLFD_LARGENUM_MASK
;
873 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
874 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
875 mask
= XLFD_NULL_MASK
;
877 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
880 Lisp_Object name
= SYMBOL_NAME (val
);
882 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
883 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
884 mask
= XLFD_REGENC_MASK
;
886 from
= to
= XLFD_ENCODING_INDEX
,
887 mask
= XLFD_ENCODING_MASK
;
889 else if (range_from
<= XLFD_WEIGHT_INDEX
890 && range_to
>= XLFD_WEIGHT_INDEX
891 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
892 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
893 else if (range_from
<= XLFD_SLANT_INDEX
894 && range_to
>= XLFD_SLANT_INDEX
895 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
896 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
897 else if (range_from
<= XLFD_SWIDTH_INDEX
898 && range_to
>= XLFD_SWIDTH_INDEX
899 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
900 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
903 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
904 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
906 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
907 mask
= XLFD_SYMBOL_MASK
;
910 /* Merge position-based and value-based restrictions. */
912 while (from
< range_from
)
913 mask
&= ~(1 << from
++);
914 while (from
< 14 && ! (mask
& (1 << from
)))
916 while (to
> range_to
)
917 mask
&= ~(1 << to
--);
918 while (to
>= 0 && ! (mask
& (1 << to
)))
922 range
[i
].from
= from
;
924 range
[i
].mask
= mask
;
926 if (from
> range_from
|| to
< range_to
)
928 /* The range is narrowed by value-based restrictions.
929 Reflect it to the other fields. */
931 /* Following fields should be after FROM. */
933 /* Preceding fields should be before TO. */
934 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
936 /* Check FROM for non-wildcard field. */
937 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
939 while (range
[j
].from
< from
)
940 range
[j
].mask
&= ~(1 << range
[j
].from
++);
941 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
943 range
[j
].from
= from
;
946 from
= range
[j
].from
;
947 if (range
[j
].to
> to
)
949 while (range
[j
].to
> to
)
950 range
[j
].mask
&= ~(1 << range
[j
].to
--);
951 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
964 /* Decide all fields from restrictions in RANGE. */
965 for (i
= j
= 0; i
< n
; i
++)
967 if (j
< range
[i
].from
)
969 if (i
== 0 || ! NILP (tmp
[i
- 1]))
970 /* None of TMP[X] corresponds to Jth field. */
972 for (; j
< range
[i
].from
; j
++)
977 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
979 for (; j
< XLFD_LAST_INDEX
; j
++)
981 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
982 field
[XLFD_ENCODING_INDEX
]
983 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
988 /* Parse NAME (null terminated) as XLFD and store information in FONT
989 (font-spec or font-entity). Size property of FONT is set as
991 specified XLFD fields FONT property
992 --------------------- -------------
993 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
994 POINT_SIZE and RESY calculated pixel size (Lisp integer)
995 POINT_SIZE POINT_SIZE/10 (Lisp float)
997 If NAME is successfully parsed, return 0. Otherwise return -1.
999 FONT is usually a font-spec, but when this function is called from
1000 X font backend driver, it is a font-entity. In that case, NAME is
1001 a fully specified XLFD. */
1004 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1007 char *f
[XLFD_LAST_INDEX
+ 1];
1011 if (len
> 255 || !len
)
1012 /* Maximum XLFD name length is 255. */
1014 /* Accept "*-.." as a fully specified XLFD. */
1015 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1016 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1019 for (p
= name
+ i
; *p
; p
++)
1023 if (i
== XLFD_LAST_INDEX
)
1028 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1029 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1031 if (i
== XLFD_LAST_INDEX
)
1033 /* Fully specified XLFD. */
1036 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1037 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1038 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1039 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1041 val
= INTERN_FIELD_SYM (i
);
1044 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1046 ASET (font
, j
, make_number (n
));
1049 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1050 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1051 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1053 ASET (font
, FONT_REGISTRY_INDEX
,
1054 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1055 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1057 p
= f
[XLFD_PIXEL_INDEX
];
1058 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1059 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1062 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1064 ASET (font
, FONT_SIZE_INDEX
, val
);
1065 else if (FONT_ENTITY_P (font
))
1069 double point_size
= -1;
1071 eassert (FONT_SPEC_P (font
));
1072 p
= f
[XLFD_POINT_INDEX
];
1074 point_size
= parse_matrix (p
);
1075 else if (c_isdigit (*p
))
1076 point_size
= atoi (p
), point_size
/= 10;
1077 if (point_size
>= 0)
1078 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1082 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1083 if (! NILP (val
) && ! INTEGERP (val
))
1085 ASET (font
, FONT_DPI_INDEX
, val
);
1086 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1089 val
= font_prop_validate_spacing (QCspacing
, val
);
1090 if (! INTEGERP (val
))
1092 ASET (font
, FONT_SPACING_INDEX
, val
);
1094 p
= f
[XLFD_AVGWIDTH_INDEX
];
1097 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1098 if (! NILP (val
) && ! INTEGERP (val
))
1100 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1104 bool wild_card_found
= 0;
1105 Lisp_Object prop
[XLFD_LAST_INDEX
];
1107 if (FONT_ENTITY_P (font
))
1109 for (j
= 0; j
< i
; j
++)
1113 if (f
[j
][1] && f
[j
][1] != '-')
1116 wild_card_found
= 1;
1119 prop
[j
] = INTERN_FIELD (j
);
1121 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1123 if (! wild_card_found
)
1125 if (font_expand_wildcards (prop
, i
) < 0)
1128 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1129 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1130 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1131 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1132 if (! NILP (prop
[i
]))
1134 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1136 ASET (font
, j
, make_number (n
));
1138 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1139 val
= prop
[XLFD_REGISTRY_INDEX
];
1142 val
= prop
[XLFD_ENCODING_INDEX
];
1144 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1146 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1147 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1149 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1150 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1152 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1154 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1155 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1156 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1158 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1160 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1163 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1164 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1165 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1167 val
= font_prop_validate_spacing (QCspacing
,
1168 prop
[XLFD_SPACING_INDEX
]);
1169 if (! INTEGERP (val
))
1171 ASET (font
, FONT_SPACING_INDEX
, val
);
1173 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1174 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1180 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1181 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1182 0, use PIXEL_SIZE instead. */
1185 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1188 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1192 eassert (FONTP (font
));
1194 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1197 if (i
== FONT_ADSTYLE_INDEX
)
1198 j
= XLFD_ADSTYLE_INDEX
;
1199 else if (i
== FONT_REGISTRY_INDEX
)
1200 j
= XLFD_REGISTRY_INDEX
;
1201 val
= AREF (font
, i
);
1204 if (j
== XLFD_REGISTRY_INDEX
)
1212 val
= SYMBOL_NAME (val
);
1213 if (j
== XLFD_REGISTRY_INDEX
1214 && ! strchr (SSDATA (val
), '-'))
1216 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1217 ptrdiff_t alloc
= SBYTES (val
) + 4;
1218 if (nbytes
<= alloc
)
1220 f
[j
] = p
= alloca (alloc
);
1221 sprintf (p
, "%s%s-*", SDATA (val
),
1222 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1225 f
[j
] = SSDATA (val
);
1229 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1232 val
= font_style_symbolic (font
, i
, 0);
1240 val
= SYMBOL_NAME (val
);
1241 alloc
= SBYTES (val
) + 1;
1242 if (nbytes
<= alloc
)
1244 f
[j
] = p
= alloca (alloc
);
1245 /* Copy the name while excluding '-', '?', ',', and '"'. */
1246 for (k
= l
= 0; k
< alloc
; k
++)
1249 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1255 val
= AREF (font
, FONT_SIZE_INDEX
);
1256 eassert (NUMBERP (val
) || NILP (val
));
1259 EMACS_INT v
= XINT (val
);
1264 f
[XLFD_PIXEL_INDEX
] = p
=
1265 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1266 sprintf (p
, "%"pI
"d-*", v
);
1269 f
[XLFD_PIXEL_INDEX
] = "*-*";
1271 else if (FLOATP (val
))
1273 double v
= XFLOAT_DATA (val
) * 10;
1274 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1275 sprintf (p
, "*-%.0f", v
);
1278 f
[XLFD_PIXEL_INDEX
] = "*-*";
1280 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1282 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1283 f
[XLFD_RESX_INDEX
] = p
=
1284 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1285 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1288 f
[XLFD_RESX_INDEX
] = "*-*";
1289 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1291 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1293 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1294 : spacing
<= FONT_SPACING_DUAL
? "d"
1295 : spacing
<= FONT_SPACING_MONO
? "m"
1299 f
[XLFD_SPACING_INDEX
] = "*";
1300 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1302 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1303 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1306 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1307 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1308 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1309 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1310 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1311 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1312 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1313 f
[XLFD_REGISTRY_INDEX
]);
1314 return len
< nbytes
? len
: -1;
1317 /* Parse NAME (null terminated) and store information in FONT
1318 (font-spec or font-entity). NAME is supplied in either the
1319 Fontconfig or GTK font name format. If NAME is successfully
1320 parsed, return 0. Otherwise return -1.
1322 The fontconfig format is
1324 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1328 FAMILY [PROPS...] [SIZE]
1330 This function tries to guess which format it is. */
1333 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1336 char *size_beg
= NULL
, *size_end
= NULL
;
1337 char *props_beg
= NULL
, *family_end
= NULL
;
1342 for (p
= name
; *p
; p
++)
1344 if (*p
== '\\' && p
[1])
1348 props_beg
= family_end
= p
;
1353 bool decimal
= 0, size_found
= 1;
1354 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1355 if (! c_isdigit (*q
))
1357 if (*q
!= '.' || decimal
)
1376 Lisp_Object extra_props
= Qnil
;
1378 /* A fontconfig name with size and/or property data. */
1379 if (family_end
> name
)
1382 family
= font_intern_prop (name
, family_end
- name
, 1);
1383 ASET (font
, FONT_FAMILY_INDEX
, family
);
1387 double point_size
= strtod (size_beg
, &size_end
);
1388 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1389 if (*size_end
== ':' && size_end
[1])
1390 props_beg
= size_end
;
1394 /* Now parse ":KEY=VAL" patterns. */
1397 for (p
= props_beg
; *p
; p
= q
)
1399 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1402 /* Must be an enumerated value. */
1406 val
= font_intern_prop (p
, q
- p
, 1);
1408 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1409 && memcmp (p, STR, strlen (STR)) == 0)
1411 if (PROP_MATCH ("light")
1412 || PROP_MATCH ("medium")
1413 || PROP_MATCH ("demibold")
1414 || PROP_MATCH ("bold")
1415 || PROP_MATCH ("black"))
1416 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1417 else if (PROP_MATCH ("roman")
1418 || PROP_MATCH ("italic")
1419 || PROP_MATCH ("oblique"))
1420 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1421 else if (PROP_MATCH ("charcell"))
1422 ASET (font
, FONT_SPACING_INDEX
,
1423 make_number (FONT_SPACING_CHARCELL
));
1424 else if (PROP_MATCH ("mono"))
1425 ASET (font
, FONT_SPACING_INDEX
,
1426 make_number (FONT_SPACING_MONO
));
1427 else if (PROP_MATCH ("proportional"))
1428 ASET (font
, FONT_SPACING_INDEX
,
1429 make_number (FONT_SPACING_PROPORTIONAL
));
1438 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1439 prop
= FONT_SIZE_INDEX
;
1442 key
= font_intern_prop (p
, q
- p
, 1);
1443 prop
= get_font_prop_index (key
);
1447 for (q
= p
; *q
&& *q
!= ':'; q
++);
1448 val
= font_intern_prop (p
, q
- p
, 0);
1450 if (prop
>= FONT_FOUNDRY_INDEX
1451 && prop
< FONT_EXTRA_INDEX
)
1452 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1455 extra_props
= nconc2 (extra_props
,
1456 list1 (Fcons (key
, val
)));
1463 if (! NILP (extra_props
))
1465 struct font_driver_list
*driver_list
= font_driver_list
;
1466 for ( ; driver_list
; driver_list
= driver_list
->next
)
1467 if (driver_list
->driver
->filter_properties
)
1468 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1474 /* Either a fontconfig-style name with no size and property
1475 data, or a GTK-style name. */
1476 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1477 Lisp_Object width
= Qnil
, size
= Qnil
;
1481 /* Scan backwards from the end, looking for a size. */
1482 for (p
= name
+ len
- 1; p
>= name
; p
--)
1483 if (!c_isdigit (*p
))
1486 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1487 /* Found a font size. */
1488 size
= make_float (strtod (p
+ 1, NULL
));
1492 /* Now P points to the termination of the string, sans size.
1493 Scan backwards, looking for font properties. */
1494 for (; p
> name
; p
= q
)
1496 for (q
= p
- 1; q
>= name
; q
--)
1498 if (q
> name
&& *(q
-1) == '\\')
1499 --q
; /* Skip quoting backslashes. */
1505 word_len
= p
- word_start
;
1507 #define PROP_MATCH(STR) \
1508 (word_len == strlen (STR) \
1509 && memcmp (word_start, STR, strlen (STR)) == 0)
1510 #define PROP_SAVE(VAR, STR) \
1511 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1513 if (PROP_MATCH ("Ultra-Light"))
1514 PROP_SAVE (weight
, "ultra-light");
1515 else if (PROP_MATCH ("Light"))
1516 PROP_SAVE (weight
, "light");
1517 else if (PROP_MATCH ("Book"))
1518 PROP_SAVE (weight
, "book");
1519 else if (PROP_MATCH ("Medium"))
1520 PROP_SAVE (weight
, "medium");
1521 else if (PROP_MATCH ("Semi-Bold"))
1522 PROP_SAVE (weight
, "semi-bold");
1523 else if (PROP_MATCH ("Bold"))
1524 PROP_SAVE (weight
, "bold");
1525 else if (PROP_MATCH ("Italic"))
1526 PROP_SAVE (slant
, "italic");
1527 else if (PROP_MATCH ("Oblique"))
1528 PROP_SAVE (slant
, "oblique");
1529 else if (PROP_MATCH ("Semi-Condensed"))
1530 PROP_SAVE (width
, "semi-condensed");
1531 else if (PROP_MATCH ("Condensed"))
1532 PROP_SAVE (width
, "condensed");
1533 /* An unknown word must be part of the font name. */
1544 ASET (font
, FONT_FAMILY_INDEX
,
1545 font_intern_prop (name
, family_end
- name
, 1));
1547 ASET (font
, FONT_SIZE_INDEX
, size
);
1549 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1551 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1553 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1559 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1560 NAME (NBYTES length), and return the name length. If
1561 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1564 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1566 Lisp_Object family
, foundry
;
1572 Lisp_Object styles
[3];
1573 const char *style_names
[3] = { "weight", "slant", "width" };
1575 family
= AREF (font
, FONT_FAMILY_INDEX
);
1576 if (! NILP (family
))
1578 if (SYMBOLP (family
))
1579 family
= SYMBOL_NAME (family
);
1584 val
= AREF (font
, FONT_SIZE_INDEX
);
1587 if (XINT (val
) != 0)
1588 pixel_size
= XINT (val
);
1593 eassert (FLOATP (val
));
1595 point_size
= (int) XFLOAT_DATA (val
);
1598 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1599 if (! NILP (foundry
))
1601 if (SYMBOLP (foundry
))
1602 foundry
= SYMBOL_NAME (foundry
);
1607 for (i
= 0; i
< 3; i
++)
1608 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1611 lim
= name
+ nbytes
;
1612 if (! NILP (family
))
1614 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1615 if (! (0 <= len
&& len
< lim
- p
))
1621 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1622 if (! (0 <= len
&& len
< lim
- p
))
1626 else if (pixel_size
> 0)
1628 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1629 if (! (0 <= len
&& len
< lim
- p
))
1633 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1635 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1636 SSDATA (SYMBOL_NAME (AREF (font
,
1637 FONT_FOUNDRY_INDEX
))));
1638 if (! (0 <= len
&& len
< lim
- p
))
1642 for (i
= 0; i
< 3; i
++)
1643 if (! NILP (styles
[i
]))
1645 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1646 SSDATA (SYMBOL_NAME (styles
[i
])));
1647 if (! (0 <= len
&& len
< lim
- p
))
1652 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1654 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1655 XINT (AREF (font
, FONT_DPI_INDEX
)));
1656 if (! (0 <= len
&& len
< lim
- p
))
1661 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1663 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1664 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1665 if (! (0 <= len
&& len
< lim
- p
))
1670 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1672 int len
= snprintf (p
, lim
- p
,
1673 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1675 : ":scalable=false"));
1676 if (! (0 <= len
&& len
< lim
- p
))
1684 /* Parse NAME (null terminated) and store information in FONT
1685 (font-spec or font-entity). If NAME is successfully parsed, return
1686 0. Otherwise return -1. */
1689 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1691 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1692 return font_parse_xlfd (name
, namelen
, font
);
1693 return font_parse_fcname (name
, namelen
, font
);
1697 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1698 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1702 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1708 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1710 CHECK_STRING (family
);
1711 len
= SBYTES (family
);
1712 p0
= SSDATA (family
);
1713 p1
= strchr (p0
, '-');
1716 if ((*p0
!= '*' && p1
- p0
> 0)
1717 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1718 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1721 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1724 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1726 if (! NILP (registry
))
1728 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1729 CHECK_STRING (registry
);
1730 len
= SBYTES (registry
);
1731 p0
= SSDATA (registry
);
1732 p1
= strchr (p0
, '-');
1735 if (SDATA (registry
)[len
- 1] == '*')
1736 registry
= concat2 (registry
, build_string ("-*"));
1738 registry
= concat2 (registry
, build_string ("*-*"));
1740 registry
= Fdowncase (registry
);
1741 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1746 /* This part (through the next ^L) is still experimental and not
1747 tested much. We may drastically change codes. */
1753 #define LGSTRING_HEADER_SIZE 6
1754 #define LGSTRING_GLYPH_SIZE 8
1757 check_gstring (Lisp_Object gstring
)
1763 CHECK_VECTOR (gstring
);
1764 val
= AREF (gstring
, 0);
1766 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1768 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1769 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1770 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1771 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1772 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1773 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1774 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1775 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1776 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1777 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1778 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1780 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1782 val
= LGSTRING_GLYPH (gstring
, i
);
1784 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1786 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1788 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1789 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1790 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1791 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1792 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1793 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1794 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1795 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1797 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1799 if (ASIZE (val
) < 3)
1801 for (j
= 0; j
< 3; j
++)
1802 CHECK_NUMBER (AREF (val
, j
));
1807 error ("Invalid glyph-string format");
1812 check_otf_features (Lisp_Object otf_features
)
1816 CHECK_CONS (otf_features
);
1817 CHECK_SYMBOL (XCAR (otf_features
));
1818 otf_features
= XCDR (otf_features
);
1819 CHECK_CONS (otf_features
);
1820 CHECK_SYMBOL (XCAR (otf_features
));
1821 otf_features
= XCDR (otf_features
);
1822 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1824 CHECK_SYMBOL (XCAR (val
));
1825 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1826 error ("Invalid OTF GSUB feature: %s",
1827 SDATA (SYMBOL_NAME (XCAR (val
))));
1829 otf_features
= XCDR (otf_features
);
1830 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1832 CHECK_SYMBOL (XCAR (val
));
1833 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1834 error ("Invalid OTF GPOS feature: %s",
1835 SDATA (SYMBOL_NAME (XCAR (val
))));
1842 Lisp_Object otf_list
;
1845 otf_tag_symbol (OTF_Tag tag
)
1849 OTF_tag_name (tag
, name
);
1850 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1854 otf_open (Lisp_Object file
)
1856 Lisp_Object val
= Fassoc (file
, otf_list
);
1860 otf
= XSAVE_POINTER (XCDR (val
), 0);
1863 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1864 val
= make_save_ptr (otf
);
1865 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1871 /* Return a list describing which scripts/languages FONT supports by
1872 which GSUB/GPOS features of OpenType tables. See the comment of
1873 (struct font_driver).otf_capability. */
1876 font_otf_capability (struct font
*font
)
1879 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1882 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1885 for (i
= 0; i
< 2; i
++)
1887 OTF_GSUB_GPOS
*gsub_gpos
;
1888 Lisp_Object script_list
= Qnil
;
1891 if (OTF_get_features (otf
, i
== 0) < 0)
1893 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1894 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1896 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1897 Lisp_Object langsys_list
= Qnil
;
1898 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1901 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1903 OTF_LangSys
*langsys
;
1904 Lisp_Object feature_list
= Qnil
;
1905 Lisp_Object langsys_tag
;
1908 if (k
== script
->LangSysCount
)
1910 langsys
= &script
->DefaultLangSys
;
1915 langsys
= script
->LangSys
+ k
;
1917 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1919 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1921 OTF_Feature
*feature
1922 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1923 Lisp_Object feature_tag
1924 = otf_tag_symbol (feature
->FeatureTag
);
1926 feature_list
= Fcons (feature_tag
, feature_list
);
1928 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1931 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1936 XSETCAR (capability
, script_list
);
1938 XSETCDR (capability
, script_list
);
1944 /* Parse OTF features in SPEC and write a proper features spec string
1945 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1946 assured that the sufficient memory has already allocated for
1950 generate_otf_features (Lisp_Object spec
, char *features
)
1958 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1964 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1969 else if (! asterisk
)
1971 val
= SYMBOL_NAME (val
);
1972 p
+= esprintf (p
, "%s", SDATA (val
));
1976 val
= SYMBOL_NAME (val
);
1977 p
+= esprintf (p
, "~%s", SDATA (val
));
1981 error ("OTF spec too long");
1985 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1987 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1989 return Fcons (make_number (len
),
1990 make_unibyte_string (device_table
->DeltaValue
, len
));
1994 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
1996 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1998 if (value_format
& OTF_XPlacement
)
1999 ASET (val
, 0, make_number (value_record
->XPlacement
));
2000 if (value_format
& OTF_YPlacement
)
2001 ASET (val
, 1, make_number (value_record
->YPlacement
));
2002 if (value_format
& OTF_XAdvance
)
2003 ASET (val
, 2, make_number (value_record
->XAdvance
));
2004 if (value_format
& OTF_YAdvance
)
2005 ASET (val
, 3, make_number (value_record
->YAdvance
));
2006 if (value_format
& OTF_XPlaDevice
)
2007 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2008 if (value_format
& OTF_YPlaDevice
)
2009 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2010 if (value_format
& OTF_XAdvDevice
)
2011 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2012 if (value_format
& OTF_YAdvDevice
)
2013 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2018 font_otf_Anchor (OTF_Anchor
*anchor
)
2022 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2023 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2024 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2025 if (anchor
->AnchorFormat
== 2)
2026 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2029 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2030 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2034 #endif /* HAVE_LIBOTF */
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));
2099 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2102 /* Score the size. Maximum difference is 127. */
2103 i
= FONT_SIZE_INDEX
;
2104 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2105 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2107 /* We use the higher 6-bit for the actual size difference. The
2108 lowest bit is set if the DPI is different. */
2110 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2112 if (CONSP (Vface_font_rescale_alist
))
2113 pixel_size
*= font_rescale_ratio (entity
);
2114 diff
= eabs (pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
))) << 1;
2115 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2116 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2118 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2119 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2121 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2128 /* Concatenate all elements of LIST into one vector. LIST is a list
2129 of font-entity vectors. */
2132 font_vconcat_entity_vectors (Lisp_Object list
)
2134 int nargs
= XINT (Flength (list
));
2135 Lisp_Object
*args
= alloca (word_size
* nargs
);
2138 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2139 args
[i
] = XCAR (list
);
2140 return Fvconcat (nargs
, args
);
2144 /* The structure for elements being sorted by qsort. */
2145 struct font_sort_data
2148 int font_driver_preference
;
2153 /* The comparison function for qsort. */
2156 font_compare (const void *d1
, const void *d2
)
2158 const struct font_sort_data
*data1
= d1
;
2159 const struct font_sort_data
*data2
= d2
;
2161 if (data1
->score
< data2
->score
)
2163 else if (data1
->score
> data2
->score
)
2165 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2169 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2170 If PREFER specifies a point-size, calculate the corresponding
2171 pixel-size from QCdpi property of PREFER or from the Y-resolution
2172 of FRAME before sorting.
2174 If BEST-ONLY is nonzero, return the best matching entity (that
2175 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2176 if BEST-ONLY is negative). Otherwise, return the sorted result as
2177 a single vector of font-entities.
2179 This function does no optimization for the case that the total
2180 number of elements is 1. The caller should avoid calling this in
2184 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2185 struct frame
*f
, int best_only
)
2187 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2189 struct font_sort_data
*data
;
2190 unsigned best_score
;
2191 Lisp_Object best_entity
;
2192 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2195 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2196 prefer_prop
[i
] = AREF (prefer
, i
);
2197 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2198 prefer_prop
[FONT_SIZE_INDEX
]
2199 = make_number (font_pixel_size (f
, prefer
));
2201 if (NILP (XCDR (list
)))
2203 /* What we have to take care of is this single vector. */
2205 maxlen
= ASIZE (vec
);
2209 /* We don't have to perform sort, so there's no need of creating
2210 a single vector. But, we must find the length of the longest
2213 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2214 if (maxlen
< ASIZE (XCAR (tail
)))
2215 maxlen
= ASIZE (XCAR (tail
));
2219 /* We have to create a single vector to sort it. */
2220 vec
= font_vconcat_entity_vectors (list
);
2221 maxlen
= ASIZE (vec
);
2224 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2225 best_score
= 0xFFFFFFFF;
2228 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2230 int font_driver_preference
= 0;
2231 Lisp_Object current_font_driver
;
2237 /* We are sure that the length of VEC > 0. */
2238 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2239 /* Score the elements. */
2240 for (i
= 0; i
< len
; i
++)
2242 data
[i
].entity
= AREF (vec
, i
);
2244 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2246 ? font_score (data
[i
].entity
, prefer_prop
)
2248 if (best_only
&& best_score
> data
[i
].score
)
2250 best_score
= data
[i
].score
;
2251 best_entity
= data
[i
].entity
;
2252 if (best_score
== 0)
2255 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2257 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2258 font_driver_preference
++;
2260 data
[i
].font_driver_preference
= font_driver_preference
;
2263 /* Sort if necessary. */
2266 qsort (data
, len
, sizeof *data
, font_compare
);
2267 for (i
= 0; i
< len
; i
++)
2268 ASET (vec
, i
, data
[i
].entity
);
2277 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2282 /* API of Font Service Layer. */
2284 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2285 sort_shift_bits. Finternal_set_font_selection_order calls this
2286 function with font_sort_order after setting up it. */
2289 font_update_sort_order (int *order
)
2293 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2295 int xlfd_idx
= order
[i
];
2297 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2298 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2299 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2300 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2301 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2302 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2304 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2309 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2310 Lisp_Object features
, Lisp_Object table
)
2315 table
= assq_no_quit (script
, table
);
2318 table
= XCDR (table
);
2319 if (! NILP (langsys
))
2321 table
= assq_no_quit (langsys
, table
);
2327 val
= assq_no_quit (Qnil
, table
);
2329 table
= XCAR (table
);
2333 table
= XCDR (table
);
2334 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2336 if (NILP (XCAR (features
)))
2341 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2347 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2350 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2352 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2354 script
= XCAR (spec
);
2358 langsys
= XCAR (spec
);
2369 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2370 XCAR (otf_capability
)))
2372 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2373 XCDR (otf_capability
)))
2380 /* Check if FONT (font-entity or font-object) matches with the font
2381 specification SPEC. */
2384 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2386 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2387 Lisp_Object extra
, font_extra
;
2390 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2391 if (! NILP (AREF (spec
, i
))
2392 && ! NILP (AREF (font
, i
))
2393 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2395 props
= XFONT_SPEC (spec
)->props
;
2396 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2398 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2399 prop
[i
] = AREF (spec
, i
);
2400 prop
[FONT_SIZE_INDEX
]
2401 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2405 if (font_score (font
, props
) > 0)
2407 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2408 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2409 for (; CONSP (extra
); extra
= XCDR (extra
))
2411 Lisp_Object key
= XCAR (XCAR (extra
));
2412 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2414 if (EQ (key
, QClang
))
2416 val2
= assq_no_quit (key
, font_extra
);
2425 if (NILP (Fmemq (val
, val2
)))
2430 ? NILP (Fmemq (val
, XCDR (val2
)))
2434 else if (EQ (key
, QCscript
))
2436 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2442 /* All characters in the list must be supported. */
2443 for (; CONSP (val2
); val2
= XCDR (val2
))
2445 if (! CHARACTERP (XCAR (val2
)))
2447 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2448 == FONT_INVALID_CODE
)
2452 else if (VECTORP (val2
))
2454 /* At most one character in the vector must be supported. */
2455 for (i
= 0; i
< ASIZE (val2
); i
++)
2457 if (! CHARACTERP (AREF (val2
, i
)))
2459 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2460 != FONT_INVALID_CODE
)
2463 if (i
== ASIZE (val2
))
2468 else if (EQ (key
, QCotf
))
2472 if (! FONT_OBJECT_P (font
))
2474 fontp
= XFONT_OBJECT (font
);
2475 if (! fontp
->driver
->otf_capability
)
2477 val2
= fontp
->driver
->otf_capability (fontp
);
2478 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2489 Each font backend has the callback function get_cache, and it
2490 returns a cons cell of which cdr part can be freely used for
2491 caching fonts. The cons cell may be shared by multiple frames
2492 and/or multiple font drivers. So, we arrange the cdr part as this:
2494 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2496 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2497 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2498 cons (FONT-SPEC FONT-ENTITY ...). */
2500 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2501 static void font_finish_cache (struct frame
*, struct font_driver
*);
2502 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2503 static void font_clear_cache (struct frame
*, Lisp_Object
,
2504 struct font_driver
*);
2507 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2509 Lisp_Object cache
, val
;
2511 cache
= driver
->get_cache (f
);
2513 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2517 val
= list2 (driver
->type
, make_number (1));
2518 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2522 val
= XCDR (XCAR (val
));
2523 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2529 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2531 Lisp_Object cache
, val
, tmp
;
2534 cache
= driver
->get_cache (f
);
2536 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2537 cache
= val
, val
= XCDR (val
);
2538 eassert (! NILP (val
));
2539 tmp
= XCDR (XCAR (val
));
2540 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2541 if (XINT (XCAR (tmp
)) == 0)
2543 font_clear_cache (f
, XCAR (val
), driver
);
2544 XSETCDR (cache
, XCDR (val
));
2550 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2552 Lisp_Object val
= driver
->get_cache (f
);
2553 Lisp_Object type
= driver
->type
;
2555 eassert (CONSP (val
));
2556 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2557 eassert (CONSP (val
));
2558 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2559 val
= XCDR (XCAR (val
));
2565 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2567 Lisp_Object tail
, elt
;
2568 Lisp_Object tail2
, entity
;
2570 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2571 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2574 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2575 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2577 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2579 entity
= XCAR (tail2
);
2581 if (FONT_ENTITY_P (entity
)
2582 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2584 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2586 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2588 Lisp_Object val
= XCAR (objlist
);
2589 struct font
*font
= XFONT_OBJECT (val
);
2591 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2593 eassert (font
&& driver
== font
->driver
);
2594 driver
->close (font
);
2597 if (driver
->free_entity
)
2598 driver
->free_entity (entity
);
2603 XSETCDR (cache
, Qnil
);
2607 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2609 /* Check each font-entity in VEC, and return a list of font-entities
2610 that satisfy these conditions:
2611 (1) matches with SPEC and SIZE if SPEC is not nil, and
2612 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2616 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2618 Lisp_Object entity
, val
;
2619 enum font_property_index prop
;
2622 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2624 entity
= AREF (vec
, i
);
2625 if (! NILP (Vface_ignored_fonts
))
2629 Lisp_Object tail
, regexp
;
2631 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2634 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2636 regexp
= XCAR (tail
);
2637 if (STRINGP (regexp
)
2638 && fast_c_string_match_ignore_case (regexp
, name
,
2648 val
= Fcons (entity
, val
);
2651 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2652 if (INTEGERP (AREF (spec
, prop
))
2653 && ((XINT (AREF (spec
, prop
)) >> 8)
2654 != (XINT (AREF (entity
, prop
)) >> 8)))
2655 prop
= FONT_SPEC_MAX
;
2656 if (prop
< FONT_SPEC_MAX
2658 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2660 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2662 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2663 prop
= FONT_SPEC_MAX
;
2665 if (prop
< FONT_SPEC_MAX
2666 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2667 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2668 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2669 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2670 prop
= FONT_SPEC_MAX
;
2671 if (prop
< FONT_SPEC_MAX
2672 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2673 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2674 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2675 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2676 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2677 prop
= FONT_SPEC_MAX
;
2678 if (prop
< FONT_SPEC_MAX
)
2679 val
= Fcons (entity
, val
);
2681 return (Fvconcat (1, &val
));
2685 /* Return a list of vectors of font-entities matching with SPEC on
2686 FRAME. Each elements in the list is a vector of entities from the
2687 same font-driver. */
2690 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2692 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2693 Lisp_Object ftype
, val
;
2694 Lisp_Object list
= Qnil
;
2696 bool need_filtering
= 0;
2699 eassert (FONT_SPEC_P (spec
));
2701 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2702 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2703 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2704 size
= font_pixel_size (f
, spec
);
2708 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2709 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2710 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2711 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2712 if (i
!= FONT_SPACING_INDEX
)
2714 ASET (scratch_font_spec
, i
, Qnil
);
2715 if (! NILP (AREF (spec
, i
)))
2718 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2719 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2721 for (; driver_list
; driver_list
= driver_list
->next
)
2723 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2725 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2727 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2728 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2735 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2739 val
= Fvconcat (1, &val
);
2740 copy
= copy_font_spec (scratch_font_spec
);
2741 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2742 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2746 || ! NILP (Vface_ignored_fonts
)))
2747 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2748 if (ASIZE (val
) > 0)
2749 list
= Fcons (val
, list
);
2752 list
= Fnreverse (list
);
2753 FONT_ADD_LOG ("list", spec
, list
);
2758 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2759 nil, is an array of face's attributes, which specifies preferred
2760 font-related attributes. */
2763 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2765 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2766 Lisp_Object ftype
, size
, entity
;
2767 Lisp_Object work
= copy_font_spec (spec
);
2769 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2770 size
= AREF (spec
, FONT_SIZE_INDEX
);
2773 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2774 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2775 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2776 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2779 for (; driver_list
; driver_list
= driver_list
->next
)
2781 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2783 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2786 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2787 entity
= assoc_no_quit (work
, XCDR (cache
));
2789 entity
= XCDR (entity
);
2792 entity
= driver_list
->driver
->match (f
, work
);
2793 copy
= copy_font_spec (work
);
2794 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2795 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2797 if (! NILP (entity
))
2800 FONT_ADD_LOG ("match", work
, entity
);
2805 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2806 opened font object. */
2809 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2811 struct font_driver_list
*driver_list
;
2812 Lisp_Object objlist
, size
, val
, font_object
;
2814 int min_width
, height
, psize
;
2816 eassert (FONT_ENTITY_P (entity
));
2817 size
= AREF (entity
, FONT_SIZE_INDEX
);
2818 if (XINT (size
) != 0)
2819 pixel_size
= XINT (size
);
2821 val
= AREF (entity
, FONT_TYPE_INDEX
);
2822 for (driver_list
= f
->font_driver_list
;
2823 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2824 driver_list
= driver_list
->next
);
2828 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2829 objlist
= XCDR (objlist
))
2831 Lisp_Object fn
= XCAR (objlist
);
2832 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2833 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2835 if (driver_list
->driver
->cached_font_ok
== NULL
2836 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2841 /* We always open a font of manageable size; i.e non-zero average
2842 width and height. */
2843 for (psize
= pixel_size
; ; psize
++)
2845 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2846 if (NILP (font_object
))
2848 font
= XFONT_OBJECT (font_object
);
2849 if (font
->average_width
> 0 && font
->height
> 0)
2852 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2853 FONT_ADD_LOG ("open", entity
, font_object
);
2854 ASET (entity
, FONT_OBJLIST_INDEX
,
2855 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2857 font
= XFONT_OBJECT (font_object
);
2858 min_width
= (font
->min_width
? font
->min_width
2859 : font
->average_width
? font
->average_width
2860 : font
->space_width
? font
->space_width
2862 height
= (font
->height
? font
->height
: 1);
2863 #ifdef HAVE_WINDOW_SYSTEM
2864 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2865 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2867 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2868 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2869 f
->fonts_changed
= 1;
2873 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2874 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2875 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2876 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2884 /* Close FONT_OBJECT that is opened on frame F. */
2887 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2889 struct font
*font
= XFONT_OBJECT (font_object
);
2891 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2892 /* Already closed. */
2894 FONT_ADD_LOG ("close", font_object
, Qnil
);
2895 font
->driver
->close (font
);
2896 #ifdef HAVE_WINDOW_SYSTEM
2897 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2898 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2903 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2904 FONT is a font-entity and it must be opened to check. */
2907 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2911 if (FONT_ENTITY_P (font
))
2913 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2914 struct font_driver_list
*driver_list
;
2916 for (driver_list
= f
->font_driver_list
;
2917 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2918 driver_list
= driver_list
->next
);
2921 if (! driver_list
->driver
->has_char
)
2923 return driver_list
->driver
->has_char (font
, c
);
2926 eassert (FONT_OBJECT_P (font
));
2927 fontp
= XFONT_OBJECT (font
);
2928 if (fontp
->driver
->has_char
)
2930 int result
= fontp
->driver
->has_char (font
, c
);
2935 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2939 /* Return the glyph ID of FONT_OBJECT for character C. */
2942 font_encode_char (Lisp_Object font_object
, int c
)
2946 eassert (FONT_OBJECT_P (font_object
));
2947 font
= XFONT_OBJECT (font_object
);
2948 return font
->driver
->encode_char (font
, c
);
2952 /* Return the name of FONT_OBJECT. */
2955 font_get_name (Lisp_Object font_object
)
2957 eassert (FONT_OBJECT_P (font_object
));
2958 return AREF (font_object
, FONT_NAME_INDEX
);
2962 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2963 could not be parsed by font_parse_name, return Qnil. */
2966 font_spec_from_name (Lisp_Object font_name
)
2968 Lisp_Object spec
= Ffont_spec (0, NULL
);
2970 CHECK_STRING (font_name
);
2971 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2973 font_put_extra (spec
, QCname
, font_name
);
2974 font_put_extra (spec
, QCuser_spec
, font_name
);
2980 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2982 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2987 if (! NILP (Ffont_get (font
, QCname
)))
2989 font
= copy_font_spec (font
);
2990 font_put_extra (font
, QCname
, Qnil
);
2993 if (NILP (AREF (font
, prop
))
2994 && prop
!= FONT_FAMILY_INDEX
2995 && prop
!= FONT_FOUNDRY_INDEX
2996 && prop
!= FONT_WIDTH_INDEX
2997 && prop
!= FONT_SIZE_INDEX
)
2999 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3000 font
= copy_font_spec (font
);
3001 ASET (font
, prop
, Qnil
);
3002 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3004 if (prop
== FONT_FAMILY_INDEX
)
3006 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3007 /* If we are setting the font family, we must also clear
3008 FONT_WIDTH_INDEX to avoid rejecting families that lack
3009 support for some widths. */
3010 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3012 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3013 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3014 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3015 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3016 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3017 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3019 else if (prop
== FONT_SIZE_INDEX
)
3021 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3022 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3023 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3025 else if (prop
== FONT_WIDTH_INDEX
)
3026 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3027 attrs
[LFACE_FONT_INDEX
] = font
;
3030 /* Select a font from ENTITIES (list of font-entity vectors) that
3031 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3034 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3035 Lisp_Object
*attrs
, int pixel_size
, int c
)
3037 Lisp_Object font_entity
;
3041 if (NILP (XCDR (entities
))
3042 && ASIZE (XCAR (entities
)) == 1)
3044 font_entity
= AREF (XCAR (entities
), 0);
3045 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3050 /* Sort fonts by properties specified in ATTRS. */
3051 prefer
= scratch_font_prefer
;
3053 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3054 ASET (prefer
, i
, Qnil
);
3055 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3057 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3059 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3060 ASET (prefer
, i
, AREF (face_font
, i
));
3062 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3063 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3064 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3065 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3066 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3067 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3068 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3070 return font_sort_entities (entities
, prefer
, f
, c
);
3073 /* Return a font-entity that satisfies SPEC and is the best match for
3074 face's font related attributes in ATTRS. C, if not negative, is a
3075 character that the entity must support. */
3078 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3081 Lisp_Object entities
, val
;
3082 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3087 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3088 if (NILP (registry
[0]))
3090 registry
[0] = DEFAULT_ENCODING
;
3091 registry
[1] = Qascii_0
;
3092 registry
[2] = zero_vector
;
3095 registry
[1] = zero_vector
;
3097 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3099 struct charset
*encoding
, *repertory
;
3101 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3102 &encoding
, &repertory
) < 0)
3105 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3107 else if (c
> encoding
->max_char
)
3111 work
= copy_font_spec (spec
);
3112 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3113 pixel_size
= font_pixel_size (f
, spec
);
3114 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3116 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3118 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3122 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3123 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3124 if (! NILP (foundry
[0]))
3125 foundry
[1] = zero_vector
;
3126 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3128 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3129 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3131 foundry
[2] = zero_vector
;
3134 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3136 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3137 if (! NILP (adstyle
[0]))
3138 adstyle
[1] = zero_vector
;
3139 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3141 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3143 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3145 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3147 adstyle
[2] = zero_vector
;
3150 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3153 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3156 val
= AREF (work
, FONT_FAMILY_INDEX
);
3157 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3159 val
= attrs
[LFACE_FAMILY_INDEX
];
3160 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3164 family
= alloca ((sizeof family
[0]) * 2);
3166 family
[1] = zero_vector
; /* terminator. */
3171 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3173 if (! NILP (alters
))
3175 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3176 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3177 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3178 family
[i
] = XCAR (alters
);
3179 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3181 family
[i
] = zero_vector
;
3185 family
= alloca ((sizeof family
[0]) * 3);
3188 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3190 family
[i
] = zero_vector
;
3194 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3196 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3197 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3199 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3200 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3202 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3203 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3205 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3206 entities
= font_list_entities (f
, work
);
3207 if (! NILP (entities
))
3209 val
= font_select_entity (f
, entities
,
3210 attrs
, pixel_size
, c
);
3228 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3232 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3233 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3234 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3237 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3238 size
= font_pixel_size (f
, spec
);
3242 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3243 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3246 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3247 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3248 eassert (INTEGERP (height
));
3253 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3257 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3258 size
= (NUMBERP (ffsize
)
3259 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3263 size
*= font_rescale_ratio (entity
);
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 (struct frame
*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 (struct frame
*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 (struct frame
*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 (struct frame
*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 (struct frame
*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
, struct frame
*f
)
3382 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3383 struct font_driver_list
*prev
, *list
;
3385 #ifdef HAVE_WINDOW_SYSTEM
3386 if (f
&& ! driver
->draw
)
3387 error ("Unusable font driver for a frame: %s",
3388 SDATA (SYMBOL_NAME (driver
->type
)));
3389 #endif /* HAVE_WINDOW_SYSTEM */
3391 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3392 if (EQ (list
->driver
->type
, driver
->type
))
3393 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3395 list
= xmalloc (sizeof *list
);
3397 list
->driver
= driver
;
3402 f
->font_driver_list
= list
;
3404 font_driver_list
= list
;
3410 free_font_driver_list (struct frame
*f
)
3412 struct font_driver_list
*list
, *next
;
3414 for (list
= f
->font_driver_list
; list
; list
= next
)
3419 f
->font_driver_list
= NULL
;
3423 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3424 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3425 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3427 A caller must free all realized faces if any in advance. The
3428 return value is a list of font backends actually made used on
3432 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3434 Lisp_Object active_drivers
= Qnil
;
3435 struct font_driver_list
*list
;
3437 /* At first, turn off non-requested drivers, and turn on requested
3439 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3441 struct font_driver
*driver
= list
->driver
;
3442 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3447 if (driver
->end_for_frame
)
3448 driver
->end_for_frame (f
);
3449 font_finish_cache (f
, driver
);
3454 if (! driver
->start_for_frame
3455 || driver
->start_for_frame (f
) == 0)
3457 font_prepare_cache (f
, driver
);
3464 if (NILP (new_drivers
))
3467 if (! EQ (new_drivers
, Qt
))
3469 /* Re-order the driver list according to new_drivers. */
3470 struct font_driver_list
**list_table
, **next
;
3474 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3475 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3477 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3478 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3481 list_table
[i
++] = list
;
3483 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3485 list_table
[i
++] = list
;
3486 list_table
[i
] = NULL
;
3488 next
= &f
->font_driver_list
;
3489 for (i
= 0; list_table
[i
]; i
++)
3491 *next
= list_table
[i
];
3492 next
= &(*next
)->next
;
3496 if (! f
->font_driver_list
->on
)
3497 { /* None of the drivers is enabled: enable them all.
3498 Happens if you set the list of drivers to (xft x) in your .emacs
3499 and then use it under w32 or ns. */
3500 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3502 struct font_driver
*driver
= list
->driver
;
3503 eassert (! list
->on
);
3504 if (! driver
->start_for_frame
3505 || driver
->start_for_frame (f
) == 0)
3507 font_prepare_cache (f
, driver
);
3514 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3516 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3517 return active_drivers
;
3521 font_put_frame_data (struct frame
*f
, struct font_driver
*driver
, void *data
)
3523 struct font_data_list
*list
, *prev
;
3525 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3526 prev
= list
, list
= list
->next
)
3527 if (list
->driver
== driver
)
3534 prev
->next
= list
->next
;
3536 f
->font_data_list
= list
->next
;
3544 list
= xmalloc (sizeof *list
);
3545 list
->driver
= driver
;
3546 list
->next
= f
->font_data_list
;
3547 f
->font_data_list
= list
;
3555 font_get_frame_data (struct frame
*f
, struct font_driver
*driver
)
3557 struct font_data_list
*list
;
3559 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3560 if (list
->driver
== driver
)
3568 /* Sets attributes on a font. Any properties that appear in ALIST and
3569 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3570 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3571 arrays of strings. This function is intended for use by the font
3572 drivers to implement their specific font_filter_properties. */
3574 font_filter_properties (Lisp_Object font
,
3576 const char *const boolean_properties
[],
3577 const char *const non_boolean_properties
[])
3582 /* Set boolean values to Qt or Qnil. */
3583 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3584 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3586 Lisp_Object key
= XCAR (XCAR (it
));
3587 Lisp_Object val
= XCDR (XCAR (it
));
3588 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3590 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3592 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3593 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3596 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3597 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3598 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3599 || strcmp ("Off", str
) == 0)
3604 Ffont_put (font
, key
, val
);
3608 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3609 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3611 Lisp_Object key
= XCAR (XCAR (it
));
3612 Lisp_Object val
= XCDR (XCAR (it
));
3613 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3614 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3615 Ffont_put (font
, key
, val
);
3620 /* Return the font used to draw character C by FACE at buffer position
3621 POS in window W. If STRING is non-nil, it is a string containing C
3622 at index POS. If C is negative, get C from the current buffer or
3626 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3631 Lisp_Object font_object
;
3633 multibyte
= (NILP (string
)
3634 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3635 : STRING_MULTIBYTE (string
));
3642 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3644 c
= FETCH_CHAR (pos_byte
);
3647 c
= FETCH_BYTE (pos
);
3653 multibyte
= STRING_MULTIBYTE (string
);
3656 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3658 str
= SDATA (string
) + pos_byte
;
3659 c
= STRING_CHAR (str
);
3662 c
= SDATA (string
)[pos
];
3666 f
= XFRAME (w
->frame
);
3667 if (! FRAME_WINDOW_P (f
))
3674 if (STRINGP (string
))
3675 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3676 DEFAULT_FACE_ID
, 0);
3678 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3680 face
= FACE_FROM_ID (f
, face_id
);
3684 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3685 face
= FACE_FROM_ID (f
, face_id
);
3690 XSETFONT (font_object
, face
->font
);
3695 #ifdef HAVE_WINDOW_SYSTEM
3697 /* Check how many characters after character/byte position POS/POS_BYTE
3698 (at most to *LIMIT) can be displayed by the same font in the window W.
3699 FACE, if non-NULL, is the face selected for the character at POS.
3700 If STRING is not nil, it is the string to check instead of the current
3701 buffer. In that case, FACE must be not NULL.
3703 The return value is the font-object for the character at POS.
3704 *LIMIT is set to the position where that font can't be used.
3706 It is assured that the current buffer (or STRING) is multibyte. */
3709 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3710 struct window
*w
, struct face
*face
, Lisp_Object string
)
3714 Lisp_Object font_object
= Qnil
;
3722 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3724 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3730 while (pos
< *limit
)
3732 Lisp_Object category
;
3735 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3737 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3738 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3739 if (INTEGERP (category
)
3740 && (XINT (category
) == UNICODE_CATEGORY_Cf
3741 || CHAR_VARIATION_SELECTOR_P (c
)))
3743 if (NILP (font_object
))
3745 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3746 if (NILP (font_object
))
3750 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3760 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3761 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3762 Return nil otherwise.
3763 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3764 which kind of font it is. It must be one of `font-spec', `font-entity',
3766 (Lisp_Object object
, Lisp_Object extra_type
)
3768 if (NILP (extra_type
))
3769 return (FONTP (object
) ? Qt
: Qnil
);
3770 if (EQ (extra_type
, Qfont_spec
))
3771 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3772 if (EQ (extra_type
, Qfont_entity
))
3773 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3774 if (EQ (extra_type
, Qfont_object
))
3775 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3776 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3779 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3780 doc
: /* Return a newly created font-spec with arguments as properties.
3782 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3783 valid font property name listed below:
3785 `:family', `:weight', `:slant', `:width'
3787 They are the same as face attributes of the same name. See
3788 `set-face-attribute'.
3792 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3796 VALUE must be a string or a symbol specifying the additional
3797 typographic style information of a font, e.g. ``sans''.
3801 VALUE must be a string or a symbol specifying the charset registry and
3802 encoding of a font, e.g. ``iso8859-1''.
3806 VALUE must be a non-negative integer or a floating point number
3807 specifying the font size. It specifies the font size in pixels (if
3808 VALUE is an integer), or in points (if VALUE is a float).
3812 VALUE must be a string of XLFD-style or fontconfig-style font name.
3816 VALUE must be a symbol representing a script that the font must
3817 support. It may be a symbol representing a subgroup of a script
3818 listed in the variable `script-representative-chars'.
3822 VALUE must be a symbol of two-letter ISO-639 language names,
3827 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3828 required OpenType features.
3830 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3831 LANGSYS-TAG: OpenType language system tag symbol,
3832 or nil for the default language system.
3833 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3834 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3836 GSUB and GPOS may contain `nil' element. In such a case, the font
3837 must not have any of the remaining elements.
3839 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3840 be an OpenType font whose GPOS table of `thai' script's default
3841 language system must contain `mark' feature.
3843 usage: (font-spec ARGS...) */)
3844 (ptrdiff_t nargs
, Lisp_Object
*args
)
3846 Lisp_Object spec
= font_make_spec ();
3849 for (i
= 0; i
< nargs
; i
+= 2)
3851 Lisp_Object key
= args
[i
], val
;
3855 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3858 if (EQ (key
, QCname
))
3861 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3862 error ("Invalid font name: %s", SSDATA (val
));
3863 font_put_extra (spec
, key
, val
);
3867 int idx
= get_font_prop_index (key
);
3871 val
= font_prop_validate (idx
, Qnil
, val
);
3872 if (idx
< FONT_EXTRA_INDEX
)
3873 ASET (spec
, idx
, val
);
3875 font_put_extra (spec
, key
, val
);
3878 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3884 /* Return a copy of FONT as a font-spec. */
3886 copy_font_spec (Lisp_Object font
)
3888 Lisp_Object new_spec
, tail
, prev
, extra
;
3892 new_spec
= font_make_spec ();
3893 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3894 ASET (new_spec
, i
, AREF (font
, i
));
3895 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3896 /* We must remove :font-entity property. */
3897 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3898 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3901 extra
= XCDR (extra
);
3903 XSETCDR (prev
, XCDR (tail
));
3906 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3910 /* Merge font-specs FROM and TO, and return a new font-spec.
3911 Every specified property in FROM overrides the corresponding
3914 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3916 Lisp_Object extra
, tail
;
3921 to
= copy_font_spec (to
);
3922 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3923 ASET (to
, i
, AREF (from
, i
));
3924 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3925 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3926 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3928 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3931 XSETCDR (slot
, XCDR (XCAR (tail
)));
3933 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3935 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3939 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3940 doc
: /* Return the value of FONT's property KEY.
3941 FONT is a font-spec, a font-entity, or a font-object.
3942 KEY is any symbol, but these are reserved for specific meanings:
3943 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3944 :size, :name, :script, :otf
3945 See the documentation of `font-spec' for their meanings.
3946 In addition, if FONT is a font-entity or a font-object, values of
3947 :script and :otf are different from those of a font-spec as below:
3949 The value of :script may be a list of scripts that are supported by the font.
3951 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3952 representing the OpenType features supported by the font by this form:
3953 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3954 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3956 (Lisp_Object font
, Lisp_Object key
)
3964 idx
= get_font_prop_index (key
);
3965 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3966 return font_style_symbolic (font
, idx
, 0);
3967 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3968 return AREF (font
, idx
);
3969 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3970 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3972 struct font
*fontp
= XFONT_OBJECT (font
);
3974 if (fontp
->driver
->otf_capability
)
3975 val
= fontp
->driver
->otf_capability (fontp
);
3977 val
= Fcons (Qnil
, Qnil
);
3984 #ifdef HAVE_WINDOW_SYSTEM
3986 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3987 doc
: /* Return a plist of face attributes generated by FONT.
3988 FONT is a font name, a font-spec, a font-entity, or a font-object.
3989 The return value is a list of the form
3991 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3993 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3994 compatible with `set-face-attribute'. Some of these key-attribute pairs
3995 may be omitted from the list if they are not specified by FONT.
3997 The optional argument FRAME specifies the frame that the face attributes
3998 are to be displayed on. If omitted, the selected frame is used. */)
3999 (Lisp_Object font
, Lisp_Object frame
)
4001 struct frame
*f
= decode_live_frame (frame
);
4002 Lisp_Object plist
[10];
4008 int fontset
= fs_query_fontset (font
, 0);
4009 Lisp_Object name
= font
;
4011 font
= fontset_ascii (fontset
);
4012 font
= font_spec_from_name (name
);
4014 signal_error ("Invalid font name", name
);
4016 else if (! FONTP (font
))
4017 signal_error ("Invalid font object", font
);
4019 val
= AREF (font
, FONT_FAMILY_INDEX
);
4022 plist
[n
++] = QCfamily
;
4023 plist
[n
++] = SYMBOL_NAME (val
);
4026 val
= AREF (font
, FONT_SIZE_INDEX
);
4029 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4030 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4031 plist
[n
++] = QCheight
;
4032 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4034 else if (FLOATP (val
))
4036 plist
[n
++] = QCheight
;
4037 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4040 val
= FONT_WEIGHT_FOR_FACE (font
);
4043 plist
[n
++] = QCweight
;
4047 val
= FONT_SLANT_FOR_FACE (font
);
4050 plist
[n
++] = QCslant
;
4054 val
= FONT_WIDTH_FOR_FACE (font
);
4057 plist
[n
++] = QCwidth
;
4061 return Flist (n
, plist
);
4066 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4067 doc
: /* Set one property of FONT: give property KEY value VAL.
4068 FONT is a font-spec, a font-entity, or a font-object.
4070 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4071 accepted by the function `font-spec' (which see), VAL must be what
4072 allowed in `font-spec'.
4074 If FONT is a font-entity or a font-object, KEY must not be the one
4075 accepted by `font-spec'. */)
4076 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4080 idx
= get_font_prop_index (prop
);
4081 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4083 CHECK_FONT_SPEC (font
);
4084 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4088 if (EQ (prop
, QCname
)
4089 || EQ (prop
, QCscript
)
4090 || EQ (prop
, QClang
)
4091 || EQ (prop
, QCotf
))
4092 CHECK_FONT_SPEC (font
);
4095 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4100 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4101 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4102 Optional 2nd argument FRAME specifies the target frame.
4103 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4104 Optional 4th argument PREFER, if non-nil, is a font-spec to
4105 control the order of the returned list. Fonts are sorted by
4106 how close they are to PREFER. */)
4107 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4109 struct frame
*f
= decode_live_frame (frame
);
4110 Lisp_Object vec
, list
;
4113 CHECK_FONT_SPEC (font_spec
);
4121 if (! NILP (prefer
))
4122 CHECK_FONT_SPEC (prefer
);
4124 list
= font_list_entities (f
, font_spec
);
4127 if (NILP (XCDR (list
))
4128 && ASIZE (XCAR (list
)) == 1)
4129 return list1 (AREF (XCAR (list
), 0));
4131 if (! NILP (prefer
))
4132 vec
= font_sort_entities (list
, prefer
, f
, 0);
4134 vec
= font_vconcat_entity_vectors (list
);
4135 if (n
== 0 || n
>= ASIZE (vec
))
4137 Lisp_Object args
[2];
4141 list
= Fappend (2, args
);
4145 for (list
= Qnil
, n
--; n
>= 0; n
--)
4146 list
= Fcons (AREF (vec
, n
), list
);
4151 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4152 doc
: /* List available font families on the current frame.
4153 If FRAME is omitted or nil, the selected frame is used. */)
4156 struct frame
*f
= decode_live_frame (frame
);
4157 struct font_driver_list
*driver_list
;
4158 Lisp_Object list
= Qnil
;
4160 for (driver_list
= f
->font_driver_list
; driver_list
;
4161 driver_list
= driver_list
->next
)
4162 if (driver_list
->driver
->list_family
)
4164 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4165 Lisp_Object tail
= list
;
4167 for (; CONSP (val
); val
= XCDR (val
))
4168 if (NILP (Fmemq (XCAR (val
), tail
))
4169 && SYMBOLP (XCAR (val
)))
4170 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4175 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4176 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4177 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4178 (Lisp_Object font_spec
, Lisp_Object frame
)
4180 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4187 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4188 doc
: /* Return XLFD name of FONT.
4189 FONT is a font-spec, font-entity, or font-object.
4190 If the name is too long for XLFD (maximum 255 chars), return nil.
4191 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4192 the consecutive wildcards are folded into one. */)
4193 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4196 int namelen
, pixel_size
= 0;
4200 if (FONT_OBJECT_P (font
))
4202 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4204 if (STRINGP (font_name
)
4205 && SDATA (font_name
)[0] == '-')
4207 if (NILP (fold_wildcards
))
4209 strcpy (name
, SSDATA (font_name
));
4210 namelen
= SBYTES (font_name
);
4213 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4215 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4219 if (! NILP (fold_wildcards
))
4221 char *p0
= name
, *p1
;
4223 while ((p1
= strstr (p0
, "-*-*")))
4225 strcpy (p1
, p1
+ 2);
4231 return make_string (name
, namelen
);
4235 clear_font_cache (struct frame
*f
)
4237 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4239 for (; driver_list
; driver_list
= driver_list
->next
)
4240 if (driver_list
->on
)
4242 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4246 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4248 eassert (! NILP (val
));
4249 tmp
= XCDR (XCAR (val
));
4250 if (XINT (XCAR (tmp
)) == 0)
4252 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4253 XSETCDR (cache
, XCDR (val
));
4258 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4259 doc
: /* Clear font cache of each frame. */)
4262 Lisp_Object list
, frame
;
4264 FOR_EACH_FRAME (list
, frame
)
4265 clear_font_cache (XFRAME (frame
));
4272 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4274 struct font
*font
= XFONT_OBJECT (font_object
);
4275 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4276 struct font_metrics metrics
;
4278 LGLYPH_SET_CODE (glyph
, code
);
4279 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4280 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4281 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4282 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4283 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4284 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4288 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4289 doc
: /* Shape the glyph-string GSTRING.
4290 Shaping means substituting glyphs and/or adjusting positions of glyphs
4291 to get the correct visual image of character sequences set in the
4292 header of the glyph-string.
4294 If the shaping was successful, the value is GSTRING itself or a newly
4295 created glyph-string. Otherwise, the value is nil.
4297 See the documentation of `composition-get-gstring' for the format of
4299 (Lisp_Object gstring
)
4302 Lisp_Object font_object
, n
, glyph
;
4303 ptrdiff_t i
, from
, to
;
4305 if (! composition_gstring_p (gstring
))
4306 signal_error ("Invalid glyph-string: ", gstring
);
4307 if (! NILP (LGSTRING_ID (gstring
)))
4309 font_object
= LGSTRING_FONT (gstring
);
4310 CHECK_FONT_OBJECT (font_object
);
4311 font
= XFONT_OBJECT (font_object
);
4312 if (! font
->driver
->shape
)
4315 /* Try at most three times with larger gstring each time. */
4316 for (i
= 0; i
< 3; i
++)
4318 n
= font
->driver
->shape (gstring
);
4321 gstring
= larger_vector (gstring
,
4322 LGSTRING_GLYPH_LEN (gstring
), -1);
4324 if (i
== 3 || XINT (n
) == 0)
4326 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4327 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4329 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4330 GLYPHS covers all characters (except for the last few ones) in
4331 GSTRING. More formally, provided that NCHARS is the number of
4332 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4333 and TO_IDX of each glyph must satisfy these conditions:
4335 GLYPHS[0].FROM_IDX == 0
4336 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4337 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4338 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4339 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4341 ;; Be sure to cover all characters.
4342 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4343 glyph
= LGSTRING_GLYPH (gstring
, 0);
4344 from
= LGLYPH_FROM (glyph
);
4345 to
= LGLYPH_TO (glyph
);
4346 if (from
!= 0 || to
< from
)
4348 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4350 glyph
= LGSTRING_GLYPH (gstring
, i
);
4353 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4354 && (LGLYPH_FROM (glyph
) == from
4355 ? LGLYPH_TO (glyph
) == to
4356 : LGLYPH_FROM (glyph
) == to
+ 1)))
4358 from
= LGLYPH_FROM (glyph
);
4359 to
= LGLYPH_TO (glyph
);
4361 return composition_gstring_put_cache (gstring
, XINT (n
));
4367 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4369 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4370 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4372 VARIATION-SELECTOR is a character code of variation selection
4373 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4374 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4375 (Lisp_Object font_object
, Lisp_Object character
)
4377 unsigned variations
[256];
4382 CHECK_FONT_OBJECT (font_object
);
4383 CHECK_CHARACTER (character
);
4384 font
= XFONT_OBJECT (font_object
);
4385 if (! font
->driver
->get_variation_glyphs
)
4387 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4391 for (i
= 0; i
< 255; i
++)
4394 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4395 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4396 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4403 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4404 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4405 OTF-FEATURES specifies which features to apply in this format:
4406 (SCRIPT LANGSYS GSUB GPOS)
4408 SCRIPT is a symbol specifying a script tag of OpenType,
4409 LANGSYS is a symbol specifying a langsys tag of OpenType,
4410 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4412 If LANGYS is nil, the default langsys is selected.
4414 The features are applied in the order they appear in the list. The
4415 symbol `*' means to apply all available features not present in this
4416 list, and the remaining features are ignored. For instance, (vatu
4417 pstf * haln) is to apply vatu and pstf in this order, then to apply
4418 all available features other than vatu, pstf, and haln.
4420 The features are applied to the glyphs in the range FROM and TO of
4421 the glyph-string GSTRING-IN.
4423 If some feature is actually applicable, the resulting glyphs are
4424 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4425 this case, the value is the number of produced glyphs.
4427 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4430 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4431 produced in GSTRING-OUT, and the value is nil.
4433 See the documentation of `composition-get-gstring' for the format of
4435 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4437 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4442 check_otf_features (otf_features
);
4443 CHECK_FONT_OBJECT (font_object
);
4444 font
= XFONT_OBJECT (font_object
);
4445 if (! font
->driver
->otf_drive
)
4446 error ("Font backend %s can't drive OpenType GSUB table",
4447 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4448 CHECK_CONS (otf_features
);
4449 CHECK_SYMBOL (XCAR (otf_features
));
4450 val
= XCDR (otf_features
);
4451 CHECK_SYMBOL (XCAR (val
));
4452 val
= XCDR (otf_features
);
4455 len
= check_gstring (gstring_in
);
4456 CHECK_VECTOR (gstring_out
);
4457 CHECK_NATNUM (from
);
4459 CHECK_NATNUM (index
);
4461 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4462 args_out_of_range_3 (from
, to
, make_number (len
));
4463 if (XINT (index
) >= ASIZE (gstring_out
))
4464 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4465 num
= font
->driver
->otf_drive (font
, otf_features
,
4466 gstring_in
, XINT (from
), XINT (to
),
4467 gstring_out
, XINT (index
), 0);
4470 return make_number (num
);
4473 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4475 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4476 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4478 (SCRIPT LANGSYS FEATURE ...)
4479 See the documentation of `font-drive-otf' for more detail.
4481 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4482 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4483 character code corresponding to the glyph or nil if there's no
4484 corresponding character. */)
4485 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4488 Lisp_Object gstring_in
, gstring_out
, g
;
4489 Lisp_Object alternates
;
4492 CHECK_FONT_GET_OBJECT (font_object
, font
);
4493 if (! font
->driver
->otf_drive
)
4494 error ("Font backend %s can't drive OpenType GSUB table",
4495 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4496 CHECK_CHARACTER (character
);
4497 CHECK_CONS (otf_features
);
4499 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4500 g
= LGSTRING_GLYPH (gstring_in
, 0);
4501 LGLYPH_SET_CHAR (g
, XINT (character
));
4502 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4503 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4504 gstring_out
, 0, 1)) < 0)
4505 gstring_out
= Ffont_make_gstring (font_object
,
4506 make_number (ASIZE (gstring_out
) * 2));
4508 for (i
= 0; i
< num
; i
++)
4510 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4511 int c
= LGLYPH_CHAR (g
);
4512 unsigned code
= LGLYPH_CODE (g
);
4514 alternates
= Fcons (Fcons (make_number (code
),
4515 c
> 0 ? make_number (c
) : Qnil
),
4518 return Fnreverse (alternates
);
4524 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4525 doc
: /* Open FONT-ENTITY. */)
4526 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4529 struct frame
*f
= decode_live_frame (frame
);
4531 CHECK_FONT_ENTITY (font_entity
);
4534 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4537 CHECK_NUMBER_OR_FLOAT (size
);
4539 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4541 isize
= XINT (size
);
4542 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4543 args_out_of_range (font_entity
, size
);
4547 return font_open_entity (f
, font_entity
, isize
);
4550 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4551 doc
: /* Close FONT-OBJECT. */)
4552 (Lisp_Object font_object
, Lisp_Object frame
)
4554 CHECK_FONT_OBJECT (font_object
);
4555 font_close_object (decode_live_frame (frame
), font_object
);
4559 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4560 doc
: /* Return information about FONT-OBJECT.
4561 The value is a vector:
4562 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4565 NAME is the font name, a string (or nil if the font backend doesn't
4568 FILENAME is the font file name, a string (or nil if the font backend
4569 doesn't provide a file name).
4571 PIXEL-SIZE is a pixel size by which the font is opened.
4573 SIZE is a maximum advance width of the font in pixels.
4575 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4578 CAPABILITY is a list whose first element is a symbol representing the
4579 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4580 remaining elements describe the details of the font capability.
4582 If the font is OpenType font, the form of the list is
4583 \(opentype GSUB GPOS)
4584 where GSUB shows which "GSUB" features the font supports, and GPOS
4585 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4586 lists of the format:
4587 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4589 If the font is not OpenType font, currently the length of the form is
4592 SCRIPT is a symbol representing OpenType script tag.
4594 LANGSYS is a symbol representing OpenType langsys tag, or nil
4595 representing the default langsys.
4597 FEATURE is a symbol representing OpenType feature tag.
4599 If the font is not OpenType font, CAPABILITY is nil. */)
4600 (Lisp_Object font_object
)
4605 CHECK_FONT_GET_OBJECT (font_object
, font
);
4607 val
= make_uninit_vector (9);
4608 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4609 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4610 ASET (val
, 2, make_number (font
->pixel_size
));
4611 ASET (val
, 3, make_number (font
->max_width
));
4612 ASET (val
, 4, make_number (font
->ascent
));
4613 ASET (val
, 5, make_number (font
->descent
));
4614 ASET (val
, 6, make_number (font
->space_width
));
4615 ASET (val
, 7, make_number (font
->average_width
));
4616 if (font
->driver
->otf_capability
)
4617 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4619 ASET (val
, 8, Qnil
);
4623 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4625 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4626 FROM and TO are positions (integers or markers) specifying a region
4627 of the current buffer.
4628 If the optional fourth arg OBJECT is not nil, it is a string or a
4629 vector containing the target characters.
4631 Each element is a vector containing information of a glyph in this format:
4632 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4634 FROM is an index numbers of a character the glyph corresponds to.
4635 TO is the same as FROM.
4636 C is the character of the glyph.
4637 CODE is the glyph-code of C in FONT-OBJECT.
4638 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4639 ADJUSTMENT is always nil.
4640 If FONT-OBJECT doesn't have a glyph for a character,
4641 the corresponding element is nil. */)
4642 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4647 Lisp_Object
*chars
, vec
;
4650 CHECK_FONT_GET_OBJECT (font_object
, font
);
4653 ptrdiff_t charpos
, bytepos
;
4655 validate_region (&from
, &to
);
4658 len
= XFASTINT (to
) - XFASTINT (from
);
4659 SAFE_ALLOCA_LISP (chars
, len
);
4660 charpos
= XFASTINT (from
);
4661 bytepos
= CHAR_TO_BYTE (charpos
);
4662 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4665 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4666 chars
[i
] = make_number (c
);
4669 else if (STRINGP (object
))
4671 const unsigned char *p
;
4673 CHECK_NUMBER (from
);
4675 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4676 || XINT (to
) > SCHARS (object
))
4677 args_out_of_range_3 (object
, from
, to
);
4680 len
= XFASTINT (to
) - XFASTINT (from
);
4681 SAFE_ALLOCA_LISP (chars
, len
);
4683 if (STRING_MULTIBYTE (object
))
4684 for (i
= 0; i
< len
; i
++)
4686 int c
= STRING_CHAR_ADVANCE (p
);
4687 chars
[i
] = make_number (c
);
4690 for (i
= 0; i
< len
; i
++)
4691 chars
[i
] = make_number (p
[i
]);
4695 CHECK_VECTOR (object
);
4696 CHECK_NUMBER (from
);
4698 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4699 || XINT (to
) > ASIZE (object
))
4700 args_out_of_range_3 (object
, from
, to
);
4703 len
= XFASTINT (to
) - XFASTINT (from
);
4704 for (i
= 0; i
< len
; i
++)
4706 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4707 CHECK_CHARACTER (elt
);
4709 chars
= aref_addr (object
, XFASTINT (from
));
4712 vec
= make_uninit_vector (len
);
4713 for (i
= 0; i
< len
; i
++)
4716 int c
= XFASTINT (chars
[i
]);
4718 struct font_metrics metrics
;
4720 code
= font
->driver
->encode_char (font
, c
);
4721 if (code
== FONT_INVALID_CODE
)
4723 ASET (vec
, i
, Qnil
);
4727 LGLYPH_SET_FROM (g
, i
);
4728 LGLYPH_SET_TO (g
, i
);
4729 LGLYPH_SET_CHAR (g
, c
);
4730 LGLYPH_SET_CODE (g
, code
);
4731 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4732 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4733 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4734 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4735 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4736 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4739 if (! VECTORP (object
))
4744 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4745 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4746 FONT is a font-spec, font-entity, or font-object. */)
4747 (Lisp_Object spec
, Lisp_Object font
)
4749 CHECK_FONT_SPEC (spec
);
4752 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4755 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4756 doc
: /* Return a font-object for displaying a character at POSITION.
4757 Optional second arg WINDOW, if non-nil, is a window displaying
4758 the current buffer. It defaults to the currently selected window.
4759 Optional third arg STRING, if non-nil, is a string containing the target
4760 character at index specified by POSITION. */)
4761 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4763 struct window
*w
= decode_live_window (window
);
4767 if (XBUFFER (w
->contents
) != current_buffer
)
4768 error ("Specified window is not displaying the current buffer.");
4769 CHECK_NUMBER_COERCE_MARKER (position
);
4770 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4771 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4775 CHECK_NUMBER (position
);
4776 CHECK_STRING (string
);
4777 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4778 args_out_of_range (string
, position
);
4781 return font_at (-1, XINT (position
), NULL
, w
, string
);
4785 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4786 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4787 The value is a number of glyphs drawn.
4788 Type C-l to recover what previously shown. */)
4789 (Lisp_Object font_object
, Lisp_Object string
)
4791 Lisp_Object frame
= selected_frame
;
4792 struct frame
*f
= XFRAME (frame
);
4798 CHECK_FONT_GET_OBJECT (font_object
, font
);
4799 CHECK_STRING (string
);
4800 len
= SCHARS (string
);
4801 code
= alloca (sizeof (unsigned) * len
);
4802 for (i
= 0; i
< len
; i
++)
4804 Lisp_Object ch
= Faref (string
, make_number (i
));
4808 code
[i
] = font
->driver
->encode_char (font
, c
);
4809 if (code
[i
] == FONT_INVALID_CODE
)
4812 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4814 if (font
->driver
->prepare_face
)
4815 font
->driver
->prepare_face (f
, face
);
4816 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4817 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4818 if (font
->driver
->done_face
)
4819 font
->driver
->done_face (f
, face
);
4821 return make_number (len
);
4825 #endif /* FONT_DEBUG */
4827 #ifdef HAVE_WINDOW_SYSTEM
4829 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4830 doc
: /* Return information about a font named NAME on frame FRAME.
4831 If FRAME is omitted or nil, use the selected frame.
4832 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4833 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4835 OPENED-NAME is the name used for opening the font,
4836 FULL-NAME is the full name of the font,
4837 SIZE is the pixelsize of the font,
4838 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4839 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4840 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4841 how to compose characters.
4842 If the named font is not yet loaded, return nil. */)
4843 (Lisp_Object name
, Lisp_Object frame
)
4848 Lisp_Object font_object
;
4851 CHECK_STRING (name
);
4852 f
= decode_window_system_frame (frame
);
4856 int fontset
= fs_query_fontset (name
, 0);
4859 name
= fontset_ascii (fontset
);
4860 font_object
= font_open_by_name (f
, name
);
4862 else if (FONT_OBJECT_P (name
))
4864 else if (FONT_ENTITY_P (name
))
4865 font_object
= font_open_entity (f
, name
, 0);
4868 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4869 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4871 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4873 if (NILP (font_object
))
4875 font
= XFONT_OBJECT (font_object
);
4877 info
= make_uninit_vector (7);
4878 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4879 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4880 ASET (info
, 2, make_number (font
->pixel_size
));
4881 ASET (info
, 3, make_number (font
->height
));
4882 ASET (info
, 4, make_number (font
->baseline_offset
));
4883 ASET (info
, 5, make_number (font
->relative_compose
));
4884 ASET (info
, 6, make_number (font
->default_ascent
));
4887 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4888 close it now. Perhaps, we should manage font-objects
4889 by `reference-count'. */
4890 font_close_object (f
, font_object
);
4897 #define BUILD_STYLE_TABLE(TBL) \
4898 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4901 build_style_table (const struct table_entry
*entry
, int nelement
)
4904 Lisp_Object table
, elt
;
4906 table
= make_uninit_vector (nelement
);
4907 for (i
= 0; i
< nelement
; i
++)
4909 for (j
= 0; entry
[i
].names
[j
]; j
++);
4910 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4911 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4912 for (j
= 0; entry
[i
].names
[j
]; j
++)
4913 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4914 ASET (table
, i
, elt
);
4919 /* The deferred font-log data of the form [ACTION ARG RESULT].
4920 If ACTION is not nil, that is added to the log when font_add_log is
4921 called next time. At that time, ACTION is set back to nil. */
4922 static Lisp_Object Vfont_log_deferred
;
4924 /* Prepend the font-related logging data in Vfont_log if it is not
4925 `t'. ACTION describes a kind of font-related action (e.g. listing,
4926 opening), ARG is the argument for the action, and RESULT is the
4927 result of the action. */
4929 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4934 if (EQ (Vfont_log
, Qt
))
4936 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4938 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4940 ASET (Vfont_log_deferred
, 0, Qnil
);
4941 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4942 AREF (Vfont_log_deferred
, 2));
4947 Lisp_Object tail
, elt
;
4948 Lisp_Object equalstr
= build_string ("=");
4950 val
= Ffont_xlfd_name (arg
, Qt
);
4951 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4955 if (EQ (XCAR (elt
), QCscript
)
4956 && SYMBOLP (XCDR (elt
)))
4957 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4958 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4959 else if (EQ (XCAR (elt
), QClang
)
4960 && SYMBOLP (XCDR (elt
)))
4961 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4962 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4963 else if (EQ (XCAR (elt
), QCotf
)
4964 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4965 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4967 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4973 && VECTORP (XCAR (result
))
4974 && ASIZE (XCAR (result
)) > 0
4975 && FONTP (AREF (XCAR (result
), 0)))
4976 result
= font_vconcat_entity_vectors (result
);
4979 val
= Ffont_xlfd_name (result
, Qt
);
4980 if (! FONT_SPEC_P (result
))
4981 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4982 build_string (":"), val
);
4985 else if (CONSP (result
))
4988 result
= Fcopy_sequence (result
);
4989 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4993 val
= Ffont_xlfd_name (val
, Qt
);
4994 XSETCAR (tail
, val
);
4997 else if (VECTORP (result
))
4999 result
= Fcopy_sequence (result
);
5000 for (i
= 0; i
< ASIZE (result
); i
++)
5002 val
= AREF (result
, i
);
5004 val
= Ffont_xlfd_name (val
, Qt
);
5005 ASET (result
, i
, val
);
5008 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5011 /* Record a font-related logging data to be added to Vfont_log when
5012 font_add_log is called next time. ACTION, ARG, RESULT are the same
5016 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5018 if (EQ (Vfont_log
, Qt
))
5020 ASET (Vfont_log_deferred
, 0, build_string (action
));
5021 ASET (Vfont_log_deferred
, 1, arg
);
5022 ASET (Vfont_log_deferred
, 2, result
);
5028 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5029 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5030 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5031 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5032 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5033 /* Note that the other elements in sort_shift_bits are not used. */
5035 staticpro (&font_charset_alist
);
5036 font_charset_alist
= Qnil
;
5038 DEFSYM (Qopentype
, "opentype");
5040 DEFSYM (Qascii_0
, "ascii-0");
5041 DEFSYM (Qiso8859_1
, "iso8859-1");
5042 DEFSYM (Qiso10646_1
, "iso10646-1");
5043 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5044 DEFSYM (Qunicode_sip
, "unicode-sip");
5048 DEFSYM (QCotf
, ":otf");
5049 DEFSYM (QClang
, ":lang");
5050 DEFSYM (QCscript
, ":script");
5051 DEFSYM (QCantialias
, ":antialias");
5053 DEFSYM (QCfoundry
, ":foundry");
5054 DEFSYM (QCadstyle
, ":adstyle");
5055 DEFSYM (QCregistry
, ":registry");
5056 DEFSYM (QCspacing
, ":spacing");
5057 DEFSYM (QCdpi
, ":dpi");
5058 DEFSYM (QCscalable
, ":scalable");
5059 DEFSYM (QCavgwidth
, ":avgwidth");
5060 DEFSYM (QCfont_entity
, ":font-entity");
5061 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5071 DEFSYM (QCuser_spec
, "user-spec");
5073 staticpro (&scratch_font_spec
);
5074 scratch_font_spec
= Ffont_spec (0, NULL
);
5075 staticpro (&scratch_font_prefer
);
5076 scratch_font_prefer
= Ffont_spec (0, NULL
);
5078 staticpro (&Vfont_log_deferred
);
5079 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5083 staticpro (&otf_list
);
5085 #endif /* HAVE_LIBOTF */
5089 defsubr (&Sfont_spec
);
5090 defsubr (&Sfont_get
);
5091 #ifdef HAVE_WINDOW_SYSTEM
5092 defsubr (&Sfont_face_attributes
);
5094 defsubr (&Sfont_put
);
5095 defsubr (&Slist_fonts
);
5096 defsubr (&Sfont_family_list
);
5097 defsubr (&Sfind_font
);
5098 defsubr (&Sfont_xlfd_name
);
5099 defsubr (&Sclear_font_cache
);
5100 defsubr (&Sfont_shape_gstring
);
5101 defsubr (&Sfont_variation_glyphs
);
5103 defsubr (&Sfont_drive_otf
);
5104 defsubr (&Sfont_otf_alternates
);
5108 defsubr (&Sopen_font
);
5109 defsubr (&Sclose_font
);
5110 defsubr (&Squery_font
);
5111 defsubr (&Sfont_get_glyphs
);
5112 defsubr (&Sfont_match_p
);
5113 defsubr (&Sfont_at
);
5115 defsubr (&Sdraw_string
);
5117 #endif /* FONT_DEBUG */
5118 #ifdef HAVE_WINDOW_SYSTEM
5119 defsubr (&Sfont_info
);
5122 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5124 Alist of fontname patterns vs the corresponding encoding and repertory info.
5125 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5126 where ENCODING is a charset or a char-table,
5127 and REPERTORY is a charset, a char-table, or nil.
5129 If ENCODING and REPERTORY are the same, the element can have the form
5130 \(REGEXP . ENCODING).
5132 ENCODING is for converting a character to a glyph code of the font.
5133 If ENCODING is a charset, encoding a character by the charset gives
5134 the corresponding glyph code. If ENCODING is a char-table, looking up
5135 the table by a character gives the corresponding glyph code.
5137 REPERTORY specifies a repertory of characters supported by the font.
5138 If REPERTORY is a charset, all characters belonging to the charset are
5139 supported. If REPERTORY is a char-table, all characters who have a
5140 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5141 gets the repertory information by an opened font and ENCODING. */);
5142 Vfont_encoding_alist
= Qnil
;
5144 /* FIXME: These 3 vars are not quite what they appear: setq on them
5145 won't have any effect other than disconnect them from the style
5146 table used by the font display code. So we make them read-only,
5147 to avoid this confusing situation. */
5149 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5150 doc
: /* Vector of valid font weight values.
5151 Each element has the form:
5152 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5153 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5154 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5155 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5157 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5158 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5159 See `font-weight-table' for the format of the vector. */);
5160 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5161 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5163 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5164 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5165 See `font-weight-table' for the format of the vector. */);
5166 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5167 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5169 staticpro (&font_style_table
);
5170 font_style_table
= make_uninit_vector (3);
5171 ASET (font_style_table
, 0, Vfont_weight_table
);
5172 ASET (font_style_table
, 1, Vfont_slant_table
);
5173 ASET (font_style_table
, 2, Vfont_width_table
);
5175 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5176 *Logging list of font related actions and results.
5177 The value t means to suppress the logging.
5178 The initial value is set to nil if the environment variable
5179 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5182 #ifdef HAVE_WINDOW_SYSTEM
5183 #ifdef HAVE_FREETYPE
5185 #ifdef HAVE_X_WINDOWS
5190 #endif /* HAVE_XFT */
5191 #endif /* HAVE_X_WINDOWS */
5192 #else /* not HAVE_FREETYPE */
5193 #ifdef HAVE_X_WINDOWS
5195 #endif /* HAVE_X_WINDOWS */
5196 #endif /* not HAVE_FREETYPE */
5199 #endif /* HAVE_BDFFONT */
5202 #endif /* HAVE_NTGUI */
5203 #endif /* HAVE_WINDOW_SYSTEM */
5209 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;