1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2011 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/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
51 Lisp_Object Qopentype
;
53 /* Important character set strings. */
54 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
56 #define DEFAULT_ENCODING Qiso8859_1
58 /* Unicode category `Cf'. */
59 static Lisp_Object QCf
;
61 /* Special vector of zero length. This is repeatedly used by (struct
62 font_driver *)->list when a specified font is not found. */
63 static Lisp_Object null_vector
;
65 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
66 static Lisp_Object font_style_table
;
68 /* Structure used for tables mapping weight, slant, and width numeric
69 values and their names. */
74 /* The first one is a valid name as a face attribute.
75 The second one (if any) is a typical name in XLFD field. */
79 /* Table of weight numeric values and their names. This table must be
80 sorted by numeric values in ascending order. */
82 static const struct table_entry weight_table
[] =
85 { 20, { "ultra-light", "ultralight" }},
86 { 40, { "extra-light", "extralight" }},
88 { 75, { "semi-light", "semilight", "demilight", "book" }},
89 { 100, { "normal", "medium", "regular", "unspecified" }},
90 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
92 { 205, { "extra-bold", "extrabold" }},
93 { 210, { "ultra-bold", "ultrabold", "black" }}
96 /* Table of slant numeric values and their names. This table must be
97 sorted by numeric values in ascending order. */
99 static const struct table_entry slant_table
[] =
101 { 0, { "reverse-oblique", "ro" }},
102 { 10, { "reverse-italic", "ri" }},
103 { 100, { "normal", "r", "unspecified" }},
104 { 200, { "italic" ,"i", "ot" }},
105 { 210, { "oblique", "o" }}
108 /* Table of width numeric values and their names. This table must be
109 sorted by numeric values in ascending order. */
111 static const struct table_entry width_table
[] =
113 { 50, { "ultra-condensed", "ultracondensed" }},
114 { 63, { "extra-condensed", "extracondensed" }},
115 { 75, { "condensed", "compressed", "narrow" }},
116 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
117 { 100, { "normal", "medium", "regular", "unspecified" }},
118 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
119 { 125, { "expanded" }},
120 { 150, { "extra-expanded", "extraexpanded" }},
121 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
124 Lisp_Object QCfoundry
;
125 static Lisp_Object QCadstyle
, QCregistry
;
126 /* Symbols representing keys of font extra info. */
127 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
128 Lisp_Object QCantialias
, QCfont_entity
;
129 static Lisp_Object QCfc_unknown_spec
;
130 /* Symbols representing values of font spacing property. */
131 static Lisp_Object Qc
, Qm
, Qd
;
133 /* Special ADSTYLE properties to avoid fonts used for Latin
134 characters; used in xfont.c and ftfont.c. */
135 Lisp_Object Qja
, Qko
;
137 static Lisp_Object QCuser_spec
;
139 /* Alist of font registry symbols and the corresponding charset
140 information. The information is retrieved from
141 Vfont_encoding_alist on demand.
143 Eash element has the form:
144 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
148 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
149 encodes a character code to a glyph code of a font, and
150 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
151 character is supported by a font.
153 The latter form means that the information for REGISTRY couldn't be
155 static Lisp_Object font_charset_alist
;
157 /* List of all font drivers. Each font-backend (XXXfont.c) calls
158 register_font_driver in syms_of_XXXfont to register its font-driver
160 static struct font_driver_list
*font_driver_list
;
164 /* Creaters of font-related Lisp object. */
167 font_make_spec (void)
169 Lisp_Object font_spec
;
170 struct font_spec
*spec
171 = ((struct font_spec
*)
172 allocate_pseudovector (VECSIZE (struct font_spec
),
173 FONT_SPEC_MAX
, PVEC_FONT
));
174 XSETFONT (font_spec
, spec
);
179 font_make_entity (void)
181 Lisp_Object font_entity
;
182 struct font_entity
*entity
183 = ((struct font_entity
*)
184 allocate_pseudovector (VECSIZE (struct font_entity
),
185 FONT_ENTITY_MAX
, PVEC_FONT
));
186 XSETFONT (font_entity
, entity
);
190 /* Create a font-object whose structure size is SIZE. If ENTITY is
191 not nil, copy properties from ENTITY to the font-object. If
192 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
194 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
196 Lisp_Object font_object
;
198 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
201 XSETFONT (font_object
, font
);
205 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
206 font
->props
[i
] = AREF (entity
, i
);
207 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
208 font
->props
[FONT_EXTRA_INDEX
]
209 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
212 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
218 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
219 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
220 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
222 static unsigned font_encode_char (Lisp_Object
, int);
224 /* Number of registered font drivers. */
225 static int num_font_drivers
;
228 /* Return a Lispy value of a font property value at STR and LEN bytes.
229 If STR is "*", return nil.
230 If FORCE_SYMBOL is zero and all characters in STR are digits,
231 return an integer. Otherwise, return a symbol interned from
235 font_intern_prop (const char *str
, ptrdiff_t len
, int force_symbol
)
240 EMACS_INT nbytes
, nchars
;
242 if (len
== 1 && *str
== '*')
244 if (!force_symbol
&& len
>=1 && isdigit (*str
))
246 for (i
= 1; i
< len
; i
++)
247 if (! isdigit (str
[i
]))
251 Lisp_Object num
= string_to_number (str
, 10, 0);
252 if (! INTEGERP (num
))
253 xsignal1 (Qoverflow_error
, num
);
258 /* The following code is copied from the function intern (in
259 lread.c), and modified to suit our purpose. */
261 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
262 obarray
= check_obarray (obarray
);
263 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
264 if (len
== nchars
|| len
!= nbytes
)
265 /* CONTENTS contains no multibyte sequences or contains an invalid
266 multibyte sequence. We'll make a unibyte string. */
267 tem
= oblookup (obarray
, str
, len
, len
);
269 tem
= oblookup (obarray
, str
, nchars
, len
);
272 if (len
== nchars
|| len
!= nbytes
)
273 tem
= make_unibyte_string (str
, len
);
275 tem
= make_multibyte_string (str
, nchars
, len
);
276 return Fintern (tem
, obarray
);
279 /* Return a pixel size of font-spec SPEC on frame F. */
282 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
284 #ifdef HAVE_WINDOW_SYSTEM
285 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
294 font_assert (FLOATP (size
));
295 point_size
= XFLOAT_DATA (size
);
296 val
= AREF (spec
, FONT_DPI_INDEX
);
301 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
309 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
310 font vector. If VAL is not valid (i.e. not registered in
311 font_style_table), return -1 if NOERROR is zero, and return a
312 proper index if NOERROR is nonzero. In that case, register VAL in
313 font_style_table if VAL is a symbol, and return the closest index if
314 VAL is an integer. */
317 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
319 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
320 int len
= ASIZE (table
);
326 Lisp_Object args
[2], elt
;
328 /* At first try exact match. */
329 for (i
= 0; i
< len
; i
++)
330 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
331 if (EQ (val
, AREF (AREF (table
, i
), j
)))
332 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
333 | (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)
341 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
342 | (i
<< 4) | (j
- 1));
348 elt
= Fmake_vector (make_number (2), make_number (100));
351 args
[1] = Fmake_vector (make_number (1), elt
);
352 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
353 return (100 << 8) | (i
<< 4);
358 int numeric
= XINT (val
);
360 for (i
= 0, last_n
= -1; i
< len
; i
++)
362 int n
= XINT (AREF (AREF (table
, i
), 0));
365 return (n
<< 8) | (i
<< 4);
370 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
371 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
377 return ((last_n
<< 8) | ((i
- 1) << 4));
382 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
384 Lisp_Object val
= AREF (font
, prop
);
385 Lisp_Object table
, elt
;
390 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
391 i
= XINT (val
) & 0xFF;
392 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
393 elt
= AREF (table
, ((i
>> 4) & 0xF));
394 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
395 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
398 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
399 FONTNAME. ENCODING is a charset symbol that specifies the encoding
400 of the font. REPERTORY is a charset symbol or nil. */
403 find_font_encoding (Lisp_Object fontname
)
405 Lisp_Object tail
, elt
;
407 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
411 && STRINGP (XCAR (elt
))
412 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
413 && (SYMBOLP (XCDR (elt
))
414 ? CHARSETP (XCDR (elt
))
415 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
421 /* Return encoding charset and repertory charset for REGISTRY in
422 ENCODING and REPERTORY correspondingly. If correct information for
423 REGISTRY is available, return 0. Otherwise return -1. */
426 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
429 int encoding_id
, repertory_id
;
431 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
437 encoding_id
= XINT (XCAR (val
));
438 repertory_id
= XINT (XCDR (val
));
442 val
= find_font_encoding (SYMBOL_NAME (registry
));
443 if (SYMBOLP (val
) && CHARSETP (val
))
445 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
447 else if (CONSP (val
))
449 if (! CHARSETP (XCAR (val
)))
451 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
452 if (NILP (XCDR (val
)))
456 if (! CHARSETP (XCDR (val
)))
458 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
463 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
465 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
469 *encoding
= CHARSET_FROM_ID (encoding_id
);
471 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
476 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
481 /* Font property value validators. See the comment of
482 font_property_table for the meaning of the arguments. */
484 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
485 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
486 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
487 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
488 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
489 static int get_font_prop_index (Lisp_Object
);
492 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
495 val
= Fintern (val
, Qnil
);
498 else if (EQ (prop
, QCregistry
))
499 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
505 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
507 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
508 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
514 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
518 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
520 if ((n
& 0xF) + 1 >= ASIZE (elt
))
522 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
526 else if (SYMBOLP (val
))
528 int n
= font_style_to_value (prop
, val
, 0);
530 val
= n
>= 0 ? make_number (n
) : Qerror
;
538 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
540 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
545 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
547 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
549 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
551 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
553 if (spacing
== 'c' || spacing
== 'C')
554 return make_number (FONT_SPACING_CHARCELL
);
555 if (spacing
== 'm' || spacing
== 'M')
556 return make_number (FONT_SPACING_MONO
);
557 if (spacing
== 'p' || spacing
== 'P')
558 return make_number (FONT_SPACING_PROPORTIONAL
);
559 if (spacing
== 'd' || spacing
== 'D')
560 return make_number (FONT_SPACING_DUAL
);
566 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
568 Lisp_Object tail
, tmp
;
571 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
572 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
573 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
576 if (! SYMBOLP (XCAR (val
)))
581 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
583 for (i
= 0; i
< 2; i
++)
590 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
591 if (! SYMBOLP (XCAR (tmp
)))
599 /* Structure of known font property keys and validator of the
603 /* Pointer to the key symbol. */
605 /* Function to validate PROP's value VAL, or NULL if any value is
606 ok. The value is VAL or its regularized value if VAL is valid,
607 and Qerror if not. */
608 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
609 } font_property_table
[] =
610 { { &QCtype
, font_prop_validate_symbol
},
611 { &QCfoundry
, font_prop_validate_symbol
},
612 { &QCfamily
, font_prop_validate_symbol
},
613 { &QCadstyle
, font_prop_validate_symbol
},
614 { &QCregistry
, font_prop_validate_symbol
},
615 { &QCweight
, font_prop_validate_style
},
616 { &QCslant
, font_prop_validate_style
},
617 { &QCwidth
, font_prop_validate_style
},
618 { &QCsize
, font_prop_validate_non_neg
},
619 { &QCdpi
, font_prop_validate_non_neg
},
620 { &QCspacing
, font_prop_validate_spacing
},
621 { &QCavgwidth
, font_prop_validate_non_neg
},
622 /* The order of the above entries must match with enum
623 font_property_index. */
624 { &QClang
, font_prop_validate_symbol
},
625 { &QCscript
, font_prop_validate_symbol
},
626 { &QCotf
, font_prop_validate_otf
}
629 /* Size (number of elements) of the above table. */
630 #define FONT_PROPERTY_TABLE_SIZE \
631 ((sizeof font_property_table) / (sizeof *font_property_table))
633 /* Return an index number of font property KEY or -1 if KEY is not an
634 already known property. */
637 get_font_prop_index (Lisp_Object key
)
641 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
642 if (EQ (key
, *font_property_table
[i
].key
))
647 /* Validate the font property. The property key is specified by the
648 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
649 signal an error. The value is VAL or the regularized one. */
652 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
654 Lisp_Object validated
;
659 prop
= *font_property_table
[idx
].key
;
662 idx
= get_font_prop_index (prop
);
666 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
667 if (EQ (validated
, Qerror
))
668 signal_error ("invalid font property", Fcons (prop
, val
));
673 /* Store VAL as a value of extra font property PROP in FONT while
674 keeping the sorting order. Don't check the validity of VAL. */
677 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
679 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
680 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
684 Lisp_Object prev
= Qnil
;
687 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
688 prev
= extra
, extra
= XCDR (extra
);
691 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
693 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
699 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
704 /* Font name parser and unparser */
706 static int parse_matrix (const char *);
707 static int font_expand_wildcards (Lisp_Object
*, int);
708 static int font_parse_name (char *, Lisp_Object
);
710 /* An enumerator for each field of an XLFD font name. */
711 enum xlfd_field_index
730 /* An enumerator for mask bit corresponding to each XLFD field. */
733 XLFD_FOUNDRY_MASK
= 0x0001,
734 XLFD_FAMILY_MASK
= 0x0002,
735 XLFD_WEIGHT_MASK
= 0x0004,
736 XLFD_SLANT_MASK
= 0x0008,
737 XLFD_SWIDTH_MASK
= 0x0010,
738 XLFD_ADSTYLE_MASK
= 0x0020,
739 XLFD_PIXEL_MASK
= 0x0040,
740 XLFD_POINT_MASK
= 0x0080,
741 XLFD_RESX_MASK
= 0x0100,
742 XLFD_RESY_MASK
= 0x0200,
743 XLFD_SPACING_MASK
= 0x0400,
744 XLFD_AVGWIDTH_MASK
= 0x0800,
745 XLFD_REGISTRY_MASK
= 0x1000,
746 XLFD_ENCODING_MASK
= 0x2000
750 /* Parse P pointing to the pixel/point size field of the form
751 `[A B C D]' which specifies a transformation matrix:
757 by which all glyphs of the font are transformed. The spec says
758 that scalar value N for the pixel/point size is equivalent to:
759 A = N * resx/resy, B = C = 0, D = N.
761 Return the scalar value N if the form is valid. Otherwise return
765 parse_matrix (const char *p
)
771 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
774 matrix
[i
] = - strtod (p
+ 1, &end
);
776 matrix
[i
] = strtod (p
, &end
);
779 return (i
== 4 ? (int) matrix
[3] : -1);
782 /* Expand a wildcard field in FIELD (the first N fields are filled) to
783 multiple fields to fill in all 14 XLFD fields while restricting a
784 field position by its contents. */
787 font_expand_wildcards (Lisp_Object
*field
, int n
)
790 Lisp_Object tmp
[XLFD_LAST_INDEX
];
791 /* Array of information about where this element can go. Nth
792 element is for Nth element of FIELD. */
794 /* Minimum possible field. */
796 /* Maxinum possible field. */
798 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
800 } range
[XLFD_LAST_INDEX
];
802 int range_from
, range_to
;
805 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
806 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
807 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
808 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
809 | XLFD_AVGWIDTH_MASK)
810 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
812 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
813 field. The value is shifted to left one bit by one in the
815 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
816 range_mask
= (range_mask
<< 1) | 1;
818 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
819 position-based retriction for FIELD[I]. */
820 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
821 i
++, range_from
++, range_to
++, range_mask
<<= 1)
823 Lisp_Object val
= field
[i
];
829 range
[i
].from
= range_from
;
830 range
[i
].to
= range_to
;
831 range
[i
].mask
= range_mask
;
835 /* The triplet FROM, TO, and MASK is a value-based
836 retriction for FIELD[I]. */
842 int numeric
= XINT (val
);
845 from
= to
= XLFD_ENCODING_INDEX
,
846 mask
= XLFD_ENCODING_MASK
;
847 else if (numeric
== 0)
848 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
849 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
850 else if (numeric
<= 48)
851 from
= to
= XLFD_PIXEL_INDEX
,
852 mask
= XLFD_PIXEL_MASK
;
854 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
855 mask
= XLFD_LARGENUM_MASK
;
857 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
858 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
859 mask
= XLFD_NULL_MASK
;
861 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
864 Lisp_Object name
= SYMBOL_NAME (val
);
866 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
867 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
868 mask
= XLFD_REGENC_MASK
;
870 from
= to
= XLFD_ENCODING_INDEX
,
871 mask
= XLFD_ENCODING_MASK
;
873 else if (range_from
<= XLFD_WEIGHT_INDEX
874 && range_to
>= XLFD_WEIGHT_INDEX
875 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
876 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
877 else if (range_from
<= XLFD_SLANT_INDEX
878 && range_to
>= XLFD_SLANT_INDEX
879 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
880 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
881 else if (range_from
<= XLFD_SWIDTH_INDEX
882 && range_to
>= XLFD_SWIDTH_INDEX
883 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
884 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
887 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
888 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
890 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
891 mask
= XLFD_SYMBOL_MASK
;
894 /* Merge position-based and value-based restrictions. */
896 while (from
< range_from
)
897 mask
&= ~(1 << from
++);
898 while (from
< 14 && ! (mask
& (1 << from
)))
900 while (to
> range_to
)
901 mask
&= ~(1 << to
--);
902 while (to
>= 0 && ! (mask
& (1 << to
)))
906 range
[i
].from
= from
;
908 range
[i
].mask
= mask
;
910 if (from
> range_from
|| to
< range_to
)
912 /* The range is narrowed by value-based restrictions.
913 Reflect it to the other fields. */
915 /* Following fields should be after FROM. */
917 /* Preceding fields should be before TO. */
918 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
920 /* Check FROM for non-wildcard field. */
921 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
923 while (range
[j
].from
< from
)
924 range
[j
].mask
&= ~(1 << range
[j
].from
++);
925 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
927 range
[j
].from
= from
;
930 from
= range
[j
].from
;
931 if (range
[j
].to
> to
)
933 while (range
[j
].to
> to
)
934 range
[j
].mask
&= ~(1 << range
[j
].to
--);
935 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
948 /* Decide all fileds from restrictions in RANGE. */
949 for (i
= j
= 0; i
< n
; i
++)
951 if (j
< range
[i
].from
)
953 if (i
== 0 || ! NILP (tmp
[i
- 1]))
954 /* None of TMP[X] corresponds to Jth field. */
956 for (; j
< range
[i
].from
; j
++)
961 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
963 for (; j
< XLFD_LAST_INDEX
; j
++)
965 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
966 field
[XLFD_ENCODING_INDEX
]
967 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
972 /* Parse NAME (null terminated) as XLFD and store information in FONT
973 (font-spec or font-entity). Size property of FONT is set as
975 specified XLFD fields FONT property
976 --------------------- -------------
977 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
978 POINT_SIZE and RESY calculated pixel size (Lisp integer)
979 POINT_SIZE POINT_SIZE/10 (Lisp float)
981 If NAME is successfully parsed, return 0. Otherwise return -1.
983 FONT is usually a font-spec, but when this function is called from
984 X font backend driver, it is a font-entity. In that case, NAME is
985 a fully specified XLFD. */
988 font_parse_xlfd (char *name
, Lisp_Object font
)
990 ptrdiff_t len
= strlen (name
);
992 char *f
[XLFD_LAST_INDEX
+ 1];
996 if (len
> 255 || !len
)
997 /* Maximum XLFD name length is 255. */
999 /* Accept "*-.." as a fully specified XLFD. */
1000 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1001 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1004 for (p
= name
+ i
; *p
; p
++)
1008 if (i
== XLFD_LAST_INDEX
)
1013 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1014 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1016 if (i
== XLFD_LAST_INDEX
)
1018 /* Fully specified XLFD. */
1021 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1022 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1023 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1024 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1026 val
= INTERN_FIELD_SYM (i
);
1029 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1031 ASET (font
, j
, make_number (n
));
1034 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1035 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1036 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1038 ASET (font
, FONT_REGISTRY_INDEX
,
1039 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1040 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1042 p
= f
[XLFD_PIXEL_INDEX
];
1043 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1044 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1047 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1049 ASET (font
, FONT_SIZE_INDEX
, val
);
1050 else if (FONT_ENTITY_P (font
))
1054 double point_size
= -1;
1056 font_assert (FONT_SPEC_P (font
));
1057 p
= f
[XLFD_POINT_INDEX
];
1059 point_size
= parse_matrix (p
);
1060 else if (isdigit (*p
))
1061 point_size
= atoi (p
), point_size
/= 10;
1062 if (point_size
>= 0)
1063 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1067 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1068 if (! NILP (val
) && ! INTEGERP (val
))
1070 ASET (font
, FONT_DPI_INDEX
, val
);
1071 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1074 val
= font_prop_validate_spacing (QCspacing
, val
);
1075 if (! INTEGERP (val
))
1077 ASET (font
, FONT_SPACING_INDEX
, val
);
1079 p
= f
[XLFD_AVGWIDTH_INDEX
];
1082 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1083 if (! NILP (val
) && ! INTEGERP (val
))
1085 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1089 int wild_card_found
= 0;
1090 Lisp_Object prop
[XLFD_LAST_INDEX
];
1092 if (FONT_ENTITY_P (font
))
1094 for (j
= 0; j
< i
; j
++)
1098 if (f
[j
][1] && f
[j
][1] != '-')
1101 wild_card_found
= 1;
1104 prop
[j
] = INTERN_FIELD (j
);
1106 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1108 if (! wild_card_found
)
1110 if (font_expand_wildcards (prop
, i
) < 0)
1113 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1114 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1115 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1116 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1117 if (! NILP (prop
[i
]))
1119 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1121 ASET (font
, j
, make_number (n
));
1123 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1124 val
= prop
[XLFD_REGISTRY_INDEX
];
1127 val
= prop
[XLFD_ENCODING_INDEX
];
1129 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1131 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1132 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1134 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1135 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1137 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1139 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1140 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1141 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1143 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1145 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1148 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1149 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1150 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1152 val
= font_prop_validate_spacing (QCspacing
,
1153 prop
[XLFD_SPACING_INDEX
]);
1154 if (! INTEGERP (val
))
1156 ASET (font
, FONT_SPACING_INDEX
, val
);
1158 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1159 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1165 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1166 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1167 0, use PIXEL_SIZE instead. */
1170 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1173 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1177 font_assert (FONTP (font
));
1179 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1182 if (i
== FONT_ADSTYLE_INDEX
)
1183 j
= XLFD_ADSTYLE_INDEX
;
1184 else if (i
== FONT_REGISTRY_INDEX
)
1185 j
= XLFD_REGISTRY_INDEX
;
1186 val
= AREF (font
, i
);
1189 if (j
== XLFD_REGISTRY_INDEX
)
1190 f
[j
] = "*-*", len
+= 4;
1192 f
[j
] = "*", len
+= 2;
1197 val
= SYMBOL_NAME (val
);
1198 if (j
== XLFD_REGISTRY_INDEX
1199 && ! strchr (SSDATA (val
), '-'))
1201 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1202 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1204 f
[j
] = p
= alloca (SBYTES (val
) + 3);
1205 sprintf (p
, "%s-*", SDATA (val
));
1206 len
+= SBYTES (val
) + 3;
1210 f
[j
] = p
= alloca (SBYTES (val
) + 4);
1211 sprintf (p
, "%s*-*", SDATA (val
));
1212 len
+= SBYTES (val
) + 4;
1216 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1220 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1223 val
= font_style_symbolic (font
, i
, 0);
1225 f
[j
] = "*", len
+= 2;
1228 val
= SYMBOL_NAME (val
);
1229 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1233 val
= AREF (font
, FONT_SIZE_INDEX
);
1234 font_assert (NUMBERP (val
) || NILP (val
));
1242 f
[XLFD_PIXEL_INDEX
] = p
= alloca (22);
1243 len
+= sprintf (p
, "%d-*", i
) + 1;
1246 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1248 else if (FLOATP (val
))
1250 i
= XFLOAT_DATA (val
) * 10;
1251 f
[XLFD_PIXEL_INDEX
] = p
= alloca (12);
1252 len
+= sprintf (p
, "*-%d", i
) + 1;
1255 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1257 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1259 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1260 f
[XLFD_RESX_INDEX
] = p
= alloca (22);
1261 len
+= sprintf (p
, "%d-%d", i
, i
) + 1;
1264 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1265 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1267 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1269 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1270 : spacing
<= FONT_SPACING_DUAL
? "d"
1271 : spacing
<= FONT_SPACING_MONO
? "m"
1276 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1277 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1279 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (22);
1280 len
+= sprintf (p
, "%"pI
"d",
1281 XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1284 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1285 len
++; /* for terminating '\0'. */
1288 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1289 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1290 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1291 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1292 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1293 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1294 f
[XLFD_REGISTRY_INDEX
]);
1297 /* Parse NAME (null terminated) and store information in FONT
1298 (font-spec or font-entity). NAME is supplied in either the
1299 Fontconfig or GTK font name format. If NAME is successfully
1300 parsed, return 0. Otherwise return -1.
1302 The fontconfig format is
1304 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1308 FAMILY [PROPS...] [SIZE]
1310 This function tries to guess which format it is. */
1313 font_parse_fcname (char *name
, Lisp_Object font
)
1316 char *size_beg
= NULL
, *size_end
= NULL
;
1317 char *props_beg
= NULL
, *family_end
= NULL
;
1318 ptrdiff_t len
= strlen (name
);
1323 for (p
= name
; *p
; p
++)
1325 if (*p
== '\\' && p
[1])
1329 props_beg
= family_end
= p
;
1334 int decimal
= 0, size_found
= 1;
1335 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1338 if (*q
!= '.' || decimal
)
1357 Lisp_Object extra_props
= Qnil
;
1359 /* A fontconfig name with size and/or property data. */
1360 if (family_end
> name
)
1363 family
= font_intern_prop (name
, family_end
- name
, 1);
1364 ASET (font
, FONT_FAMILY_INDEX
, family
);
1368 double point_size
= strtod (size_beg
, &size_end
);
1369 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1370 if (*size_end
== ':' && size_end
[1])
1371 props_beg
= size_end
;
1375 /* Now parse ":KEY=VAL" patterns. */
1378 for (p
= props_beg
; *p
; p
= q
)
1380 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1383 /* Must be an enumerated value. */
1387 val
= font_intern_prop (p
, q
- p
, 1);
1389 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1390 && memcmp (p, STR, strlen (STR)) == 0)
1392 if (PROP_MATCH ("light")
1393 || PROP_MATCH ("medium")
1394 || PROP_MATCH ("demibold")
1395 || PROP_MATCH ("bold")
1396 || PROP_MATCH ("black"))
1397 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1398 else if (PROP_MATCH ("roman")
1399 || PROP_MATCH ("italic")
1400 || PROP_MATCH ("oblique"))
1401 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1402 else if (PROP_MATCH ("charcell"))
1403 ASET (font
, FONT_SPACING_INDEX
,
1404 make_number (FONT_SPACING_CHARCELL
));
1405 else if (PROP_MATCH ("mono"))
1406 ASET (font
, FONT_SPACING_INDEX
,
1407 make_number (FONT_SPACING_MONO
));
1408 else if (PROP_MATCH ("proportional"))
1409 ASET (font
, FONT_SPACING_INDEX
,
1410 make_number (FONT_SPACING_PROPORTIONAL
));
1419 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1420 prop
= FONT_SIZE_INDEX
;
1423 key
= font_intern_prop (p
, q
- p
, 1);
1424 prop
= get_font_prop_index (key
);
1428 for (q
= p
; *q
&& *q
!= ':'; q
++);
1429 val
= font_intern_prop (p
, q
- p
, 0);
1431 if (prop
>= FONT_FOUNDRY_INDEX
1432 && prop
< FONT_EXTRA_INDEX
)
1433 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1436 extra_props
= nconc2 (extra_props
,
1437 Fcons (Fcons (key
, val
), Qnil
));
1444 if (! NILP (extra_props
))
1446 struct font_driver_list
*driver_list
= font_driver_list
;
1447 for ( ; driver_list
; driver_list
= driver_list
->next
)
1448 if (driver_list
->driver
->filter_properties
)
1449 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1455 /* Either a fontconfig-style name with no size and property
1456 data, or a GTK-style name. */
1457 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1458 Lisp_Object width
= Qnil
, size
= Qnil
;
1462 /* Scan backwards from the end, looking for a size. */
1463 for (p
= name
+ len
- 1; p
>= name
; p
--)
1467 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1468 /* Found a font size. */
1469 size
= make_float (strtod (p
+ 1, NULL
));
1473 /* Now P points to the termination of the string, sans size.
1474 Scan backwards, looking for font properties. */
1475 for (; p
> name
; p
= q
)
1477 for (q
= p
- 1; q
>= name
; q
--)
1479 if (q
> name
&& *(q
-1) == '\\')
1480 --q
; /* Skip quoting backslashes. */
1486 word_len
= p
- word_start
;
1488 #define PROP_MATCH(STR) \
1489 (word_len == strlen (STR) \
1490 && memcmp (word_start, STR, strlen (STR)) == 0)
1491 #define PROP_SAVE(VAR, STR) \
1492 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1494 if (PROP_MATCH ("Ultra-Light"))
1495 PROP_SAVE (weight
, "ultra-light");
1496 else if (PROP_MATCH ("Light"))
1497 PROP_SAVE (weight
, "light");
1498 else if (PROP_MATCH ("Book"))
1499 PROP_SAVE (weight
, "book");
1500 else if (PROP_MATCH ("Medium"))
1501 PROP_SAVE (weight
, "medium");
1502 else if (PROP_MATCH ("Semi-Bold"))
1503 PROP_SAVE (weight
, "semi-bold");
1504 else if (PROP_MATCH ("Bold"))
1505 PROP_SAVE (weight
, "bold");
1506 else if (PROP_MATCH ("Italic"))
1507 PROP_SAVE (slant
, "italic");
1508 else if (PROP_MATCH ("Oblique"))
1509 PROP_SAVE (slant
, "oblique");
1510 else if (PROP_MATCH ("Semi-Condensed"))
1511 PROP_SAVE (width
, "semi-condensed");
1512 else if (PROP_MATCH ("Condensed"))
1513 PROP_SAVE (width
, "condensed");
1514 /* An unknown word must be part of the font name. */
1525 ASET (font
, FONT_FAMILY_INDEX
,
1526 font_intern_prop (name
, family_end
- name
, 1));
1528 ASET (font
, FONT_SIZE_INDEX
, size
);
1530 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1532 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1534 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1540 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1541 NAME (NBYTES length), and return the name length. If
1542 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1545 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1547 Lisp_Object family
, foundry
;
1548 Lisp_Object tail
, val
;
1553 Lisp_Object styles
[3];
1554 const char *style_names
[3] = { "weight", "slant", "width" };
1557 family
= AREF (font
, FONT_FAMILY_INDEX
);
1558 if (! NILP (family
))
1560 if (SYMBOLP (family
))
1562 family
= SYMBOL_NAME (family
);
1563 len
+= SBYTES (family
);
1569 val
= AREF (font
, FONT_SIZE_INDEX
);
1572 if (XINT (val
) != 0)
1573 pixel_size
= XINT (val
);
1575 len
+= 21; /* for ":pixelsize=NUM" */
1582 point_size
= (int) XFLOAT_DATA (val
);
1583 len
+= 11; /* for "-NUM" */
1586 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1587 if (! NILP (foundry
))
1589 if (SYMBOLP (foundry
))
1591 foundry
= SYMBOL_NAME (foundry
);
1592 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1598 for (i
= 0; i
< 3; i
++)
1600 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1601 if (! NILP (styles
[i
]))
1602 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1603 SDATA (SYMBOL_NAME (styles
[i
])));
1606 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1607 len
+= sprintf (work
, ":dpi=%"pI
"d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1608 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1609 len
+= strlen (":spacing=100");
1610 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1611 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1612 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1614 Lisp_Object key
= XCAR (XCAR (tail
)), value
= XCDR (XCAR (tail
));
1616 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1617 if (STRINGP (value
))
1618 len
+= SBYTES (value
);
1619 else if (INTEGERP (value
))
1620 len
+= sprintf (work
, "%"pI
"d", XINT (value
));
1621 else if (SYMBOLP (value
))
1622 len
+= (NILP (value
) ? 5 : 4); /* for "false" or "true" */
1628 if (! NILP (family
))
1629 p
+= sprintf (p
, "%s", SDATA (family
));
1633 p
+= sprintf (p
, "%d", point_size
);
1635 p
+= sprintf (p
, "-%d", point_size
);
1637 else if (pixel_size
> 0)
1638 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1639 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1640 p
+= sprintf (p
, ":foundry=%s",
1641 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1642 for (i
= 0; i
< 3; i
++)
1643 if (! NILP (styles
[i
]))
1644 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1645 SDATA (SYMBOL_NAME (styles
[i
])));
1646 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1647 p
+= sprintf (p
, ":dpi=%"pI
"d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1648 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1649 p
+= sprintf (p
, ":spacing=%"pI
"d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1650 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1652 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1653 p
+= sprintf (p
, ":scalable=true");
1655 p
+= sprintf (p
, ":scalable=false");
1660 /* Parse NAME (null terminated) and store information in FONT
1661 (font-spec or font-entity). If NAME is successfully parsed, return
1662 0. Otherwise return -1. */
1665 font_parse_name (char *name
, Lisp_Object font
)
1667 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1668 return font_parse_xlfd (name
, font
);
1669 return font_parse_fcname (name
, font
);
1673 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1674 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1678 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1684 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1686 CHECK_STRING (family
);
1687 len
= SBYTES (family
);
1688 p0
= SSDATA (family
);
1689 p1
= strchr (p0
, '-');
1692 if ((*p0
!= '*' && p1
- p0
> 0)
1693 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1694 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1697 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1700 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1702 if (! NILP (registry
))
1704 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1705 CHECK_STRING (registry
);
1706 len
= SBYTES (registry
);
1707 p0
= SSDATA (registry
);
1708 p1
= strchr (p0
, '-');
1711 if (SDATA (registry
)[len
- 1] == '*')
1712 registry
= concat2 (registry
, build_string ("-*"));
1714 registry
= concat2 (registry
, build_string ("*-*"));
1716 registry
= Fdowncase (registry
);
1717 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1722 /* This part (through the next ^L) is still experimental and not
1723 tested much. We may drastically change codes. */
1729 #define LGSTRING_HEADER_SIZE 6
1730 #define LGSTRING_GLYPH_SIZE 8
1733 check_gstring (gstring
)
1734 Lisp_Object gstring
;
1739 CHECK_VECTOR (gstring
);
1740 val
= AREF (gstring
, 0);
1742 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1744 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1745 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1746 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1747 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1748 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1749 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1750 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1751 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1752 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1753 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1754 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1756 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1758 val
= LGSTRING_GLYPH (gstring
, i
);
1760 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1762 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1764 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1765 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1766 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1767 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1768 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1769 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1770 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1771 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1773 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1775 if (ASIZE (val
) < 3)
1777 for (j
= 0; j
< 3; j
++)
1778 CHECK_NUMBER (AREF (val
, j
));
1783 error ("Invalid glyph-string format");
1788 check_otf_features (otf_features
)
1789 Lisp_Object otf_features
;
1793 CHECK_CONS (otf_features
);
1794 CHECK_SYMBOL (XCAR (otf_features
));
1795 otf_features
= XCDR (otf_features
);
1796 CHECK_CONS (otf_features
);
1797 CHECK_SYMBOL (XCAR (otf_features
));
1798 otf_features
= XCDR (otf_features
);
1799 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1801 CHECK_SYMBOL (Fcar (val
));
1802 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1803 error ("Invalid OTF GSUB feature: %s",
1804 SDATA (SYMBOL_NAME (XCAR (val
))));
1806 otf_features
= XCDR (otf_features
);
1807 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1809 CHECK_SYMBOL (Fcar (val
));
1810 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1811 error ("Invalid OTF GPOS feature: %s",
1812 SDATA (SYMBOL_NAME (XCAR (val
))));
1819 Lisp_Object otf_list
;
1822 otf_tag_symbol (tag
)
1827 OTF_tag_name (tag
, name
);
1828 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1835 Lisp_Object val
= Fassoc (file
, otf_list
);
1839 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1842 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1843 val
= make_save_value (otf
, 0);
1844 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1850 /* Return a list describing which scripts/languages FONT supports by
1851 which GSUB/GPOS features of OpenType tables. See the comment of
1852 (struct font_driver).otf_capability. */
1855 font_otf_capability (font
)
1859 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1862 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1865 for (i
= 0; i
< 2; i
++)
1867 OTF_GSUB_GPOS
*gsub_gpos
;
1868 Lisp_Object script_list
= Qnil
;
1871 if (OTF_get_features (otf
, i
== 0) < 0)
1873 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1874 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1876 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1877 Lisp_Object langsys_list
= Qnil
;
1878 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1881 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1883 OTF_LangSys
*langsys
;
1884 Lisp_Object feature_list
= Qnil
;
1885 Lisp_Object langsys_tag
;
1888 if (k
== script
->LangSysCount
)
1890 langsys
= &script
->DefaultLangSys
;
1895 langsys
= script
->LangSys
+ k
;
1897 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1899 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1901 OTF_Feature
*feature
1902 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1903 Lisp_Object feature_tag
1904 = otf_tag_symbol (feature
->FeatureTag
);
1906 feature_list
= Fcons (feature_tag
, feature_list
);
1908 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1911 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1916 XSETCAR (capability
, script_list
);
1918 XSETCDR (capability
, script_list
);
1924 /* Parse OTF features in SPEC and write a proper features spec string
1925 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1926 assured that the sufficient memory has already allocated for
1930 generate_otf_features (spec
, features
)
1940 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1946 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1951 else if (! asterisk
)
1953 val
= SYMBOL_NAME (val
);
1954 p
+= sprintf (p
, "%s", SDATA (val
));
1958 val
= SYMBOL_NAME (val
);
1959 p
+= sprintf (p
, "~%s", SDATA (val
));
1963 error ("OTF spec too long");
1967 font_otf_DeviceTable (device_table
)
1968 OTF_DeviceTable
*device_table
;
1970 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1972 return Fcons (make_number (len
),
1973 make_unibyte_string (device_table
->DeltaValue
, len
));
1977 font_otf_ValueRecord (value_format
, value_record
)
1979 OTF_ValueRecord
*value_record
;
1981 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1983 if (value_format
& OTF_XPlacement
)
1984 ASET (val
, 0, make_number (value_record
->XPlacement
));
1985 if (value_format
& OTF_YPlacement
)
1986 ASET (val
, 1, make_number (value_record
->YPlacement
));
1987 if (value_format
& OTF_XAdvance
)
1988 ASET (val
, 2, make_number (value_record
->XAdvance
));
1989 if (value_format
& OTF_YAdvance
)
1990 ASET (val
, 3, make_number (value_record
->YAdvance
));
1991 if (value_format
& OTF_XPlaDevice
)
1992 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1993 if (value_format
& OTF_YPlaDevice
)
1994 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1995 if (value_format
& OTF_XAdvDevice
)
1996 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1997 if (value_format
& OTF_YAdvDevice
)
1998 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2003 font_otf_Anchor (anchor
)
2008 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2009 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2010 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2011 if (anchor
->AnchorFormat
== 2)
2012 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2015 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2016 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2020 #endif /* HAVE_LIBOTF */
2026 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2027 static int font_compare (const void *, const void *);
2028 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2032 font_rescale_ratio (Lisp_Object font_entity
)
2034 Lisp_Object tail
, elt
;
2035 Lisp_Object name
= Qnil
;
2037 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2040 if (FLOATP (XCDR (elt
)))
2042 if (STRINGP (XCAR (elt
)))
2045 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2046 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2047 return XFLOAT_DATA (XCDR (elt
));
2049 else if (FONT_SPEC_P (XCAR (elt
)))
2051 if (font_match_p (XCAR (elt
), font_entity
))
2052 return XFLOAT_DATA (XCDR (elt
));
2059 /* We sort fonts by scoring each of them against a specified
2060 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2061 the value is, the closer the font is to the font-spec.
2063 The lowest 2 bits of the score are used for driver type. The font
2064 available by the most preferred font driver is 0.
2066 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2067 WEIGHT, SLANT, WIDTH, and SIZE. */
2069 /* How many bits to shift to store the difference value of each font
2070 property in a score. Note that floats for FONT_TYPE_INDEX and
2071 FONT_REGISTRY_INDEX are not used. */
2072 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2074 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2075 The return value indicates how different ENTITY is compared with
2079 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2084 /* Score three style numeric fields. Maximum difference is 127. */
2085 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2086 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2088 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2089 - (XINT (spec_prop
[i
]) >> 8));
2092 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2095 /* Score the size. Maximum difference is 127. */
2096 i
= FONT_SIZE_INDEX
;
2097 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2098 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2100 /* We use the higher 6-bit for the actual size difference. The
2101 lowest bit is set if the DPI is different. */
2103 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2105 if (CONSP (Vface_font_rescale_alist
))
2106 pixel_size
*= font_rescale_ratio (entity
);
2107 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2111 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2112 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2114 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2115 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2117 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2124 /* Concatenate all elements of LIST into one vector. LIST is a list
2125 of font-entity vectors. */
2128 font_vconcat_entity_vectors (Lisp_Object list
)
2130 int nargs
= XINT (Flength (list
));
2131 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2134 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2135 args
[i
] = XCAR (list
);
2136 return Fvconcat (nargs
, args
);
2140 /* The structure for elements being sorted by qsort. */
2141 struct font_sort_data
2144 int font_driver_preference
;
2149 /* The comparison function for qsort. */
2152 font_compare (const void *d1
, const void *d2
)
2154 const struct font_sort_data
*data1
= d1
;
2155 const struct font_sort_data
*data2
= d2
;
2157 if (data1
->score
< data2
->score
)
2159 else if (data1
->score
> data2
->score
)
2161 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2165 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2166 If PREFER specifies a point-size, calculate the corresponding
2167 pixel-size from QCdpi property of PREFER or from the Y-resolution
2168 of FRAME before sorting.
2170 If BEST-ONLY is nonzero, return the best matching entity (that
2171 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2172 if BEST-ONLY is negative). Otherwise, return the sorted result as
2173 a single vector of font-entities.
2175 This function does no optimization for the case that the total
2176 number of elements is 1. The caller should avoid calling this in
2180 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2182 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2184 struct font_sort_data
*data
;
2185 unsigned best_score
;
2186 Lisp_Object best_entity
;
2187 struct frame
*f
= XFRAME (frame
);
2188 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2191 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2192 prefer_prop
[i
] = AREF (prefer
, i
);
2193 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2194 prefer_prop
[FONT_SIZE_INDEX
]
2195 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2197 if (NILP (XCDR (list
)))
2199 /* What we have to take care of is this single vector. */
2201 maxlen
= ASIZE (vec
);
2205 /* We don't have to perform sort, so there's no need of creating
2206 a single vector. But, we must find the length of the longest
2209 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2210 if (maxlen
< ASIZE (XCAR (tail
)))
2211 maxlen
= ASIZE (XCAR (tail
));
2215 /* We have to create a single vector to sort it. */
2216 vec
= font_vconcat_entity_vectors (list
);
2217 maxlen
= ASIZE (vec
);
2220 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2221 best_score
= 0xFFFFFFFF;
2224 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2226 int font_driver_preference
= 0;
2227 Lisp_Object current_font_driver
;
2233 /* We are sure that the length of VEC > 0. */
2234 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2235 /* Score the elements. */
2236 for (i
= 0; i
< len
; i
++)
2238 data
[i
].entity
= AREF (vec
, i
);
2240 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2242 ? font_score (data
[i
].entity
, prefer_prop
)
2244 if (best_only
&& best_score
> data
[i
].score
)
2246 best_score
= data
[i
].score
;
2247 best_entity
= data
[i
].entity
;
2248 if (best_score
== 0)
2251 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2253 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2254 font_driver_preference
++;
2256 data
[i
].font_driver_preference
= font_driver_preference
;
2259 /* Sort if necessary. */
2262 qsort (data
, len
, sizeof *data
, font_compare
);
2263 for (i
= 0; i
< len
; i
++)
2264 ASET (vec
, i
, data
[i
].entity
);
2273 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2278 /* API of Font Service Layer. */
2280 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2281 sort_shift_bits. Finternal_set_font_selection_order calls this
2282 function with font_sort_order after setting up it. */
2285 font_update_sort_order (int *order
)
2289 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2291 int xlfd_idx
= order
[i
];
2293 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2294 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2295 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2296 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2297 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2298 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2300 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2305 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2310 table
= assq_no_quit (script
, table
);
2313 table
= XCDR (table
);
2314 if (! NILP (langsys
))
2316 table
= assq_no_quit (langsys
, table
);
2322 val
= assq_no_quit (Qnil
, table
);
2324 table
= XCAR (table
);
2328 table
= XCDR (table
);
2329 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2331 if (NILP (XCAR (features
)))
2336 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2342 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2345 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2347 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2349 script
= XCAR (spec
);
2353 langsys
= XCAR (spec
);
2364 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2365 XCAR (otf_capability
)))
2367 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2368 XCDR (otf_capability
)))
2375 /* Check if FONT (font-entity or font-object) matches with the font
2376 specification SPEC. */
2379 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2381 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2382 Lisp_Object extra
, font_extra
;
2385 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2386 if (! NILP (AREF (spec
, i
))
2387 && ! NILP (AREF (font
, i
))
2388 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2390 props
= XFONT_SPEC (spec
)->props
;
2391 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2393 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2394 prop
[i
] = AREF (spec
, i
);
2395 prop
[FONT_SIZE_INDEX
]
2396 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2400 if (font_score (font
, props
) > 0)
2402 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2403 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2404 for (; CONSP (extra
); extra
= XCDR (extra
))
2406 Lisp_Object key
= XCAR (XCAR (extra
));
2407 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2409 if (EQ (key
, QClang
))
2411 val2
= assq_no_quit (key
, font_extra
);
2420 if (NILP (Fmemq (val
, val2
)))
2425 ? NILP (Fmemq (val
, XCDR (val2
)))
2429 else if (EQ (key
, QCscript
))
2431 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2437 /* All characters in the list must be supported. */
2438 for (; CONSP (val2
); val2
= XCDR (val2
))
2440 if (! NATNUMP (XCAR (val2
)))
2442 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2443 == FONT_INVALID_CODE
)
2447 else if (VECTORP (val2
))
2449 /* At most one character in the vector must be supported. */
2450 for (i
= 0; i
< ASIZE (val2
); i
++)
2452 if (! NATNUMP (AREF (val2
, i
)))
2454 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2455 != FONT_INVALID_CODE
)
2458 if (i
== ASIZE (val2
))
2463 else if (EQ (key
, QCotf
))
2467 if (! FONT_OBJECT_P (font
))
2469 fontp
= XFONT_OBJECT (font
);
2470 if (! fontp
->driver
->otf_capability
)
2472 val2
= fontp
->driver
->otf_capability (fontp
);
2473 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2484 Each font backend has the callback function get_cache, and it
2485 returns a cons cell of which cdr part can be freely used for
2486 caching fonts. The cons cell may be shared by multiple frames
2487 and/or multiple font drivers. So, we arrange the cdr part as this:
2489 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2491 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2492 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2493 cons (FONT-SPEC FONT-ENTITY ...). */
2495 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2496 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2497 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2498 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2499 struct font_driver
*);
2502 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2504 Lisp_Object cache
, val
;
2506 cache
= driver
->get_cache (f
);
2508 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2512 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2513 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2517 val
= XCDR (XCAR (val
));
2518 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2524 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2526 Lisp_Object cache
, val
, tmp
;
2529 cache
= driver
->get_cache (f
);
2531 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2532 cache
= val
, val
= XCDR (val
);
2533 font_assert (! NILP (val
));
2534 tmp
= XCDR (XCAR (val
));
2535 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2536 if (XINT (XCAR (tmp
)) == 0)
2538 font_clear_cache (f
, XCAR (val
), driver
);
2539 XSETCDR (cache
, XCDR (val
));
2545 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2547 Lisp_Object val
= driver
->get_cache (f
);
2548 Lisp_Object type
= driver
->type
;
2550 font_assert (CONSP (val
));
2551 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2552 font_assert (CONSP (val
));
2553 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2554 val
= XCDR (XCAR (val
));
2558 static int num_fonts
;
2561 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2563 Lisp_Object tail
, elt
;
2564 Lisp_Object tail2
, entity
;
2566 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2567 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2570 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2571 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2573 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2575 entity
= XCAR (tail2
);
2577 if (FONT_ENTITY_P (entity
)
2578 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2580 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2582 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2584 Lisp_Object val
= XCAR (objlist
);
2585 struct font
*font
= XFONT_OBJECT (val
);
2587 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2589 font_assert (font
&& driver
== font
->driver
);
2590 driver
->close (f
, font
);
2594 if (driver
->free_entity
)
2595 driver
->free_entity (entity
);
2600 XSETCDR (cache
, Qnil
);
2604 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2606 /* Check each font-entity in VEC, and return a list of font-entities
2607 that satisfy these conditions:
2608 (1) matches with SPEC and SIZE if SPEC is not nil, and
2609 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2613 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2615 Lisp_Object entity
, val
;
2616 enum font_property_index prop
;
2619 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2621 entity
= AREF (vec
, i
);
2622 if (! NILP (Vface_ignored_fonts
))
2625 Lisp_Object tail
, regexp
;
2627 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2629 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2631 regexp
= XCAR (tail
);
2632 if (STRINGP (regexp
)
2633 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2642 val
= Fcons (entity
, val
);
2645 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2646 if (INTEGERP (AREF (spec
, prop
))
2647 && ((XINT (AREF (spec
, prop
)) >> 8)
2648 != (XINT (AREF (entity
, prop
)) >> 8)))
2649 prop
= FONT_SPEC_MAX
;
2650 if (prop
< FONT_SPEC_MAX
2652 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2654 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2657 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2658 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2659 prop
= FONT_SPEC_MAX
;
2661 if (prop
< FONT_SPEC_MAX
2662 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2663 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2664 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2665 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2666 prop
= FONT_SPEC_MAX
;
2667 if (prop
< FONT_SPEC_MAX
2668 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2669 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2670 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2671 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2672 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2673 prop
= FONT_SPEC_MAX
;
2674 if (prop
< FONT_SPEC_MAX
)
2675 val
= Fcons (entity
, val
);
2677 return (Fvconcat (1, &val
));
2681 /* Return a list of vectors of font-entities matching with SPEC on
2682 FRAME. Each elements in the list is a vector of entities from the
2683 same font-driver. */
2686 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2688 FRAME_PTR f
= XFRAME (frame
);
2689 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2690 Lisp_Object ftype
, val
;
2691 Lisp_Object list
= Qnil
;
2693 int need_filtering
= 0;
2696 font_assert (FONT_SPEC_P (spec
));
2698 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2699 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2700 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2701 size
= font_pixel_size (f
, spec
);
2705 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2706 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2707 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2708 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2709 if (i
!= FONT_SPACING_INDEX
)
2711 ASET (scratch_font_spec
, i
, Qnil
);
2712 if (! NILP (AREF (spec
, i
)))
2715 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2716 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2718 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2720 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2722 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2724 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2725 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2732 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2736 val
= Fvconcat (1, &val
);
2737 copy
= copy_font_spec (scratch_font_spec
);
2738 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2739 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2743 || ! NILP (Vface_ignored_fonts
)))
2744 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2745 if (ASIZE (val
) > 0)
2746 list
= Fcons (val
, list
);
2749 list
= Fnreverse (list
);
2750 FONT_ADD_LOG ("list", spec
, list
);
2755 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2756 nil, is an array of face's attributes, which specifies preferred
2757 font-related attributes. */
2760 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2762 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2763 Lisp_Object ftype
, size
, entity
;
2765 Lisp_Object work
= copy_font_spec (spec
);
2767 XSETFRAME (frame
, f
);
2768 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2769 size
= AREF (spec
, FONT_SIZE_INDEX
);
2772 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2773 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2774 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2775 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2778 for (; driver_list
; driver_list
= driver_list
->next
)
2780 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2782 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2785 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2786 entity
= assoc_no_quit (work
, XCDR (cache
));
2788 entity
= XCDR (entity
);
2791 entity
= driver_list
->driver
->match (frame
, work
);
2792 copy
= copy_font_spec (work
);
2793 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2794 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2796 if (! NILP (entity
))
2799 FONT_ADD_LOG ("match", work
, entity
);
2804 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2805 opened font object. */
2808 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2810 struct font_driver_list
*driver_list
;
2811 Lisp_Object objlist
, size
, val
, font_object
;
2813 int min_width
, height
;
2814 int scaled_pixel_size
= pixel_size
;
2816 font_assert (FONT_ENTITY_P (entity
));
2817 size
= AREF (entity
, FONT_SIZE_INDEX
);
2818 if (XINT (size
) != 0)
2819 scaled_pixel_size
= pixel_size
= XINT (size
);
2820 else if (CONSP (Vface_font_rescale_alist
))
2821 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2823 val
= AREF (entity
, FONT_TYPE_INDEX
);
2824 for (driver_list
= f
->font_driver_list
;
2825 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2826 driver_list
= driver_list
->next
);
2830 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2831 objlist
= XCDR (objlist
))
2833 Lisp_Object fn
= XCAR (objlist
);
2834 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2835 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2837 if (driver_list
->driver
->cached_font_ok
== NULL
2838 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2843 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2844 if (!NILP (font_object
))
2845 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2846 FONT_ADD_LOG ("open", entity
, font_object
);
2847 if (NILP (font_object
))
2849 ASET (entity
, FONT_OBJLIST_INDEX
,
2850 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2853 font
= XFONT_OBJECT (font_object
);
2854 min_width
= (font
->min_width
? font
->min_width
2855 : font
->average_width
? font
->average_width
2856 : font
->space_width
? font
->space_width
2858 height
= (font
->height
? font
->height
: 1);
2859 #ifdef HAVE_WINDOW_SYSTEM
2860 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2861 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2863 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2864 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2865 fonts_changed_p
= 1;
2869 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2870 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2871 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2872 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2880 /* Close FONT_OBJECT that is opened on frame F. */
2883 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2885 struct font
*font
= XFONT_OBJECT (font_object
);
2887 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2888 /* Already closed. */
2890 FONT_ADD_LOG ("close", font_object
, Qnil
);
2891 font
->driver
->close (f
, font
);
2892 #ifdef HAVE_WINDOW_SYSTEM
2893 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2894 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2900 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2901 FONT is a font-entity and it must be opened to check. */
2904 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2908 if (FONT_ENTITY_P (font
))
2910 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2911 struct font_driver_list
*driver_list
;
2913 for (driver_list
= f
->font_driver_list
;
2914 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2915 driver_list
= driver_list
->next
);
2918 if (! driver_list
->driver
->has_char
)
2920 return driver_list
->driver
->has_char (font
, c
);
2923 font_assert (FONT_OBJECT_P (font
));
2924 fontp
= XFONT_OBJECT (font
);
2925 if (fontp
->driver
->has_char
)
2927 int result
= fontp
->driver
->has_char (font
, c
);
2932 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2936 /* Return the glyph ID of FONT_OBJECT for character C. */
2939 font_encode_char (Lisp_Object font_object
, int c
)
2943 font_assert (FONT_OBJECT_P (font_object
));
2944 font
= XFONT_OBJECT (font_object
);
2945 return font
->driver
->encode_char (font
, c
);
2949 /* Return the name of FONT_OBJECT. */
2952 font_get_name (Lisp_Object font_object
)
2954 font_assert (FONT_OBJECT_P (font_object
));
2955 return AREF (font_object
, FONT_NAME_INDEX
);
2959 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2960 could not be parsed by font_parse_name, return Qnil. */
2963 font_spec_from_name (Lisp_Object font_name
)
2965 Lisp_Object spec
= Ffont_spec (0, NULL
);
2967 CHECK_STRING (font_name
);
2968 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2970 font_put_extra (spec
, QCname
, font_name
);
2971 font_put_extra (spec
, QCuser_spec
, font_name
);
2977 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2979 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2984 if (! NILP (Ffont_get (font
, QCname
)))
2986 font
= copy_font_spec (font
);
2987 font_put_extra (font
, QCname
, Qnil
);
2990 if (NILP (AREF (font
, prop
))
2991 && prop
!= FONT_FAMILY_INDEX
2992 && prop
!= FONT_FOUNDRY_INDEX
2993 && prop
!= FONT_WIDTH_INDEX
2994 && prop
!= FONT_SIZE_INDEX
)
2996 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
2997 font
= copy_font_spec (font
);
2998 ASET (font
, prop
, Qnil
);
2999 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3001 if (prop
== FONT_FAMILY_INDEX
)
3003 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3004 /* If we are setting the font family, we must also clear
3005 FONT_WIDTH_INDEX to avoid rejecting families that lack
3006 support for some widths. */
3007 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3009 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3010 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3011 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3012 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3013 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3014 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3016 else if (prop
== FONT_SIZE_INDEX
)
3018 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3019 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3020 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3022 else if (prop
== FONT_WIDTH_INDEX
)
3023 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3024 attrs
[LFACE_FONT_INDEX
] = font
;
3027 /* Select a font from ENTITIES (list of font-entity vectors) that
3028 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3031 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3033 Lisp_Object font_entity
;
3036 FRAME_PTR f
= XFRAME (frame
);
3038 if (NILP (XCDR (entities
))
3039 && ASIZE (XCAR (entities
)) == 1)
3041 font_entity
= AREF (XCAR (entities
), 0);
3043 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3048 /* Sort fonts by properties specified in ATTRS. */
3049 prefer
= scratch_font_prefer
;
3051 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3052 ASET (prefer
, i
, Qnil
);
3053 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3055 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3057 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3058 ASET (prefer
, i
, AREF (face_font
, i
));
3060 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3061 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3062 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3063 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3064 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3065 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3066 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3068 return font_sort_entities (entities
, prefer
, frame
, c
);
3071 /* Return a font-entity that satisfies SPEC and is the best match for
3072 face's font related attributes in ATTRS. C, if not negative, is a
3073 character that the entity must support. */
3076 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3079 Lisp_Object frame
, entities
, val
;
3080 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3084 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3085 if (NILP (registry
[0]))
3087 registry
[0] = DEFAULT_ENCODING
;
3088 registry
[1] = Qascii_0
;
3089 registry
[2] = null_vector
;
3092 registry
[1] = null_vector
;
3094 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3096 struct charset
*encoding
, *repertory
;
3098 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3099 &encoding
, &repertory
) < 0)
3102 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3104 else if (c
> encoding
->max_char
)
3108 work
= copy_font_spec (spec
);
3109 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3110 XSETFRAME (frame
, f
);
3111 pixel_size
= font_pixel_size (f
, spec
);
3112 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3114 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3116 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3118 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3119 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3120 if (! NILP (foundry
[0]))
3121 foundry
[1] = null_vector
;
3122 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3124 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3125 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3127 foundry
[2] = null_vector
;
3130 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3132 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3133 if (! NILP (adstyle
[0]))
3134 adstyle
[1] = null_vector
;
3135 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3137 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3139 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3141 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3143 adstyle
[2] = null_vector
;
3146 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3149 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3152 val
= AREF (work
, FONT_FAMILY_INDEX
);
3153 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3155 val
= attrs
[LFACE_FAMILY_INDEX
];
3156 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3160 family
= alloca ((sizeof family
[0]) * 2);
3162 family
[1] = null_vector
; /* terminator. */
3167 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3168 /* Font family names are case-sensitive under NS. */
3176 if (! NILP (alters
))
3178 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3179 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3180 family
[i
] = XCAR (alters
);
3181 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3183 family
[i
] = null_vector
;
3187 family
= alloca ((sizeof family
[0]) * 3);
3190 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3192 family
[i
] = null_vector
;
3196 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3198 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3199 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3201 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3202 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3204 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3205 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3207 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3208 entities
= font_list_entities (frame
, work
);
3209 if (! NILP (entities
))
3211 val
= font_select_entity (frame
, entities
,
3212 attrs
, pixel_size
, c
);
3225 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3229 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3230 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3231 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3232 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3233 size
= font_pixel_size (f
, spec
);
3237 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3238 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3241 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3242 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3243 if (INTEGERP (height
))
3246 abort(); /* We should never end up here. */
3250 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3254 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3255 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3259 return font_open_entity (f
, entity
, size
);
3263 /* Find a font that satisfies SPEC and is the best match for
3264 face's attributes in ATTRS on FRAME, and return the opened
3268 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3270 Lisp_Object entity
, name
;
3272 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3275 /* No font is listed for SPEC, but each font-backend may have
3276 different criteria about "font matching". So, try it. */
3277 entity
= font_matching_entity (f
, attrs
, spec
);
3281 /* Don't lose the original name that was put in initially. We need
3282 it to re-apply the font when font parameters (like hinting or dpi) have
3284 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3287 name
= Ffont_get (spec
, QCuser_spec
);
3288 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3294 /* Make FACE on frame F ready to use the font opened for FACE. */
3297 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3299 if (face
->font
->driver
->prepare_face
)
3300 face
->font
->driver
->prepare_face (f
, face
);
3304 /* Make FACE on frame F stop using the font opened for FACE. */
3307 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3309 if (face
->font
->driver
->done_face
)
3310 face
->font
->driver
->done_face (f
, face
);
3315 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3316 font is found, return Qnil. */
3319 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3321 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3323 /* We set up the default font-related attributes of a face to prefer
3325 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3326 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3327 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3329 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3331 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3333 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3335 return font_load_for_lface (f
, attrs
, spec
);
3339 /* Open a font that matches NAME on frame F. If no proper font is
3340 found, return Qnil. */
3343 font_open_by_name (FRAME_PTR f
, const char *name
)
3345 Lisp_Object args
[2];
3346 Lisp_Object spec
, ret
;
3349 args
[1] = make_unibyte_string (name
, strlen (name
));
3350 spec
= Ffont_spec (2, args
);
3351 ret
= font_open_by_spec (f
, spec
);
3352 /* Do not lose name originally put in. */
3354 font_put_extra (ret
, QCuser_spec
, args
[1]);
3360 /* Register font-driver DRIVER. This function is used in two ways.
3362 The first is with frame F non-NULL. In this case, make DRIVER
3363 available (but not yet activated) on F. All frame creators
3364 (e.g. Fx_create_frame) must call this function at least once with
3365 an available font-driver.
3367 The second is with frame F NULL. In this case, DRIVER is globally
3368 registered in the variable `font_driver_list'. All font-driver
3369 implementations must call this function in its syms_of_XXXX
3370 (e.g. syms_of_xfont). */
3373 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3375 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3376 struct font_driver_list
*prev
, *list
;
3378 if (f
&& ! driver
->draw
)
3379 error ("Unusable font driver for a frame: %s",
3380 SDATA (SYMBOL_NAME (driver
->type
)));
3382 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3383 if (EQ (list
->driver
->type
, driver
->type
))
3384 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3386 list
= xmalloc (sizeof (struct font_driver_list
));
3388 list
->driver
= driver
;
3393 f
->font_driver_list
= list
;
3395 font_driver_list
= list
;
3401 free_font_driver_list (FRAME_PTR f
)
3403 struct font_driver_list
*list
, *next
;
3405 for (list
= f
->font_driver_list
; list
; list
= next
)
3410 f
->font_driver_list
= NULL
;
3414 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3415 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3416 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3418 A caller must free all realized faces if any in advance. The
3419 return value is a list of font backends actually made used on
3423 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3425 Lisp_Object active_drivers
= Qnil
;
3426 struct font_driver_list
*list
;
3428 /* At first, turn off non-requested drivers, and turn on requested
3430 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3432 struct font_driver
*driver
= list
->driver
;
3433 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3438 if (driver
->end_for_frame
)
3439 driver
->end_for_frame (f
);
3440 font_finish_cache (f
, driver
);
3445 if (! driver
->start_for_frame
3446 || driver
->start_for_frame (f
) == 0)
3448 font_prepare_cache (f
, driver
);
3455 if (NILP (new_drivers
))
3458 if (! EQ (new_drivers
, Qt
))
3460 /* Re-order the driver list according to new_drivers. */
3461 struct font_driver_list
**list_table
, **next
;
3465 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3466 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3468 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3469 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3472 list_table
[i
++] = list
;
3474 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3476 list_table
[i
++] = list
;
3477 list_table
[i
] = NULL
;
3479 next
= &f
->font_driver_list
;
3480 for (i
= 0; list_table
[i
]; i
++)
3482 *next
= list_table
[i
];
3483 next
= &(*next
)->next
;
3487 if (! f
->font_driver_list
->on
)
3488 { /* None of the drivers is enabled: enable them all.
3489 Happens if you set the list of drivers to (xft x) in your .emacs
3490 and then use it under w32 or ns. */
3491 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3493 struct font_driver
*driver
= list
->driver
;
3494 eassert (! list
->on
);
3495 if (! driver
->start_for_frame
3496 || driver
->start_for_frame (f
) == 0)
3498 font_prepare_cache (f
, driver
);
3505 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3507 active_drivers
= nconc2 (active_drivers
,
3508 Fcons (list
->driver
->type
, Qnil
));
3509 return active_drivers
;
3513 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3515 struct font_data_list
*list
, *prev
;
3517 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3518 prev
= list
, list
= list
->next
)
3519 if (list
->driver
== driver
)
3526 prev
->next
= list
->next
;
3528 f
->font_data_list
= list
->next
;
3536 list
= xmalloc (sizeof (struct font_data_list
));
3537 list
->driver
= driver
;
3538 list
->next
= f
->font_data_list
;
3539 f
->font_data_list
= list
;
3547 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3549 struct font_data_list
*list
;
3551 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3552 if (list
->driver
== driver
)
3560 /* Sets attributes on a font. Any properties that appear in ALIST and
3561 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3562 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3563 arrays of strings. This function is intended for use by the font
3564 drivers to implement their specific font_filter_properties. */
3566 font_filter_properties (Lisp_Object font
,
3568 const char *const boolean_properties
[],
3569 const char *const non_boolean_properties
[])
3574 /* Set boolean values to Qt or Qnil */
3575 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3576 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3578 Lisp_Object key
= XCAR (XCAR (it
));
3579 Lisp_Object val
= XCDR (XCAR (it
));
3580 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3582 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3584 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3585 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3588 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3589 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3590 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3591 || strcmp ("Off", str
) == 0)
3596 Ffont_put (font
, key
, val
);
3600 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3601 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3603 Lisp_Object key
= XCAR (XCAR (it
));
3604 Lisp_Object val
= XCDR (XCAR (it
));
3605 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3606 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3607 Ffont_put (font
, key
, val
);
3612 /* Return the font used to draw character C by FACE at buffer position
3613 POS in window W. If STRING is non-nil, it is a string containing C
3614 at index POS. If C is negative, get C from the current buffer or
3618 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3623 Lisp_Object font_object
;
3625 multibyte
= (NILP (string
)
3626 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3627 : STRING_MULTIBYTE (string
));
3634 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3636 c
= FETCH_CHAR (pos_byte
);
3639 c
= FETCH_BYTE (pos
);
3645 multibyte
= STRING_MULTIBYTE (string
);
3648 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3650 str
= SDATA (string
) + pos_byte
;
3651 c
= STRING_CHAR (str
);
3654 c
= SDATA (string
)[pos
];
3658 f
= XFRAME (w
->frame
);
3659 if (! FRAME_WINDOW_P (f
))
3666 if (STRINGP (string
))
3667 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3668 DEFAULT_FACE_ID
, 0);
3670 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3672 face
= FACE_FROM_ID (f
, face_id
);
3676 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3677 face
= FACE_FROM_ID (f
, face_id
);
3682 XSETFONT (font_object
, face
->font
);
3687 #ifdef HAVE_WINDOW_SYSTEM
3689 /* Check how many characters after POS (at most to *LIMIT) can be
3690 displayed by the same font in the window W. FACE, if non-NULL, is
3691 the face selected for the character at POS. If STRING is not nil,
3692 it is the string to check instead of the current buffer. In that
3693 case, FACE must be not NULL.
3695 The return value is the font-object for the character at POS.
3696 *LIMIT is set to the position where that font can't be used.
3698 It is assured that the current buffer (or STRING) is multibyte. */
3701 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3703 EMACS_INT pos_byte
, ignore
;
3705 Lisp_Object font_object
= Qnil
;
3709 pos_byte
= CHAR_TO_BYTE (pos
);
3714 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3716 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3722 pos_byte
= string_char_to_byte (string
, pos
);
3725 while (pos
< *limit
)
3727 Lisp_Object category
;
3730 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3732 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3733 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3734 if (EQ (category
, QCf
)
3735 || CHAR_VARIATION_SELECTOR_P (c
))
3737 if (NILP (font_object
))
3739 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3740 if (NILP (font_object
))
3744 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3754 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3755 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3756 Return nil otherwise.
3757 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3758 which kind of font it is. It must be one of `font-spec', `font-entity',
3760 (Lisp_Object object
, Lisp_Object extra_type
)
3762 if (NILP (extra_type
))
3763 return (FONTP (object
) ? Qt
: Qnil
);
3764 if (EQ (extra_type
, Qfont_spec
))
3765 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3766 if (EQ (extra_type
, Qfont_entity
))
3767 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3768 if (EQ (extra_type
, Qfont_object
))
3769 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3770 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3773 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3774 doc
: /* Return a newly created font-spec with arguments as properties.
3776 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3777 valid font property name listed below:
3779 `:family', `:weight', `:slant', `:width'
3781 They are the same as face attributes of the same name. See
3782 `set-face-attribute'.
3786 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3790 VALUE must be a string or a symbol specifying the additional
3791 typographic style information of a font, e.g. ``sans''.
3795 VALUE must be a string or a symbol specifying the charset registry and
3796 encoding of a font, e.g. ``iso8859-1''.
3800 VALUE must be a non-negative integer or a floating point number
3801 specifying the font size. It specifies the font size in pixels (if
3802 VALUE is an integer), or in points (if VALUE is a float).
3806 VALUE must be a string of XLFD-style or fontconfig-style font name.
3810 VALUE must be a symbol representing a script that the font must
3811 support. It may be a symbol representing a subgroup of a script
3812 listed in the variable `script-representative-chars'.
3816 VALUE must be a symbol of two-letter ISO-639 language names,
3821 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3822 required OpenType features.
3824 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3825 LANGSYS-TAG: OpenType language system tag symbol,
3826 or nil for the default language system.
3827 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3828 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3830 GSUB and GPOS may contain `nil' element. In such a case, the font
3831 must not have any of the remaining elements.
3833 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3834 be an OpenType font whose GPOS table of `thai' script's default
3835 language system must contain `mark' feature.
3837 usage: (font-spec ARGS...) */)
3838 (ptrdiff_t nargs
, Lisp_Object
*args
)
3840 Lisp_Object spec
= font_make_spec ();
3843 for (i
= 0; i
< nargs
; i
+= 2)
3845 Lisp_Object key
= args
[i
], val
;
3849 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3852 if (EQ (key
, QCname
))
3855 font_parse_name (SSDATA (val
), spec
);
3856 font_put_extra (spec
, key
, val
);
3860 int idx
= get_font_prop_index (key
);
3864 val
= font_prop_validate (idx
, Qnil
, val
);
3865 if (idx
< FONT_EXTRA_INDEX
)
3866 ASET (spec
, idx
, val
);
3868 font_put_extra (spec
, key
, val
);
3871 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3877 /* Return a copy of FONT as a font-spec. */
3879 copy_font_spec (Lisp_Object font
)
3881 Lisp_Object new_spec
, tail
, prev
, extra
;
3885 new_spec
= font_make_spec ();
3886 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3887 ASET (new_spec
, i
, AREF (font
, i
));
3888 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3889 /* We must remove :font-entity property. */
3890 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3891 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3894 extra
= XCDR (extra
);
3896 XSETCDR (prev
, XCDR (tail
));
3899 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3903 /* Merge font-specs FROM and TO, and return a new font-spec.
3904 Every specified property in FROM overrides the corresponding
3907 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3909 Lisp_Object extra
, tail
;
3914 to
= copy_font_spec (to
);
3915 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3916 ASET (to
, i
, AREF (from
, i
));
3917 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3918 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3919 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3921 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3924 XSETCDR (slot
, XCDR (XCAR (tail
)));
3926 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3928 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3932 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3933 doc
: /* Return the value of FONT's property KEY.
3934 FONT is a font-spec, a font-entity, or a font-object.
3935 KEY is any symbol, but these are reserved for specific meanings:
3936 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3937 :size, :name, :script, :otf
3938 See the documentation of `font-spec' for their meanings.
3939 In addition, if FONT is a font-entity or a font-object, values of
3940 :script and :otf are different from those of a font-spec as below:
3942 The value of :script may be a list of scripts that are supported by the font.
3944 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3945 representing the OpenType features supported by the font by this form:
3946 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3947 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3949 (Lisp_Object font
, Lisp_Object key
)
3957 idx
= get_font_prop_index (key
);
3958 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3959 return font_style_symbolic (font
, idx
, 0);
3960 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3961 return AREF (font
, idx
);
3962 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3963 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3965 struct font
*fontp
= XFONT_OBJECT (font
);
3967 if (fontp
->driver
->otf_capability
)
3968 val
= fontp
->driver
->otf_capability (fontp
);
3970 val
= Fcons (Qnil
, Qnil
);
3977 #ifdef HAVE_WINDOW_SYSTEM
3979 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3980 doc
: /* Return a plist of face attributes generated by FONT.
3981 FONT is a font name, a font-spec, a font-entity, or a font-object.
3982 The return value is a list of the form
3984 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3986 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3987 compatible with `set-face-attribute'. Some of these key-attribute pairs
3988 may be omitted from the list if they are not specified by FONT.
3990 The optional argument FRAME specifies the frame that the face attributes
3991 are to be displayed on. If omitted, the selected frame is used. */)
3992 (Lisp_Object font
, Lisp_Object frame
)
3995 Lisp_Object plist
[10];
4000 frame
= selected_frame
;
4001 CHECK_LIVE_FRAME (frame
);
4006 int fontset
= fs_query_fontset (font
, 0);
4007 Lisp_Object name
= font
;
4009 font
= fontset_ascii (fontset
);
4010 font
= font_spec_from_name (name
);
4012 signal_error ("Invalid font name", name
);
4014 else if (! FONTP (font
))
4015 signal_error ("Invalid font object", font
);
4017 val
= AREF (font
, FONT_FAMILY_INDEX
);
4020 plist
[n
++] = QCfamily
;
4021 plist
[n
++] = SYMBOL_NAME (val
);
4024 val
= AREF (font
, FONT_SIZE_INDEX
);
4027 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4028 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4029 plist
[n
++] = QCheight
;
4030 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4032 else if (FLOATP (val
))
4034 plist
[n
++] = QCheight
;
4035 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4038 val
= FONT_WEIGHT_FOR_FACE (font
);
4041 plist
[n
++] = QCweight
;
4045 val
= FONT_SLANT_FOR_FACE (font
);
4048 plist
[n
++] = QCslant
;
4052 val
= FONT_WIDTH_FOR_FACE (font
);
4055 plist
[n
++] = QCwidth
;
4059 return Flist (n
, plist
);
4064 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4065 doc
: /* Set one property of FONT: give property KEY value VAL.
4066 FONT is a font-spec, a font-entity, or a font-object.
4068 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4069 accepted by the function `font-spec' (which see), VAL must be what
4070 allowed in `font-spec'.
4072 If FONT is a font-entity or a font-object, KEY must not be the one
4073 accepted by `font-spec'. */)
4074 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4078 idx
= get_font_prop_index (prop
);
4079 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4081 CHECK_FONT_SPEC (font
);
4082 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4086 if (EQ (prop
, QCname
)
4087 || EQ (prop
, QCscript
)
4088 || EQ (prop
, QClang
)
4089 || EQ (prop
, QCotf
))
4090 CHECK_FONT_SPEC (font
);
4093 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4098 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4099 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4100 Optional 2nd argument FRAME specifies the target frame.
4101 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4102 Optional 4th argument PREFER, if non-nil, is a font-spec to
4103 control the order of the returned list. Fonts are sorted by
4104 how close they are to PREFER. */)
4105 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4107 Lisp_Object vec
, list
;
4111 frame
= selected_frame
;
4112 CHECK_LIVE_FRAME (frame
);
4113 CHECK_FONT_SPEC (font_spec
);
4121 if (! NILP (prefer
))
4122 CHECK_FONT_SPEC (prefer
);
4124 list
= font_list_entities (frame
, font_spec
);
4127 if (NILP (XCDR (list
))
4128 && ASIZE (XCAR (list
)) == 1)
4129 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4131 if (! NILP (prefer
))
4132 vec
= font_sort_entities (list
, prefer
, frame
, 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 Optional argument FRAME, if non-nil, specifies the target frame. */)
4157 struct font_driver_list
*driver_list
;
4161 frame
= selected_frame
;
4162 CHECK_LIVE_FRAME (frame
);
4165 for (driver_list
= f
->font_driver_list
; driver_list
;
4166 driver_list
= driver_list
->next
)
4167 if (driver_list
->driver
->list_family
)
4169 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4170 Lisp_Object tail
= list
;
4172 for (; CONSP (val
); val
= XCDR (val
))
4173 if (NILP (Fmemq (XCAR (val
), tail
))
4174 && SYMBOLP (XCAR (val
)))
4175 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4180 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4181 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4182 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4183 (Lisp_Object font_spec
, Lisp_Object frame
)
4185 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4192 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4193 doc
: /* Return XLFD name of FONT.
4194 FONT is a font-spec, font-entity, or font-object.
4195 If the name is too long for XLFD (maximum 255 chars), return nil.
4196 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4197 the consecutive wildcards are folded into one. */)
4198 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4205 if (FONT_OBJECT_P (font
))
4207 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4209 if (STRINGP (font_name
)
4210 && SDATA (font_name
)[0] == '-')
4212 if (NILP (fold_wildcards
))
4214 strcpy (name
, SSDATA (font_name
));
4217 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4219 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4222 if (! NILP (fold_wildcards
))
4224 char *p0
= name
, *p1
;
4226 while ((p1
= strstr (p0
, "-*-*")))
4228 strcpy (p1
, p1
+ 2);
4233 return build_string (name
);
4236 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4237 doc
: /* Clear font cache. */)
4240 Lisp_Object list
, frame
;
4242 FOR_EACH_FRAME (list
, frame
)
4244 FRAME_PTR f
= XFRAME (frame
);
4245 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4247 for (; driver_list
; driver_list
= driver_list
->next
)
4248 if (driver_list
->on
)
4250 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4251 Lisp_Object val
, tmp
;
4255 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4257 font_assert (! NILP (val
));
4258 tmp
= XCDR (XCAR (val
));
4259 if (XINT (XCAR (tmp
)) == 0)
4261 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4262 XSETCDR (cache
, XCDR (val
));
4272 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4274 struct font
*font
= XFONT_OBJECT (font_object
);
4276 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4277 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4278 struct font_metrics metrics
;
4280 LGLYPH_SET_CODE (glyph
, ecode
);
4282 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4283 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4284 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4285 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4286 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4287 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4291 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4292 doc
: /* Shape the glyph-string GSTRING.
4293 Shaping means substituting glyphs and/or adjusting positions of glyphs
4294 to get the correct visual image of character sequences set in the
4295 header of the glyph-string.
4297 If the shaping was successful, the value is GSTRING itself or a newly
4298 created glyph-string. Otherwise, the value is nil. */)
4299 (Lisp_Object gstring
)
4302 Lisp_Object font_object
, n
, glyph
;
4303 EMACS_INT i
, j
, 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 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4325 if (i
== 3 || XINT (n
) == 0)
4327 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4328 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4330 glyph
= LGSTRING_GLYPH (gstring
, 0);
4331 from
= LGLYPH_FROM (glyph
);
4332 to
= LGLYPH_TO (glyph
);
4333 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4335 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4339 if (NILP (LGLYPH_ADJUSTMENT (this)))
4344 glyph
= LGSTRING_GLYPH (gstring
, j
);
4345 LGLYPH_SET_FROM (glyph
, from
);
4346 LGLYPH_SET_TO (glyph
, to
);
4348 from
= LGLYPH_FROM (this);
4349 to
= LGLYPH_TO (this);
4354 if (from
> LGLYPH_FROM (this))
4355 from
= LGLYPH_FROM (this);
4356 if (to
< LGLYPH_TO (this))
4357 to
= LGLYPH_TO (this);
4363 glyph
= LGSTRING_GLYPH (gstring
, j
);
4364 LGLYPH_SET_FROM (glyph
, from
);
4365 LGLYPH_SET_TO (glyph
, to
);
4367 return composition_gstring_put_cache (gstring
, XINT (n
));
4370 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4372 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4373 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4375 VARIATION-SELECTOR is a character code of variation selection
4376 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4377 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4378 (Lisp_Object font_object
, Lisp_Object character
)
4380 unsigned variations
[256];
4385 CHECK_FONT_OBJECT (font_object
);
4386 CHECK_CHARACTER (character
);
4387 font
= XFONT_OBJECT (font_object
);
4388 if (! font
->driver
->get_variation_glyphs
)
4390 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4394 for (i
= 0; i
< 255; i
++)
4397 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4398 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4399 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4406 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4407 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4408 OTF-FEATURES specifies which features to apply in this format:
4409 (SCRIPT LANGSYS GSUB GPOS)
4411 SCRIPT is a symbol specifying a script tag of OpenType,
4412 LANGSYS is a symbol specifying a langsys tag of OpenType,
4413 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4415 If LANGYS is nil, the default langsys is selected.
4417 The features are applied in the order they appear in the list. The
4418 symbol `*' means to apply all available features not present in this
4419 list, and the remaining features are ignored. For instance, (vatu
4420 pstf * haln) is to apply vatu and pstf in this order, then to apply
4421 all available features other than vatu, pstf, and haln.
4423 The features are applied to the glyphs in the range FROM and TO of
4424 the glyph-string GSTRING-IN.
4426 If some feature is actually applicable, the resulting glyphs are
4427 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4428 this case, the value is the number of produced glyphs.
4430 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4433 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4434 produced in GSTRING-OUT, and the value is nil.
4436 See the documentation of `composition-get-gstring' for the format of
4438 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4440 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4445 check_otf_features (otf_features
);
4446 CHECK_FONT_OBJECT (font_object
);
4447 font
= XFONT_OBJECT (font_object
);
4448 if (! font
->driver
->otf_drive
)
4449 error ("Font backend %s can't drive OpenType GSUB table",
4450 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4451 CHECK_CONS (otf_features
);
4452 CHECK_SYMBOL (XCAR (otf_features
));
4453 val
= XCDR (otf_features
);
4454 CHECK_SYMBOL (XCAR (val
));
4455 val
= XCDR (otf_features
);
4458 len
= check_gstring (gstring_in
);
4459 CHECK_VECTOR (gstring_out
);
4460 CHECK_NATNUM (from
);
4462 CHECK_NATNUM (index
);
4464 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4465 args_out_of_range_3 (from
, to
, make_number (len
));
4466 if (XINT (index
) >= ASIZE (gstring_out
))
4467 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4468 num
= font
->driver
->otf_drive (font
, otf_features
,
4469 gstring_in
, XINT (from
), XINT (to
),
4470 gstring_out
, XINT (index
), 0);
4473 return make_number (num
);
4476 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4478 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4479 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4481 (SCRIPT LANGSYS FEATURE ...)
4482 See the documentation of `font-drive-otf' for more detail.
4484 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4485 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4486 character code corresponding to the glyph or nil if there's no
4487 corresponding character. */)
4488 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4491 Lisp_Object gstring_in
, gstring_out
, g
;
4492 Lisp_Object alternates
;
4495 CHECK_FONT_GET_OBJECT (font_object
, font
);
4496 if (! font
->driver
->otf_drive
)
4497 error ("Font backend %s can't drive OpenType GSUB table",
4498 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4499 CHECK_CHARACTER (character
);
4500 CHECK_CONS (otf_features
);
4502 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4503 g
= LGSTRING_GLYPH (gstring_in
, 0);
4504 LGLYPH_SET_CHAR (g
, XINT (character
));
4505 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4506 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4507 gstring_out
, 0, 1)) < 0)
4508 gstring_out
= Ffont_make_gstring (font_object
,
4509 make_number (ASIZE (gstring_out
) * 2));
4511 for (i
= 0; i
< num
; i
++)
4513 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4514 int c
= LGLYPH_CHAR (g
);
4515 unsigned code
= LGLYPH_CODE (g
);
4517 alternates
= Fcons (Fcons (make_number (code
),
4518 c
> 0 ? make_number (c
) : Qnil
),
4521 return Fnreverse (alternates
);
4527 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4528 doc
: /* Open FONT-ENTITY. */)
4529 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4533 CHECK_FONT_ENTITY (font_entity
);
4535 frame
= selected_frame
;
4536 CHECK_LIVE_FRAME (frame
);
4539 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4542 CHECK_NUMBER_OR_FLOAT (size
);
4544 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4546 isize
= XINT (size
);
4550 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4553 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4554 doc
: /* Close FONT-OBJECT. */)
4555 (Lisp_Object font_object
, Lisp_Object frame
)
4557 CHECK_FONT_OBJECT (font_object
);
4559 frame
= selected_frame
;
4560 CHECK_LIVE_FRAME (frame
);
4561 font_close_object (XFRAME (frame
), font_object
);
4565 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4566 doc
: /* Return information about FONT-OBJECT.
4567 The value is a vector:
4568 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4571 NAME is the font name, a string (or nil if the font backend doesn't
4574 FILENAME is the font file name, a string (or nil if the font backend
4575 doesn't provide a file name).
4577 PIXEL-SIZE is a pixel size by which the font is opened.
4579 SIZE is a maximum advance width of the font in pixels.
4581 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4584 CAPABILITY is a list whose first element is a symbol representing the
4585 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4586 remaining elements describe the details of the font capability.
4588 If the font is OpenType font, the form of the list is
4589 \(opentype GSUB GPOS)
4590 where GSUB shows which "GSUB" features the font supports, and GPOS
4591 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4592 lists of the format:
4593 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4595 If the font is not OpenType font, currently the length of the form is
4598 SCRIPT is a symbol representing OpenType script tag.
4600 LANGSYS is a symbol representing OpenType langsys tag, or nil
4601 representing the default langsys.
4603 FEATURE is a symbol representing OpenType feature tag.
4605 If the font is not OpenType font, CAPABILITY is nil. */)
4606 (Lisp_Object font_object
)
4611 CHECK_FONT_GET_OBJECT (font_object
, font
);
4613 val
= Fmake_vector (make_number (9), Qnil
);
4614 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4615 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4616 ASET (val
, 2, make_number (font
->pixel_size
));
4617 ASET (val
, 3, make_number (font
->max_width
));
4618 ASET (val
, 4, make_number (font
->ascent
));
4619 ASET (val
, 5, make_number (font
->descent
));
4620 ASET (val
, 6, make_number (font
->space_width
));
4621 ASET (val
, 7, make_number (font
->average_width
));
4622 if (font
->driver
->otf_capability
)
4623 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4627 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4629 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4630 FROM and TO are positions (integers or markers) specifying a region
4631 of the current buffer.
4632 If the optional fourth arg OBJECT is not nil, it is a string or a
4633 vector containing the target characters.
4635 Each element is a vector containing information of a glyph in this format:
4636 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4638 FROM is an index numbers of a character the glyph corresponds to.
4639 TO is the same as FROM.
4640 C is the character of the glyph.
4641 CODE is the glyph-code of C in FONT-OBJECT.
4642 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4643 ADJUSTMENT is always nil.
4644 If FONT-OBJECT doesn't have a glyph for a character,
4645 the corresponding element is nil. */)
4646 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4651 Lisp_Object
*chars
, vec
;
4654 CHECK_FONT_GET_OBJECT (font_object
, font
);
4657 EMACS_INT charpos
, bytepos
;
4659 validate_region (&from
, &to
);
4662 len
= XFASTINT (to
) - XFASTINT (from
);
4663 SAFE_ALLOCA_LISP (chars
, len
);
4664 charpos
= XFASTINT (from
);
4665 bytepos
= CHAR_TO_BYTE (charpos
);
4666 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4669 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4670 chars
[i
] = make_number (c
);
4673 else if (STRINGP (object
))
4675 const unsigned char *p
;
4677 CHECK_NUMBER (from
);
4679 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4680 || XINT (to
) > SCHARS (object
))
4681 args_out_of_range_3 (object
, from
, to
);
4684 len
= XFASTINT (to
) - XFASTINT (from
);
4685 SAFE_ALLOCA_LISP (chars
, len
);
4687 if (STRING_MULTIBYTE (object
))
4688 for (i
= 0; i
< len
; i
++)
4690 int c
= STRING_CHAR_ADVANCE (p
);
4691 chars
[i
] = make_number (c
);
4694 for (i
= 0; i
< len
; i
++)
4695 chars
[i
] = make_number (p
[i
]);
4699 CHECK_VECTOR (object
);
4700 CHECK_NUMBER (from
);
4702 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4703 || XINT (to
) > ASIZE (object
))
4704 args_out_of_range_3 (object
, from
, to
);
4707 len
= XFASTINT (to
) - XFASTINT (from
);
4708 for (i
= 0; i
< len
; i
++)
4710 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4711 CHECK_CHARACTER (elt
);
4713 chars
= &(AREF (object
, XFASTINT (from
)));
4716 vec
= Fmake_vector (make_number (len
), Qnil
);
4717 for (i
= 0; i
< len
; i
++)
4720 int c
= XFASTINT (chars
[i
]);
4722 struct font_metrics metrics
;
4724 code
= font
->driver
->encode_char (font
, c
);
4725 if (code
== FONT_INVALID_CODE
)
4727 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4728 LGLYPH_SET_FROM (g
, i
);
4729 LGLYPH_SET_TO (g
, i
);
4730 LGLYPH_SET_CHAR (g
, c
);
4731 LGLYPH_SET_CODE (g
, code
);
4732 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4733 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4734 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4735 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4736 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4737 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4740 if (! VECTORP (object
))
4745 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4746 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4747 FONT is a font-spec, font-entity, or font-object. */)
4748 (Lisp_Object spec
, Lisp_Object font
)
4750 CHECK_FONT_SPEC (spec
);
4753 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4756 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4757 doc
: /* Return a font-object for displaying a character at POSITION.
4758 Optional second arg WINDOW, if non-nil, is a window displaying
4759 the current buffer. It defaults to the currently selected window. */)
4760 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4767 CHECK_NUMBER_COERCE_MARKER (position
);
4768 pos
= XINT (position
);
4769 if (pos
< BEGV
|| pos
>= ZV
)
4770 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4774 CHECK_NUMBER (position
);
4775 CHECK_STRING (string
);
4776 pos
= XINT (position
);
4777 if (pos
< 0 || pos
>= SCHARS (string
))
4778 args_out_of_range (string
, position
);
4781 window
= selected_window
;
4782 CHECK_LIVE_WINDOW (window
);
4783 w
= XWINDOW (window
);
4785 return font_at (-1, pos
, NULL
, w
, string
);
4789 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4790 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4791 The value is a number of glyphs drawn.
4792 Type C-l to recover what previously shown. */)
4793 (Lisp_Object font_object
, Lisp_Object string
)
4795 Lisp_Object frame
= selected_frame
;
4796 FRAME_PTR f
= XFRAME (frame
);
4802 CHECK_FONT_GET_OBJECT (font_object
, font
);
4803 CHECK_STRING (string
);
4804 len
= SCHARS (string
);
4805 code
= alloca (sizeof (unsigned) * len
);
4806 for (i
= 0; i
< len
; i
++)
4808 Lisp_Object ch
= Faref (string
, make_number (i
));
4812 code
[i
] = font
->driver
->encode_char (font
, c
);
4813 if (code
[i
] == FONT_INVALID_CODE
)
4816 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4818 if (font
->driver
->prepare_face
)
4819 font
->driver
->prepare_face (f
, face
);
4820 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4821 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4822 if (font
->driver
->done_face
)
4823 font
->driver
->done_face (f
, face
);
4825 return make_number (len
);
4829 #endif /* FONT_DEBUG */
4831 #ifdef HAVE_WINDOW_SYSTEM
4833 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4834 doc
: /* Return information about a font named NAME on frame FRAME.
4835 If FRAME is omitted or nil, use the selected frame.
4836 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4837 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4839 OPENED-NAME is the name used for opening the font,
4840 FULL-NAME is the full name of the font,
4841 SIZE is the pixelsize of the font,
4842 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4843 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4844 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4845 how to compose characters.
4846 If the named font is not yet loaded, return nil. */)
4847 (Lisp_Object name
, Lisp_Object frame
)
4852 Lisp_Object font_object
;
4854 (*check_window_system_func
) ();
4857 CHECK_STRING (name
);
4859 frame
= selected_frame
;
4860 CHECK_LIVE_FRAME (frame
);
4865 int fontset
= fs_query_fontset (name
, 0);
4868 name
= fontset_ascii (fontset
);
4869 font_object
= font_open_by_name (f
, SSDATA (name
));
4871 else if (FONT_OBJECT_P (name
))
4873 else if (FONT_ENTITY_P (name
))
4874 font_object
= font_open_entity (f
, name
, 0);
4877 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4878 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4880 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4882 if (NILP (font_object
))
4884 font
= XFONT_OBJECT (font_object
);
4886 info
= Fmake_vector (make_number (7), Qnil
);
4887 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4888 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4889 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4890 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4891 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4892 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4893 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4896 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4897 close it now. Perhaps, we should manage font-objects
4898 by `reference-count'. */
4899 font_close_object (f
, font_object
);
4906 #define BUILD_STYLE_TABLE(TBL) \
4907 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4910 build_style_table (const struct table_entry
*entry
, int nelement
)
4913 Lisp_Object table
, elt
;
4915 table
= Fmake_vector (make_number (nelement
), Qnil
);
4916 for (i
= 0; i
< nelement
; i
++)
4918 for (j
= 0; entry
[i
].names
[j
]; j
++);
4919 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4920 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4921 for (j
= 0; entry
[i
].names
[j
]; j
++)
4922 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4923 ASET (table
, i
, elt
);
4928 /* The deferred font-log data of the form [ACTION ARG RESULT].
4929 If ACTION is not nil, that is added to the log when font_add_log is
4930 called next time. At that time, ACTION is set back to nil. */
4931 static Lisp_Object Vfont_log_deferred
;
4933 /* Prepend the font-related logging data in Vfont_log if it is not
4934 `t'. ACTION describes a kind of font-related action (e.g. listing,
4935 opening), ARG is the argument for the action, and RESULT is the
4936 result of the action. */
4938 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4943 if (EQ (Vfont_log
, Qt
))
4945 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4947 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4949 ASET (Vfont_log_deferred
, 0, Qnil
);
4950 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4951 AREF (Vfont_log_deferred
, 2));
4956 Lisp_Object tail
, elt
;
4957 Lisp_Object equalstr
= build_string ("=");
4959 val
= Ffont_xlfd_name (arg
, Qt
);
4960 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4964 if (EQ (XCAR (elt
), QCscript
)
4965 && SYMBOLP (XCDR (elt
)))
4966 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4967 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4968 else if (EQ (XCAR (elt
), QClang
)
4969 && SYMBOLP (XCDR (elt
)))
4970 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4971 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4972 else if (EQ (XCAR (elt
), QCotf
)
4973 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4974 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4976 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4982 && VECTORP (XCAR (result
))
4983 && ASIZE (XCAR (result
)) > 0
4984 && FONTP (AREF (XCAR (result
), 0)))
4985 result
= font_vconcat_entity_vectors (result
);
4988 val
= Ffont_xlfd_name (result
, Qt
);
4989 if (! FONT_SPEC_P (result
))
4990 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4991 build_string (":"), val
);
4994 else if (CONSP (result
))
4997 result
= Fcopy_sequence (result
);
4998 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5002 val
= Ffont_xlfd_name (val
, Qt
);
5003 XSETCAR (tail
, val
);
5006 else if (VECTORP (result
))
5008 result
= Fcopy_sequence (result
);
5009 for (i
= 0; i
< ASIZE (result
); i
++)
5011 val
= AREF (result
, i
);
5013 val
= Ffont_xlfd_name (val
, Qt
);
5014 ASET (result
, i
, val
);
5017 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5020 /* Record a font-related logging data to be added to Vfont_log when
5021 font_add_log is called next time. ACTION, ARG, RESULT are the same
5025 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5027 if (EQ (Vfont_log
, Qt
))
5029 ASET (Vfont_log_deferred
, 0, build_string (action
));
5030 ASET (Vfont_log_deferred
, 1, arg
);
5031 ASET (Vfont_log_deferred
, 2, result
);
5037 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5038 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5039 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5040 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5041 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5042 /* Note that the other elements in sort_shift_bits are not used. */
5044 staticpro (&font_charset_alist
);
5045 font_charset_alist
= Qnil
;
5047 DEFSYM (Qopentype
, "opentype");
5049 DEFSYM (Qascii_0
, "ascii-0");
5050 DEFSYM (Qiso8859_1
, "iso8859-1");
5051 DEFSYM (Qiso10646_1
, "iso10646-1");
5052 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5053 DEFSYM (Qunicode_sip
, "unicode-sip");
5057 DEFSYM (QCotf
, ":otf");
5058 DEFSYM (QClang
, ":lang");
5059 DEFSYM (QCscript
, ":script");
5060 DEFSYM (QCantialias
, ":antialias");
5062 DEFSYM (QCfoundry
, ":foundry");
5063 DEFSYM (QCadstyle
, ":adstyle");
5064 DEFSYM (QCregistry
, ":registry");
5065 DEFSYM (QCspacing
, ":spacing");
5066 DEFSYM (QCdpi
, ":dpi");
5067 DEFSYM (QCscalable
, ":scalable");
5068 DEFSYM (QCavgwidth
, ":avgwidth");
5069 DEFSYM (QCfont_entity
, ":font-entity");
5070 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5080 DEFSYM (QCuser_spec
, "user-spec");
5082 staticpro (&null_vector
);
5083 null_vector
= Fmake_vector (make_number (0), Qnil
);
5085 staticpro (&scratch_font_spec
);
5086 scratch_font_spec
= Ffont_spec (0, NULL
);
5087 staticpro (&scratch_font_prefer
);
5088 scratch_font_prefer
= Ffont_spec (0, NULL
);
5090 staticpro (&Vfont_log_deferred
);
5091 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5095 staticpro (&otf_list
);
5097 #endif /* HAVE_LIBOTF */
5101 defsubr (&Sfont_spec
);
5102 defsubr (&Sfont_get
);
5103 #ifdef HAVE_WINDOW_SYSTEM
5104 defsubr (&Sfont_face_attributes
);
5106 defsubr (&Sfont_put
);
5107 defsubr (&Slist_fonts
);
5108 defsubr (&Sfont_family_list
);
5109 defsubr (&Sfind_font
);
5110 defsubr (&Sfont_xlfd_name
);
5111 defsubr (&Sclear_font_cache
);
5112 defsubr (&Sfont_shape_gstring
);
5113 defsubr (&Sfont_variation_glyphs
);
5115 defsubr (&Sfont_drive_otf
);
5116 defsubr (&Sfont_otf_alternates
);
5120 defsubr (&Sopen_font
);
5121 defsubr (&Sclose_font
);
5122 defsubr (&Squery_font
);
5123 defsubr (&Sfont_get_glyphs
);
5124 defsubr (&Sfont_match_p
);
5125 defsubr (&Sfont_at
);
5127 defsubr (&Sdraw_string
);
5129 #endif /* FONT_DEBUG */
5130 #ifdef HAVE_WINDOW_SYSTEM
5131 defsubr (&Sfont_info
);
5134 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5136 Alist of fontname patterns vs the corresponding encoding and repertory info.
5137 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5138 where ENCODING is a charset or a char-table,
5139 and REPERTORY is a charset, a char-table, or nil.
5141 If ENCODING and REPERTORY are the same, the element can have the form
5142 \(REGEXP . ENCODING).
5144 ENCODING is for converting a character to a glyph code of the font.
5145 If ENCODING is a charset, encoding a character by the charset gives
5146 the corresponding glyph code. If ENCODING is a char-table, looking up
5147 the table by a character gives the corresponding glyph code.
5149 REPERTORY specifies a repertory of characters supported by the font.
5150 If REPERTORY is a charset, all characters beloging to the charset are
5151 supported. If REPERTORY is a char-table, all characters who have a
5152 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5153 gets the repertory information by an opened font and ENCODING. */);
5154 Vfont_encoding_alist
= Qnil
;
5156 /* FIXME: These 3 vars are not quite what they appear: setq on them
5157 won't have any effect other than disconnect them from the style
5158 table used by the font display code. So we make them read-only,
5159 to avoid this confusing situation. */
5161 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5162 doc
: /* Vector of valid font weight values.
5163 Each element has the form:
5164 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5165 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5166 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5167 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5169 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5170 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5171 See `font-weight-table' for the format of the vector. */);
5172 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5173 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5175 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5176 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5177 See `font-weight-table' for the format of the vector. */);
5178 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5179 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5181 staticpro (&font_style_table
);
5182 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5183 ASET (font_style_table
, 0, Vfont_weight_table
);
5184 ASET (font_style_table
, 1, Vfont_slant_table
);
5185 ASET (font_style_table
, 2, Vfont_width_table
);
5187 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5188 *Logging list of font related actions and results.
5189 The value t means to suppress the logging.
5190 The initial value is set to nil if the environment variable
5191 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5194 #ifdef HAVE_WINDOW_SYSTEM
5195 #ifdef HAVE_FREETYPE
5197 #ifdef HAVE_X_WINDOWS
5202 #endif /* HAVE_XFT */
5203 #endif /* HAVE_X_WINDOWS */
5204 #else /* not HAVE_FREETYPE */
5205 #ifdef HAVE_X_WINDOWS
5207 #endif /* HAVE_X_WINDOWS */
5208 #endif /* not HAVE_FREETYPE */
5211 #endif /* HAVE_BDFFONT */
5214 #endif /* WINDOWSNT */
5217 #endif /* HAVE_NS */
5218 #endif /* HAVE_WINDOW_SYSTEM */
5224 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;