1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
4 Free Software Foundation, Inc.
5 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
6 National Institute of Advanced Industrial Science and Technology (AIST)
7 Registration Number H13PRO009
9 This file is part of GNU Emacs.
11 GNU Emacs is free software: you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
13 the Free Software Foundation, either version 3 of the License, or
14 (at your option) any later version.
16 GNU Emacs is distributed in the hope that it will be useful,
17 but WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 GNU General Public License for more details.
21 You should have received a copy of the GNU General Public License
22 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
33 #include "dispextern.h"
35 #include "character.h"
36 #include "composite.h"
42 #endif /* HAVE_X_WINDOWS */
46 #endif /* HAVE_NTGUI */
52 Lisp_Object Qopentype
;
54 /* Important character set strings. */
55 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
57 #define DEFAULT_ENCODING Qiso8859_1
59 /* Unicode category `Cf'. */
60 static Lisp_Object QCf
;
62 /* Special vector of zero length. This is repeatedly used by (struct
63 font_driver *)->list when a specified font is not found. */
64 static Lisp_Object null_vector
;
66 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
67 static Lisp_Object font_style_table
;
69 /* Structure used for tables mapping weight, slant, and width numeric
70 values and their names. */
75 /* The first one is a valid name as a face attribute.
76 The second one (if any) is a typical name in XLFD field. */
80 /* Table of weight numeric values and their names. This table must be
81 sorted by numeric values in ascending order. */
83 static const struct table_entry weight_table
[] =
86 { 20, { "ultra-light", "ultralight" }},
87 { 40, { "extra-light", "extralight" }},
89 { 75, { "semi-light", "semilight", "demilight", "book" }},
90 { 100, { "normal", "medium", "regular", "unspecified" }},
91 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
93 { 205, { "extra-bold", "extrabold" }},
94 { 210, { "ultra-bold", "ultrabold", "black" }}
97 /* Table of slant numeric values and their names. This table must be
98 sorted by numeric values in ascending order. */
100 static const struct table_entry slant_table
[] =
102 { 0, { "reverse-oblique", "ro" }},
103 { 10, { "reverse-italic", "ri" }},
104 { 100, { "normal", "r", "unspecified" }},
105 { 200, { "italic" ,"i", "ot" }},
106 { 210, { "oblique", "o" }}
109 /* Table of width numeric values and their names. This table must be
110 sorted by numeric values in ascending order. */
112 static const struct table_entry width_table
[] =
114 { 50, { "ultra-condensed", "ultracondensed" }},
115 { 63, { "extra-condensed", "extracondensed" }},
116 { 75, { "condensed", "compressed", "narrow" }},
117 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
118 { 100, { "normal", "medium", "regular", "unspecified" }},
119 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
120 { 125, { "expanded" }},
121 { 150, { "extra-expanded", "extraexpanded" }},
122 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
125 Lisp_Object QCfoundry
;
126 static Lisp_Object QCadstyle
, QCregistry
;
127 /* Symbols representing keys of font extra info. */
128 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
129 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
130 /* Symbols representing values of font spacing property. */
131 Lisp_Object Qc
, Qm
, Qp
, Qd
;
132 /* Special ADSTYLE properties to avoid fonts used for Latin
133 characters; used in xfont.c and ftfont.c. */
134 Lisp_Object Qja
, Qko
;
136 Lisp_Object QCuser_spec
;
138 /* Alist of font registry symbol and the corresponding charsets
139 information. The information is retrieved from
140 Vfont_encoding_alist on demand.
142 Eash element has the form:
143 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
147 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
148 encodes a character code to a glyph code of a font, and
149 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
150 character is supported by a font.
152 The latter form means that the information for REGISTRY couldn't be
154 static Lisp_Object font_charset_alist
;
156 /* List of all font drivers. Each font-backend (XXXfont.c) calls
157 register_font_driver in syms_of_XXXfont to register its font-driver
159 static struct font_driver_list
*font_driver_list
;
163 /* Creaters of font-related Lisp object. */
166 font_make_spec (void)
168 Lisp_Object font_spec
;
169 struct font_spec
*spec
170 = ((struct font_spec
*)
171 allocate_pseudovector (VECSIZE (struct font_spec
),
172 FONT_SPEC_MAX
, PVEC_FONT
));
173 XSETFONT (font_spec
, spec
);
178 font_make_entity (void)
180 Lisp_Object font_entity
;
181 struct font_entity
*entity
182 = ((struct font_entity
*)
183 allocate_pseudovector (VECSIZE (struct font_entity
),
184 FONT_ENTITY_MAX
, PVEC_FONT
));
185 XSETFONT (font_entity
, entity
);
189 /* Create a font-object whose structure size is SIZE. If ENTITY is
190 not nil, copy properties from ENTITY to the font-object. If
191 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
193 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
195 Lisp_Object font_object
;
197 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
200 XSETFONT (font_object
, font
);
204 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
205 font
->props
[i
] = AREF (entity
, i
);
206 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
207 font
->props
[FONT_EXTRA_INDEX
]
208 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
211 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
217 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
218 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
219 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
221 static unsigned font_encode_char (Lisp_Object
, int);
223 /* Number of registered font drivers. */
224 static int num_font_drivers
;
227 /* Return a Lispy value of a font property value at STR and LEN bytes.
228 If STR is "*", it returns nil.
229 If FORCE_SYMBOL is zero and all characters in STR are digits, it
230 returns an integer. Otherwise, it returns a symbol interned from
234 font_intern_prop (const char *str
, int len
, int force_symbol
)
239 EMACS_INT nbytes
, nchars
;
241 if (len
== 1 && *str
== '*')
243 if (!force_symbol
&& len
>=1 && isdigit (*str
))
245 for (i
= 1; i
< len
; i
++)
246 if (! isdigit (str
[i
]))
249 return make_number (atoi (str
));
252 /* The following code is copied from the function intern (in
253 lread.c), and modified to suite our purpose. */
255 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
256 obarray
= check_obarray (obarray
);
257 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
258 if (len
== nchars
|| len
!= nbytes
)
259 /* CONTENTS contains no multibyte sequences or contains an invalid
260 multibyte sequence. We'll make a unibyte string. */
261 tem
= oblookup (obarray
, str
, len
, len
);
263 tem
= oblookup (obarray
, str
, nchars
, len
);
266 if (len
== nchars
|| len
!= nbytes
)
267 tem
= make_unibyte_string (str
, len
);
269 tem
= make_multibyte_string (str
, nchars
, len
);
270 return Fintern (tem
, obarray
);
273 /* Return a pixel size of font-spec SPEC on frame F. */
276 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
278 #ifdef HAVE_WINDOW_SYSTEM
279 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
288 font_assert (FLOATP (size
));
289 point_size
= XFLOAT_DATA (size
);
290 val
= AREF (spec
, FONT_DPI_INDEX
);
295 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
303 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
304 font vector. If VAL is not valid (i.e. not registered in
305 font_style_table), return -1 if NOERROR is zero, and return a
306 proper index if NOERROR is nonzero. In that case, register VAL in
307 font_style_table if VAL is a symbol, and return a closest index if
308 VAL is an integer. */
311 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
313 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
314 int len
= ASIZE (table
);
320 Lisp_Object args
[2], elt
;
322 /* At first try exact match. */
323 for (i
= 0; i
< len
; i
++)
324 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
325 if (EQ (val
, AREF (AREF (table
, i
), j
)))
326 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
327 | (i
<< 4) | (j
- 1));
328 /* Try also with case-folding match. */
329 s
= SDATA (SYMBOL_NAME (val
));
330 for (i
= 0; i
< len
; i
++)
331 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
333 elt
= AREF (AREF (table
, i
), j
);
334 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
335 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
336 | (i
<< 4) | (j
- 1));
342 elt
= Fmake_vector (make_number (2), make_number (100));
345 args
[1] = Fmake_vector (make_number (1), elt
);
346 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
347 return (100 << 8) | (i
<< 4);
352 int numeric
= XINT (val
);
354 for (i
= 0, last_n
= -1; i
< len
; i
++)
356 int n
= XINT (AREF (AREF (table
, i
), 0));
359 return (n
<< 8) | (i
<< 4);
364 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
365 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
371 return ((last_n
<< 8) | ((i
- 1) << 4));
376 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
378 Lisp_Object val
= AREF (font
, prop
);
379 Lisp_Object table
, elt
;
384 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
385 i
= XINT (val
) & 0xFF;
386 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
387 elt
= AREF (table
, ((i
>> 4) & 0xF));
388 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
389 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
392 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
393 FONTNAME. ENCODING is a charset symbol that specifies the encoding
394 of the font. REPERTORY is a charset symbol or nil. */
397 find_font_encoding (Lisp_Object fontname
)
399 Lisp_Object tail
, elt
;
401 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
405 && STRINGP (XCAR (elt
))
406 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
407 && (SYMBOLP (XCDR (elt
))
408 ? CHARSETP (XCDR (elt
))
409 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
415 /* Return encoding charset and repertory charset for REGISTRY in
416 ENCODING and REPERTORY correspondingly. If correct information for
417 REGISTRY is available, return 0. Otherwise return -1. */
420 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
423 int encoding_id
, repertory_id
;
425 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
431 encoding_id
= XINT (XCAR (val
));
432 repertory_id
= XINT (XCDR (val
));
436 val
= find_font_encoding (SYMBOL_NAME (registry
));
437 if (SYMBOLP (val
) && CHARSETP (val
))
439 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
441 else if (CONSP (val
))
443 if (! CHARSETP (XCAR (val
)))
445 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
446 if (NILP (XCDR (val
)))
450 if (! CHARSETP (XCDR (val
)))
452 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
457 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
459 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
463 *encoding
= CHARSET_FROM_ID (encoding_id
);
465 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
470 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
475 /* Font property value validaters. See the comment of
476 font_property_table for the meaning of the arguments. */
478 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
479 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
480 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
481 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
482 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
483 static int get_font_prop_index (Lisp_Object
);
486 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
489 val
= Fintern (val
, Qnil
);
492 else if (EQ (prop
, QCregistry
))
493 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
499 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
501 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
502 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
509 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
513 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
515 if ((n
& 0xF) + 1 >= ASIZE (elt
))
517 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
521 else if (SYMBOLP (val
))
523 int n
= font_style_to_value (prop
, val
, 0);
525 val
= n
>= 0 ? make_number (n
) : Qerror
;
533 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
535 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
540 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
542 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
544 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
546 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
548 if (spacing
== 'c' || spacing
== 'C')
549 return make_number (FONT_SPACING_CHARCELL
);
550 if (spacing
== 'm' || spacing
== 'M')
551 return make_number (FONT_SPACING_MONO
);
552 if (spacing
== 'p' || spacing
== 'P')
553 return make_number (FONT_SPACING_PROPORTIONAL
);
554 if (spacing
== 'd' || spacing
== 'D')
555 return make_number (FONT_SPACING_DUAL
);
561 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
563 Lisp_Object tail
, tmp
;
566 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
567 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
568 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
571 if (! SYMBOLP (XCAR (val
)))
576 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
578 for (i
= 0; i
< 2; i
++)
585 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
586 if (! SYMBOLP (XCAR (tmp
)))
594 /* Structure of known font property keys and validater of the
598 /* Pointer to the key symbol. */
600 /* Function to validate PROP's value VAL, or NULL if any value is
601 ok. The value is VAL or its regularized value if VAL is valid,
602 and Qerror if not. */
603 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
604 } font_property_table
[] =
605 { { &QCtype
, font_prop_validate_symbol
},
606 { &QCfoundry
, font_prop_validate_symbol
},
607 { &QCfamily
, font_prop_validate_symbol
},
608 { &QCadstyle
, font_prop_validate_symbol
},
609 { &QCregistry
, font_prop_validate_symbol
},
610 { &QCweight
, font_prop_validate_style
},
611 { &QCslant
, font_prop_validate_style
},
612 { &QCwidth
, font_prop_validate_style
},
613 { &QCsize
, font_prop_validate_non_neg
},
614 { &QCdpi
, font_prop_validate_non_neg
},
615 { &QCspacing
, font_prop_validate_spacing
},
616 { &QCavgwidth
, font_prop_validate_non_neg
},
617 /* The order of the above entries must match with enum
618 font_property_index. */
619 { &QClang
, font_prop_validate_symbol
},
620 { &QCscript
, font_prop_validate_symbol
},
621 { &QCotf
, font_prop_validate_otf
}
624 /* Size (number of elements) of the above table. */
625 #define FONT_PROPERTY_TABLE_SIZE \
626 ((sizeof font_property_table) / (sizeof *font_property_table))
628 /* Return an index number of font property KEY or -1 if KEY is not an
629 already known property. */
632 get_font_prop_index (Lisp_Object key
)
636 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
637 if (EQ (key
, *font_property_table
[i
].key
))
642 /* Validate the font property. The property key is specified by the
643 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
644 signal an error. The value is VAL or the regularized one. */
647 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
649 Lisp_Object validated
;
654 prop
= *font_property_table
[idx
].key
;
657 idx
= get_font_prop_index (prop
);
661 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
662 if (EQ (validated
, Qerror
))
663 signal_error ("invalid font property", Fcons (prop
, val
));
668 /* Store VAL as a value of extra font property PROP in FONT while
669 keeping the sorting order. Don't check the validity of VAL. */
672 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
674 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
675 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
679 Lisp_Object prev
= Qnil
;
682 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
683 prev
= extra
, extra
= XCDR (extra
);
686 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
688 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
694 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
699 /* Font name parser and unparser */
701 static int parse_matrix (const char *);
702 static int font_expand_wildcards (Lisp_Object
*, int);
703 static int font_parse_name (char *, Lisp_Object
);
705 /* An enumerator for each field of an XLFD font name. */
706 enum xlfd_field_index
725 /* An enumerator for mask bit corresponding to each XLFD field. */
728 XLFD_FOUNDRY_MASK
= 0x0001,
729 XLFD_FAMILY_MASK
= 0x0002,
730 XLFD_WEIGHT_MASK
= 0x0004,
731 XLFD_SLANT_MASK
= 0x0008,
732 XLFD_SWIDTH_MASK
= 0x0010,
733 XLFD_ADSTYLE_MASK
= 0x0020,
734 XLFD_PIXEL_MASK
= 0x0040,
735 XLFD_POINT_MASK
= 0x0080,
736 XLFD_RESX_MASK
= 0x0100,
737 XLFD_RESY_MASK
= 0x0200,
738 XLFD_SPACING_MASK
= 0x0400,
739 XLFD_AVGWIDTH_MASK
= 0x0800,
740 XLFD_REGISTRY_MASK
= 0x1000,
741 XLFD_ENCODING_MASK
= 0x2000
745 /* Parse P pointing the pixel/point size field of the form
746 `[A B C D]' which specifies a transformation matrix:
752 by which all glyphs of the font are transformed. The spec says
753 that scalar value N for the pixel/point size is equivalent to:
754 A = N * resx/resy, B = C = 0, D = N.
756 Return the scalar value N if the form is valid. Otherwise return
760 parse_matrix (const char *p
)
766 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
769 matrix
[i
] = - strtod (p
+ 1, &end
);
771 matrix
[i
] = strtod (p
, &end
);
774 return (i
== 4 ? (int) matrix
[3] : -1);
777 /* Expand a wildcard field in FIELD (the first N fields are filled) to
778 multiple fields to fill in all 14 XLFD fields while restring a
779 field position by its contents. */
782 font_expand_wildcards (Lisp_Object
*field
, int n
)
785 Lisp_Object tmp
[XLFD_LAST_INDEX
];
786 /* Array of information about where this element can go. Nth
787 element is for Nth element of FIELD. */
789 /* Minimum possible field. */
791 /* Maxinum possible field. */
793 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
795 } range
[XLFD_LAST_INDEX
];
797 int range_from
, range_to
;
800 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
801 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
802 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
803 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
804 | XLFD_AVGWIDTH_MASK)
805 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
807 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
808 field. The value is shifted to left one bit by one in the
810 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
811 range_mask
= (range_mask
<< 1) | 1;
813 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
814 position-based retriction for FIELD[I]. */
815 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
816 i
++, range_from
++, range_to
++, range_mask
<<= 1)
818 Lisp_Object val
= field
[i
];
824 range
[i
].from
= range_from
;
825 range
[i
].to
= range_to
;
826 range
[i
].mask
= range_mask
;
830 /* The triplet FROM, TO, and MASK is a value-based
831 retriction for FIELD[I]. */
837 int numeric
= XINT (val
);
840 from
= to
= XLFD_ENCODING_INDEX
,
841 mask
= XLFD_ENCODING_MASK
;
842 else if (numeric
== 0)
843 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
844 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
845 else if (numeric
<= 48)
846 from
= to
= XLFD_PIXEL_INDEX
,
847 mask
= XLFD_PIXEL_MASK
;
849 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
850 mask
= XLFD_LARGENUM_MASK
;
852 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
853 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
854 mask
= XLFD_NULL_MASK
;
856 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
859 Lisp_Object name
= SYMBOL_NAME (val
);
861 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
862 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
863 mask
= XLFD_REGENC_MASK
;
865 from
= to
= XLFD_ENCODING_INDEX
,
866 mask
= XLFD_ENCODING_MASK
;
868 else if (range_from
<= XLFD_WEIGHT_INDEX
869 && range_to
>= XLFD_WEIGHT_INDEX
870 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
871 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
872 else if (range_from
<= XLFD_SLANT_INDEX
873 && range_to
>= XLFD_SLANT_INDEX
874 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
875 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
876 else if (range_from
<= XLFD_SWIDTH_INDEX
877 && range_to
>= XLFD_SWIDTH_INDEX
878 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
879 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
882 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
883 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
885 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
886 mask
= XLFD_SYMBOL_MASK
;
889 /* Merge position-based and value-based restrictions. */
891 while (from
< range_from
)
892 mask
&= ~(1 << from
++);
893 while (from
< 14 && ! (mask
& (1 << from
)))
895 while (to
> range_to
)
896 mask
&= ~(1 << to
--);
897 while (to
>= 0 && ! (mask
& (1 << to
)))
901 range
[i
].from
= from
;
903 range
[i
].mask
= mask
;
905 if (from
> range_from
|| to
< range_to
)
907 /* The range is narrowed by value-based restrictions.
908 Reflect it to the other fields. */
910 /* Following fields should be after FROM. */
912 /* Preceding fields should be before TO. */
913 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
915 /* Check FROM for non-wildcard field. */
916 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
918 while (range
[j
].from
< from
)
919 range
[j
].mask
&= ~(1 << range
[j
].from
++);
920 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
922 range
[j
].from
= from
;
925 from
= range
[j
].from
;
926 if (range
[j
].to
> to
)
928 while (range
[j
].to
> to
)
929 range
[j
].mask
&= ~(1 << range
[j
].to
--);
930 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
943 /* Decide all fileds from restrictions in RANGE. */
944 for (i
= j
= 0; i
< n
; i
++)
946 if (j
< range
[i
].from
)
948 if (i
== 0 || ! NILP (tmp
[i
- 1]))
949 /* None of TMP[X] corresponds to Jth field. */
951 for (; j
< range
[i
].from
; j
++)
956 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
958 for (; j
< XLFD_LAST_INDEX
; j
++)
960 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
961 field
[XLFD_ENCODING_INDEX
]
962 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
967 /* Parse NAME (null terminated) as XLFD and store information in FONT
968 (font-spec or font-entity). Size property of FONT is set as
970 specified XLFD fields FONT property
971 --------------------- -------------
972 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
973 POINT_SIZE and RESY calculated pixel size (Lisp integer)
974 POINT_SIZE POINT_SIZE/10 (Lisp float)
976 If NAME is successfully parsed, return 0. Otherwise return -1.
978 FONT is usually a font-spec, but when this function is called from
979 X font backend driver, it is a font-entity. In that case, NAME is
980 a fully specified XLFD. */
983 font_parse_xlfd (char *name
, Lisp_Object font
)
985 int len
= strlen (name
);
987 char *f
[XLFD_LAST_INDEX
+ 1];
991 if (len
> 255 || !len
)
992 /* Maximum XLFD name length is 255. */
994 /* Accept "*-.." as a fully specified XLFD. */
995 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
996 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
999 for (p
= name
+ i
; *p
; p
++)
1003 if (i
== XLFD_LAST_INDEX
)
1008 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1009 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1011 if (i
== XLFD_LAST_INDEX
)
1013 /* Fully specified XLFD. */
1016 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1017 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1018 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1019 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1021 val
= INTERN_FIELD_SYM (i
);
1024 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1026 ASET (font
, j
, make_number (n
));
1029 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1030 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1031 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1033 ASET (font
, FONT_REGISTRY_INDEX
,
1034 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1035 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1037 p
= f
[XLFD_PIXEL_INDEX
];
1038 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1039 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1042 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1044 ASET (font
, FONT_SIZE_INDEX
, val
);
1045 else if (FONT_ENTITY_P (font
))
1049 double point_size
= -1;
1051 font_assert (FONT_SPEC_P (font
));
1052 p
= f
[XLFD_POINT_INDEX
];
1054 point_size
= parse_matrix (p
);
1055 else if (isdigit (*p
))
1056 point_size
= atoi (p
), point_size
/= 10;
1057 if (point_size
>= 0)
1058 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1062 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1063 if (! NILP (val
) && ! INTEGERP (val
))
1065 ASET (font
, FONT_DPI_INDEX
, val
);
1066 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1069 val
= font_prop_validate_spacing (QCspacing
, val
);
1070 if (! INTEGERP (val
))
1072 ASET (font
, FONT_SPACING_INDEX
, val
);
1074 p
= f
[XLFD_AVGWIDTH_INDEX
];
1077 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1078 if (! NILP (val
) && ! INTEGERP (val
))
1080 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1084 int wild_card_found
= 0;
1085 Lisp_Object prop
[XLFD_LAST_INDEX
];
1087 if (FONT_ENTITY_P (font
))
1089 for (j
= 0; j
< i
; j
++)
1093 if (f
[j
][1] && f
[j
][1] != '-')
1096 wild_card_found
= 1;
1099 prop
[j
] = INTERN_FIELD (j
);
1101 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1103 if (! wild_card_found
)
1105 if (font_expand_wildcards (prop
, i
) < 0)
1108 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1109 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1110 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1111 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1112 if (! NILP (prop
[i
]))
1114 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1116 ASET (font
, j
, make_number (n
));
1118 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1119 val
= prop
[XLFD_REGISTRY_INDEX
];
1122 val
= prop
[XLFD_ENCODING_INDEX
];
1124 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1126 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1127 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1129 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1130 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1132 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1134 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1135 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1136 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1138 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1140 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1143 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1144 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1145 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1147 val
= font_prop_validate_spacing (QCspacing
,
1148 prop
[XLFD_SPACING_INDEX
]);
1149 if (! INTEGERP (val
))
1151 ASET (font
, FONT_SPACING_INDEX
, val
);
1153 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1154 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1160 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1161 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1162 0, use PIXEL_SIZE instead. */
1165 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1167 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1171 font_assert (FONTP (font
));
1173 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1176 if (i
== FONT_ADSTYLE_INDEX
)
1177 j
= XLFD_ADSTYLE_INDEX
;
1178 else if (i
== FONT_REGISTRY_INDEX
)
1179 j
= XLFD_REGISTRY_INDEX
;
1180 val
= AREF (font
, i
);
1183 if (j
== XLFD_REGISTRY_INDEX
)
1184 f
[j
] = "*-*", len
+= 4;
1186 f
[j
] = "*", len
+= 2;
1191 val
= SYMBOL_NAME (val
);
1192 if (j
== XLFD_REGISTRY_INDEX
1193 && ! strchr ((char *) SDATA (val
), '-'))
1195 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1196 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1198 f
[j
] = alloca (SBYTES (val
) + 3);
1199 sprintf (f
[j
], "%s-*", SDATA (val
));
1200 len
+= SBYTES (val
) + 3;
1204 f
[j
] = alloca (SBYTES (val
) + 4);
1205 sprintf (f
[j
], "%s*-*", SDATA (val
));
1206 len
+= SBYTES (val
) + 4;
1210 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1214 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1217 val
= font_style_symbolic (font
, i
, 0);
1219 f
[j
] = "*", len
+= 2;
1222 val
= SYMBOL_NAME (val
);
1223 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1227 val
= AREF (font
, FONT_SIZE_INDEX
);
1228 font_assert (NUMBERP (val
) || NILP (val
));
1236 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1237 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1240 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1242 else if (FLOATP (val
))
1244 i
= XFLOAT_DATA (val
) * 10;
1245 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1246 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1249 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1251 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1253 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1254 f
[XLFD_RESX_INDEX
] = alloca (22);
1255 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1259 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1260 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1262 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1264 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1265 : spacing
<= FONT_SPACING_DUAL
? "d"
1266 : spacing
<= FONT_SPACING_MONO
? "m"
1271 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1272 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1274 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1275 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1276 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1279 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1280 len
++; /* for terminating '\0'. */
1283 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1284 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1285 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1286 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1287 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1288 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1289 f
[XLFD_REGISTRY_INDEX
]);
1292 /* Parse NAME (null terminated) and store information in FONT
1293 (font-spec or font-entity). NAME is supplied in either the
1294 Fontconfig or GTK font name format. If NAME is successfully
1295 parsed, return 0. Otherwise return -1.
1297 The fontconfig format is
1299 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1303 FAMILY [PROPS...] [SIZE]
1305 This function tries to guess which format it is. */
1308 font_parse_fcname (char *name
, Lisp_Object font
)
1311 char *size_beg
= NULL
, *size_end
= NULL
;
1312 char *props_beg
= NULL
, *family_end
= NULL
;
1313 int len
= strlen (name
);
1318 for (p
= name
; *p
; p
++)
1320 if (*p
== '\\' && p
[1])
1324 props_beg
= family_end
= p
;
1329 int decimal
= 0, size_found
= 1;
1330 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1333 if (*q
!= '.' || decimal
)
1352 Lisp_Object extra_props
= Qnil
;
1354 /* A fontconfig name with size and/or property data. */
1355 if (family_end
> name
)
1358 family
= font_intern_prop (name
, family_end
- name
, 1);
1359 ASET (font
, FONT_FAMILY_INDEX
, family
);
1363 double point_size
= strtod (size_beg
, &size_end
);
1364 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1365 if (*size_end
== ':' && size_end
[1])
1366 props_beg
= size_end
;
1370 /* Now parse ":KEY=VAL" patterns. */
1373 for (p
= props_beg
; *p
; p
= q
)
1375 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1378 /* Must be an enumerated value. */
1382 val
= font_intern_prop (p
, q
- p
, 1);
1384 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1386 if (PROP_MATCH ("light", 5)
1387 || PROP_MATCH ("medium", 6)
1388 || PROP_MATCH ("demibold", 8)
1389 || PROP_MATCH ("bold", 4)
1390 || PROP_MATCH ("black", 5))
1391 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1392 else if (PROP_MATCH ("roman", 5)
1393 || PROP_MATCH ("italic", 6)
1394 || PROP_MATCH ("oblique", 7))
1395 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1396 else if (PROP_MATCH ("charcell", 8))
1397 ASET (font
, FONT_SPACING_INDEX
,
1398 make_number (FONT_SPACING_CHARCELL
));
1399 else if (PROP_MATCH ("mono", 4))
1400 ASET (font
, FONT_SPACING_INDEX
,
1401 make_number (FONT_SPACING_MONO
));
1402 else if (PROP_MATCH ("proportional", 12))
1403 ASET (font
, FONT_SPACING_INDEX
,
1404 make_number (FONT_SPACING_PROPORTIONAL
));
1413 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1414 prop
= FONT_SIZE_INDEX
;
1417 key
= font_intern_prop (p
, q
- p
, 1);
1418 prop
= get_font_prop_index (key
);
1422 for (q
= p
; *q
&& *q
!= ':'; q
++);
1423 val
= font_intern_prop (p
, q
- p
, 0);
1425 if (prop
>= FONT_FOUNDRY_INDEX
1426 && prop
< FONT_EXTRA_INDEX
)
1427 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1430 extra_props
= nconc2 (extra_props
,
1431 Fcons (Fcons (key
, val
), Qnil
));
1438 if (! NILP (extra_props
))
1440 struct font_driver_list
*driver_list
= font_driver_list
;
1441 for ( ; driver_list
; driver_list
= driver_list
->next
)
1442 if (driver_list
->driver
->filter_properties
)
1443 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1449 /* Either a fontconfig-style name with no size and property
1450 data, or a GTK-style name. */
1452 int word_len
, prop_found
= 0;
1454 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1460 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1461 if (! isdigit (*q
) && *q
!= '.')
1468 double point_size
= strtod (p
, &q
);
1469 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1474 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1475 if (*q
== '\\' && q
[1])
1479 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1481 if (PROP_MATCH ("Ultra-Light", 11))
1484 prop
= font_intern_prop ("ultra-light", 11, 1);
1485 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1487 else if (PROP_MATCH ("Light", 5))
1490 prop
= font_intern_prop ("light", 5, 1);
1491 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1493 else if (PROP_MATCH ("Book", 4))
1496 prop
= font_intern_prop ("book", 4, 1);
1497 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1499 else if (PROP_MATCH ("Medium", 6))
1502 prop
= font_intern_prop ("medium", 6, 1);
1503 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1505 else if (PROP_MATCH ("Semi-Bold", 9))
1508 prop
= font_intern_prop ("semi-bold", 9, 1);
1509 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1511 else if (PROP_MATCH ("Bold", 4))
1514 prop
= font_intern_prop ("bold", 4, 1);
1515 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1517 else if (PROP_MATCH ("Italic", 6))
1520 prop
= font_intern_prop ("italic", 4, 1);
1521 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1523 else if (PROP_MATCH ("Oblique", 7))
1526 prop
= font_intern_prop ("oblique", 7, 1);
1527 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1529 else if (PROP_MATCH ("Semi-Condensed", 14))
1532 prop
= font_intern_prop ("semi-condensed", 14, 1);
1533 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1535 else if (PROP_MATCH ("Condensed", 9))
1538 prop
= font_intern_prop ("condensed", 9, 1);
1539 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1543 return -1; /* Unknown property in GTK-style font name. */
1552 family
= font_intern_prop (name
, family_end
- name
, 1);
1553 ASET (font
, FONT_FAMILY_INDEX
, family
);
1560 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1561 NAME (NBYTES length), and return the name length. If
1562 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1565 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1567 Lisp_Object family
, foundry
;
1568 Lisp_Object tail
, val
;
1572 Lisp_Object styles
[3];
1573 const char *style_names
[3] = { "weight", "slant", "width" };
1576 family
= AREF (font
, FONT_FAMILY_INDEX
);
1577 if (! NILP (family
))
1579 if (SYMBOLP (family
))
1581 family
= SYMBOL_NAME (family
);
1582 len
+= SBYTES (family
);
1588 val
= AREF (font
, FONT_SIZE_INDEX
);
1591 if (XINT (val
) != 0)
1592 pixel_size
= XINT (val
);
1594 len
+= 21; /* for ":pixelsize=NUM" */
1596 else if (FLOATP (val
))
1599 point_size
= (int) XFLOAT_DATA (val
);
1600 len
+= 11; /* for "-NUM" */
1603 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1604 if (! NILP (foundry
))
1606 if (SYMBOLP (foundry
))
1608 foundry
= SYMBOL_NAME (foundry
);
1609 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1615 for (i
= 0; i
< 3; i
++)
1617 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1618 if (! NILP (styles
[i
]))
1619 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1620 SDATA (SYMBOL_NAME (styles
[i
])));
1623 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1624 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1625 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1626 len
+= strlen (":spacing=100");
1627 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1628 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1629 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1631 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1633 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1635 len
+= SBYTES (val
);
1636 else if (INTEGERP (val
))
1637 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1638 else if (SYMBOLP (val
))
1639 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1645 if (! NILP (family
))
1646 p
+= sprintf (p
, "%s", SDATA (family
));
1650 p
+= sprintf (p
, "%d", point_size
);
1652 p
+= sprintf (p
, "-%d", point_size
);
1654 else if (pixel_size
> 0)
1655 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1656 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1657 p
+= sprintf (p
, ":foundry=%s",
1658 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1659 for (i
= 0; i
< 3; i
++)
1660 if (! NILP (styles
[i
]))
1661 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1662 SDATA (SYMBOL_NAME (styles
[i
])));
1663 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1664 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1665 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1666 p
+= sprintf (p
, ":spacing=%ld",
1667 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1668 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1670 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1671 p
+= sprintf (p
, ":scalable=true");
1673 p
+= sprintf (p
, ":scalable=false");
1678 /* Parse NAME (null terminated) and store information in FONT
1679 (font-spec or font-entity). If NAME is successfully parsed, return
1680 0. Otherwise return -1. */
1683 font_parse_name (char *name
, Lisp_Object font
)
1685 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1686 return font_parse_xlfd (name
, font
);
1687 return font_parse_fcname (name
, font
);
1691 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1692 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1696 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1702 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1704 CHECK_STRING (family
);
1705 len
= SBYTES (family
);
1706 p0
= (char *) SDATA (family
);
1707 p1
= strchr (p0
, '-');
1710 if ((*p0
!= '*' && p1
- p0
> 0)
1711 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1712 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1715 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1718 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1720 if (! NILP (registry
))
1722 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1723 CHECK_STRING (registry
);
1724 len
= SBYTES (registry
);
1725 p0
= (char *) SDATA (registry
);
1726 p1
= strchr (p0
, '-');
1729 if (SDATA (registry
)[len
- 1] == '*')
1730 registry
= concat2 (registry
, build_string ("-*"));
1732 registry
= concat2 (registry
, build_string ("*-*"));
1734 registry
= Fdowncase (registry
);
1735 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1740 /* This part (through the next ^L) is still experimental and not
1741 tested much. We may drastically change codes. */
1747 #define LGSTRING_HEADER_SIZE 6
1748 #define LGSTRING_GLYPH_SIZE 8
1751 check_gstring (gstring
)
1752 Lisp_Object gstring
;
1757 CHECK_VECTOR (gstring
);
1758 val
= AREF (gstring
, 0);
1760 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1762 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1763 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1764 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1765 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1766 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1767 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1768 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1769 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1770 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1771 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1772 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1774 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1776 val
= LGSTRING_GLYPH (gstring
, i
);
1778 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1780 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1782 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1783 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1784 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1785 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1786 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1787 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1788 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1789 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1791 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1793 if (ASIZE (val
) < 3)
1795 for (j
= 0; j
< 3; j
++)
1796 CHECK_NUMBER (AREF (val
, j
));
1801 error ("Invalid glyph-string format");
1806 check_otf_features (otf_features
)
1807 Lisp_Object otf_features
;
1811 CHECK_CONS (otf_features
);
1812 CHECK_SYMBOL (XCAR (otf_features
));
1813 otf_features
= XCDR (otf_features
);
1814 CHECK_CONS (otf_features
);
1815 CHECK_SYMBOL (XCAR (otf_features
));
1816 otf_features
= XCDR (otf_features
);
1817 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1819 CHECK_SYMBOL (Fcar (val
));
1820 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1821 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1823 otf_features
= XCDR (otf_features
);
1824 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1826 CHECK_SYMBOL (Fcar (val
));
1827 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1828 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1835 Lisp_Object otf_list
;
1838 otf_tag_symbol (tag
)
1843 OTF_tag_name (tag
, name
);
1844 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1851 Lisp_Object val
= Fassoc (file
, otf_list
);
1855 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1858 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1859 val
= make_save_value (otf
, 0);
1860 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1866 /* Return a list describing which scripts/languages FONT supports by
1867 which GSUB/GPOS features of OpenType tables. See the comment of
1868 (struct font_driver).otf_capability. */
1871 font_otf_capability (font
)
1875 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1878 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1881 for (i
= 0; i
< 2; i
++)
1883 OTF_GSUB_GPOS
*gsub_gpos
;
1884 Lisp_Object script_list
= Qnil
;
1887 if (OTF_get_features (otf
, i
== 0) < 0)
1889 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1890 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1892 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1893 Lisp_Object langsys_list
= Qnil
;
1894 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1897 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1899 OTF_LangSys
*langsys
;
1900 Lisp_Object feature_list
= Qnil
;
1901 Lisp_Object langsys_tag
;
1904 if (k
== script
->LangSysCount
)
1906 langsys
= &script
->DefaultLangSys
;
1911 langsys
= script
->LangSys
+ k
;
1913 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1915 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1917 OTF_Feature
*feature
1918 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1919 Lisp_Object feature_tag
1920 = otf_tag_symbol (feature
->FeatureTag
);
1922 feature_list
= Fcons (feature_tag
, feature_list
);
1924 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1927 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1932 XSETCAR (capability
, script_list
);
1934 XSETCDR (capability
, script_list
);
1940 /* Parse OTF features in SPEC and write a proper features spec string
1941 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1942 assured that the sufficient memory has already allocated for
1946 generate_otf_features (spec
, features
)
1956 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1962 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1967 else if (! asterisk
)
1969 val
= SYMBOL_NAME (val
);
1970 p
+= sprintf (p
, "%s", SDATA (val
));
1974 val
= SYMBOL_NAME (val
);
1975 p
+= sprintf (p
, "~%s", SDATA (val
));
1979 error ("OTF spec too long");
1983 font_otf_DeviceTable (device_table
)
1984 OTF_DeviceTable
*device_table
;
1986 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1988 return Fcons (make_number (len
),
1989 make_unibyte_string (device_table
->DeltaValue
, len
));
1993 font_otf_ValueRecord (value_format
, value_record
)
1995 OTF_ValueRecord
*value_record
;
1997 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1999 if (value_format
& OTF_XPlacement
)
2000 ASET (val
, 0, make_number (value_record
->XPlacement
));
2001 if (value_format
& OTF_YPlacement
)
2002 ASET (val
, 1, make_number (value_record
->YPlacement
));
2003 if (value_format
& OTF_XAdvance
)
2004 ASET (val
, 2, make_number (value_record
->XAdvance
));
2005 if (value_format
& OTF_YAdvance
)
2006 ASET (val
, 3, make_number (value_record
->YAdvance
));
2007 if (value_format
& OTF_XPlaDevice
)
2008 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2009 if (value_format
& OTF_YPlaDevice
)
2010 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2011 if (value_format
& OTF_XAdvDevice
)
2012 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2013 if (value_format
& OTF_YAdvDevice
)
2014 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2019 font_otf_Anchor (anchor
)
2024 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2025 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2026 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2027 if (anchor
->AnchorFormat
== 2)
2028 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2031 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2032 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2036 #endif /* HAVE_LIBOTF */
2042 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2043 static int font_compare (const void *, const void *);
2044 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2048 font_rescale_ratio (Lisp_Object font_entity
)
2050 Lisp_Object tail
, elt
;
2051 Lisp_Object name
= Qnil
;
2053 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2056 if (FLOATP (XCDR (elt
)))
2058 if (STRINGP (XCAR (elt
)))
2061 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2062 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2063 return XFLOAT_DATA (XCDR (elt
));
2065 else if (FONT_SPEC_P (XCAR (elt
)))
2067 if (font_match_p (XCAR (elt
), font_entity
))
2068 return XFLOAT_DATA (XCDR (elt
));
2075 /* We sort fonts by scoring each of them against a specified
2076 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2077 the value is, the closer the font is to the font-spec.
2079 The lowest 2 bits of the score is used for driver type. The font
2080 available by the most preferred font driver is 0.
2082 Each 7-bit in the higher 28 bits are used for numeric properties
2083 WEIGHT, SLANT, WIDTH, and SIZE. */
2085 /* How many bits to shift to store the difference value of each font
2086 property in a score. Note that flots for FONT_TYPE_INDEX and
2087 FONT_REGISTRY_INDEX are not used. */
2088 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2090 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2091 The return value indicates how different ENTITY is compared with
2095 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2100 /* Score three style numeric fields. Maximum difference is 127. */
2101 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2102 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2104 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2109 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2112 /* Score the size. Maximum difference is 127. */
2113 i
= FONT_SIZE_INDEX
;
2114 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2115 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2117 /* We use the higher 6-bit for the actual size difference. The
2118 lowest bit is set if the DPI is different. */
2120 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2122 if (CONSP (Vface_font_rescale_alist
))
2123 pixel_size
*= font_rescale_ratio (entity
);
2124 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2128 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2129 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2131 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2132 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2134 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2141 /* Concatenate all elements of LIST into one vector. LIST is a list
2142 of font-entity vectors. */
2145 font_vconcat_entity_vectors (Lisp_Object list
)
2147 int nargs
= XINT (Flength (list
));
2148 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2151 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2152 args
[i
] = XCAR (list
);
2153 return Fvconcat (nargs
, args
);
2157 /* The structure for elements being sorted by qsort. */
2158 struct font_sort_data
2161 int font_driver_preference
;
2166 /* The comparison function for qsort. */
2169 font_compare (const void *d1
, const void *d2
)
2171 const struct font_sort_data
*data1
= d1
;
2172 const struct font_sort_data
*data2
= d2
;
2174 if (data1
->score
< data2
->score
)
2176 else if (data1
->score
> data2
->score
)
2178 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2182 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2183 If PREFER specifies a point-size, calculate the corresponding
2184 pixel-size from QCdpi property of PREFER or from the Y-resolution
2185 of FRAME before sorting.
2187 If BEST-ONLY is nonzero, return the best matching entity (that
2188 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2189 if BEST-ONLY is negative). Otherwise, return the sorted result as
2190 a single vector of font-entities.
2192 This function does no optimization for the case that the total
2193 number of elements is 1. The caller should avoid calling this in
2197 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2199 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2201 struct font_sort_data
*data
;
2202 unsigned best_score
;
2203 Lisp_Object best_entity
;
2204 struct frame
*f
= XFRAME (frame
);
2205 Lisp_Object tail
, vec
;
2208 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2209 prefer_prop
[i
] = AREF (prefer
, i
);
2210 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2211 prefer_prop
[FONT_SIZE_INDEX
]
2212 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2214 if (NILP (XCDR (list
)))
2216 /* What we have to take care of is this single vector. */
2218 maxlen
= ASIZE (vec
);
2222 /* We don't have to perform sort, so there's no need of creating
2223 a single vector. But, we must find the length of the longest
2226 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2227 if (maxlen
< ASIZE (XCAR (tail
)))
2228 maxlen
= ASIZE (XCAR (tail
));
2232 /* We have to create a single vector to sort it. */
2233 vec
= font_vconcat_entity_vectors (list
);
2234 maxlen
= ASIZE (vec
);
2237 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2238 best_score
= 0xFFFFFFFF;
2241 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2243 int font_driver_preference
= 0;
2244 Lisp_Object current_font_driver
;
2250 /* We are sure that the length of VEC > 0. */
2251 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2252 /* Score the elements. */
2253 for (i
= 0; i
< len
; i
++)
2255 data
[i
].entity
= AREF (vec
, i
);
2257 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2259 ? font_score (data
[i
].entity
, prefer_prop
)
2261 if (best_only
&& best_score
> data
[i
].score
)
2263 best_score
= data
[i
].score
;
2264 best_entity
= data
[i
].entity
;
2265 if (best_score
== 0)
2268 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2270 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2271 font_driver_preference
++;
2273 data
[i
].font_driver_preference
= font_driver_preference
;
2276 /* Sort if necessary. */
2279 qsort (data
, len
, sizeof *data
, font_compare
);
2280 for (i
= 0; i
< len
; i
++)
2281 ASET (vec
, i
, data
[i
].entity
);
2290 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2295 /* API of Font Service Layer. */
2297 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2298 sort_shift_bits. Finternal_set_font_selection_order calls this
2299 function with font_sort_order after setting up it. */
2302 font_update_sort_order (int *order
)
2306 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2308 int xlfd_idx
= order
[i
];
2310 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2311 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2312 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2313 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2314 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2315 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2317 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2322 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2327 table
= assq_no_quit (script
, table
);
2330 table
= XCDR (table
);
2331 if (! NILP (langsys
))
2333 table
= assq_no_quit (langsys
, table
);
2339 val
= assq_no_quit (Qnil
, table
);
2341 table
= XCAR (table
);
2345 table
= XCDR (table
);
2346 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2348 if (NILP (XCAR (features
)))
2353 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2359 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2362 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2364 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2366 script
= XCAR (spec
);
2370 langsys
= XCAR (spec
);
2381 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2382 XCAR (otf_capability
)))
2384 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2385 XCDR (otf_capability
)))
2392 /* Check if FONT (font-entity or font-object) matches with the font
2393 specification SPEC. */
2396 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2398 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2399 Lisp_Object extra
, font_extra
;
2402 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2403 if (! NILP (AREF (spec
, i
))
2404 && ! NILP (AREF (font
, i
))
2405 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2407 props
= XFONT_SPEC (spec
)->props
;
2408 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2410 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2411 prop
[i
] = AREF (spec
, i
);
2412 prop
[FONT_SIZE_INDEX
]
2413 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2417 if (font_score (font
, props
) > 0)
2419 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2420 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2421 for (; CONSP (extra
); extra
= XCDR (extra
))
2423 Lisp_Object key
= XCAR (XCAR (extra
));
2424 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2426 if (EQ (key
, QClang
))
2428 val2
= assq_no_quit (key
, font_extra
);
2437 if (NILP (Fmemq (val
, val2
)))
2442 ? NILP (Fmemq (val
, XCDR (val2
)))
2446 else if (EQ (key
, QCscript
))
2448 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2454 /* All characters in the list must be supported. */
2455 for (; CONSP (val2
); val2
= XCDR (val2
))
2457 if (! NATNUMP (XCAR (val2
)))
2459 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2460 == FONT_INVALID_CODE
)
2464 else if (VECTORP (val2
))
2466 /* At most one character in the vector must be supported. */
2467 for (i
= 0; i
< ASIZE (val2
); i
++)
2469 if (! NATNUMP (AREF (val2
, i
)))
2471 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2472 != FONT_INVALID_CODE
)
2475 if (i
== ASIZE (val2
))
2480 else if (EQ (key
, QCotf
))
2484 if (! FONT_OBJECT_P (font
))
2486 fontp
= XFONT_OBJECT (font
);
2487 if (! fontp
->driver
->otf_capability
)
2489 val2
= fontp
->driver
->otf_capability (fontp
);
2490 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2501 Each font backend has the callback function get_cache, and it
2502 returns a cons cell of which cdr part can be freely used for
2503 caching fonts. The cons cell may be shared by multiple frames
2504 and/or multiple font drivers. So, we arrange the cdr part as this:
2506 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2508 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2509 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2510 cons (FONT-SPEC FONT-ENTITY ...). */
2512 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2513 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2514 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2515 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2516 struct font_driver
*);
2519 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2521 Lisp_Object cache
, val
;
2523 cache
= driver
->get_cache (f
);
2525 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2529 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2530 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2534 val
= XCDR (XCAR (val
));
2535 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2541 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2543 Lisp_Object cache
, val
, tmp
;
2546 cache
= driver
->get_cache (f
);
2548 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2549 cache
= val
, val
= XCDR (val
);
2550 font_assert (! NILP (val
));
2551 tmp
= XCDR (XCAR (val
));
2552 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2553 if (XINT (XCAR (tmp
)) == 0)
2555 font_clear_cache (f
, XCAR (val
), driver
);
2556 XSETCDR (cache
, XCDR (val
));
2562 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2564 Lisp_Object val
= driver
->get_cache (f
);
2565 Lisp_Object type
= driver
->type
;
2567 font_assert (CONSP (val
));
2568 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2569 font_assert (CONSP (val
));
2570 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2571 val
= XCDR (XCAR (val
));
2575 static int num_fonts
;
2578 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2580 Lisp_Object tail
, elt
;
2581 Lisp_Object tail2
, entity
;
2583 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2584 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2587 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2588 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2590 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2592 entity
= XCAR (tail2
);
2594 if (FONT_ENTITY_P (entity
)
2595 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2597 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2599 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2601 Lisp_Object val
= XCAR (objlist
);
2602 struct font
*font
= XFONT_OBJECT (val
);
2604 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2606 font_assert (font
&& driver
== font
->driver
);
2607 driver
->close (f
, font
);
2611 if (driver
->free_entity
)
2612 driver
->free_entity (entity
);
2617 XSETCDR (cache
, Qnil
);
2621 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2623 /* Check each font-entity in VEC, and return a list of font-entities
2624 that satisfy this condition:
2625 (1) matches with SPEC and SIZE if SPEC is not nil, and
2626 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2630 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2632 Lisp_Object entity
, val
;
2633 enum font_property_index prop
;
2636 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2638 entity
= AREF (vec
, i
);
2639 if (! NILP (Vface_ignored_fonts
))
2642 Lisp_Object tail
, regexp
;
2644 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2646 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2648 regexp
= XCAR (tail
);
2649 if (STRINGP (regexp
)
2650 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2659 val
= Fcons (entity
, val
);
2662 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2663 if (INTEGERP (AREF (spec
, prop
))
2664 && ((XINT (AREF (spec
, prop
)) >> 8)
2665 != (XINT (AREF (entity
, prop
)) >> 8)))
2666 prop
= FONT_SPEC_MAX
;
2667 if (prop
< FONT_SPEC_MAX
2669 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2671 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2674 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2675 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2676 prop
= FONT_SPEC_MAX
;
2678 if (prop
< FONT_SPEC_MAX
2679 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2680 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2681 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2682 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2683 prop
= FONT_SPEC_MAX
;
2684 if (prop
< FONT_SPEC_MAX
2685 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2686 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2687 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2688 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2689 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2690 prop
= FONT_SPEC_MAX
;
2691 if (prop
< FONT_SPEC_MAX
)
2692 val
= Fcons (entity
, val
);
2694 return (Fvconcat (1, &val
));
2698 /* Return a list of vectors of font-entities matching with SPEC on
2699 FRAME. Each elements in the list is a vector of entities from the
2700 same font-driver. */
2703 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2705 FRAME_PTR f
= XFRAME (frame
);
2706 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2707 Lisp_Object ftype
, val
;
2708 Lisp_Object list
= Qnil
;
2710 int need_filtering
= 0;
2713 font_assert (FONT_SPEC_P (spec
));
2715 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2716 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2717 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2718 size
= font_pixel_size (f
, spec
);
2722 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2723 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2724 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2725 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2727 ASET (scratch_font_spec
, i
, Qnil
);
2728 if (! NILP (AREF (spec
, i
)))
2730 if (i
== FONT_DPI_INDEX
)
2731 /* Skip FONT_SPACING_INDEX */
2734 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2735 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2737 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2739 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2741 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2743 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2744 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2751 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2755 val
= Fvconcat (1, &val
);
2756 copy
= Fcopy_font_spec (scratch_font_spec
);
2757 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2758 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2762 || ! NILP (Vface_ignored_fonts
)))
2763 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2764 if (ASIZE (val
) > 0)
2765 list
= Fcons (val
, list
);
2768 list
= Fnreverse (list
);
2769 FONT_ADD_LOG ("list", spec
, list
);
2774 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2775 nil, is an array of face's attributes, which specifies preferred
2776 font-related attributes. */
2779 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2781 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2782 Lisp_Object ftype
, size
, entity
;
2784 Lisp_Object work
= Fcopy_font_spec (spec
);
2786 XSETFRAME (frame
, f
);
2787 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2788 size
= AREF (spec
, FONT_SIZE_INDEX
);
2791 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2792 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2793 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2794 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2797 for (; driver_list
; driver_list
= driver_list
->next
)
2799 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2801 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2804 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2805 entity
= assoc_no_quit (work
, XCDR (cache
));
2807 entity
= XCDR (entity
);
2810 entity
= driver_list
->driver
->match (frame
, work
);
2811 copy
= Fcopy_font_spec (work
);
2812 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2813 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2815 if (! NILP (entity
))
2818 FONT_ADD_LOG ("match", work
, entity
);
2823 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2824 opened font object. */
2827 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2829 struct font_driver_list
*driver_list
;
2830 Lisp_Object objlist
, size
, val
, font_object
;
2832 int min_width
, height
;
2833 int scaled_pixel_size
;
2835 font_assert (FONT_ENTITY_P (entity
));
2836 size
= AREF (entity
, FONT_SIZE_INDEX
);
2837 if (XINT (size
) != 0)
2838 scaled_pixel_size
= pixel_size
= XINT (size
);
2839 else if (CONSP (Vface_font_rescale_alist
))
2840 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2842 val
= AREF (entity
, FONT_TYPE_INDEX
);
2843 for (driver_list
= f
->font_driver_list
;
2844 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2845 driver_list
= driver_list
->next
);
2849 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2850 objlist
= XCDR (objlist
))
2852 Lisp_Object fn
= XCAR (objlist
);
2853 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2854 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2856 if (driver_list
->driver
->cached_font_ok
== NULL
2857 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2862 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2863 if (!NILP (font_object
))
2864 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2865 FONT_ADD_LOG ("open", entity
, font_object
);
2866 if (NILP (font_object
))
2868 ASET (entity
, FONT_OBJLIST_INDEX
,
2869 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2872 font
= XFONT_OBJECT (font_object
);
2873 min_width
= (font
->min_width
? font
->min_width
2874 : font
->average_width
? font
->average_width
2875 : font
->space_width
? font
->space_width
2877 height
= (font
->height
? font
->height
: 1);
2878 #ifdef HAVE_WINDOW_SYSTEM
2879 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2880 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2882 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2883 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2884 fonts_changed_p
= 1;
2888 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2889 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2890 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2891 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2899 /* Close FONT_OBJECT that is opened on frame F. */
2902 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2904 struct font
*font
= XFONT_OBJECT (font_object
);
2906 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2907 /* Already closed. */
2909 FONT_ADD_LOG ("close", font_object
, Qnil
);
2910 font
->driver
->close (f
, font
);
2911 #ifdef HAVE_WINDOW_SYSTEM
2912 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2913 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2919 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2920 FONT is a font-entity and it must be opened to check. */
2923 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2927 if (FONT_ENTITY_P (font
))
2929 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2930 struct font_driver_list
*driver_list
;
2932 for (driver_list
= f
->font_driver_list
;
2933 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2934 driver_list
= driver_list
->next
);
2937 if (! driver_list
->driver
->has_char
)
2939 return driver_list
->driver
->has_char (font
, c
);
2942 font_assert (FONT_OBJECT_P (font
));
2943 fontp
= XFONT_OBJECT (font
);
2944 if (fontp
->driver
->has_char
)
2946 int result
= fontp
->driver
->has_char (font
, c
);
2951 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2955 /* Return the glyph ID of FONT_OBJECT for character C. */
2958 font_encode_char (Lisp_Object font_object
, int c
)
2962 font_assert (FONT_OBJECT_P (font_object
));
2963 font
= XFONT_OBJECT (font_object
);
2964 return font
->driver
->encode_char (font
, c
);
2968 /* Return the name of FONT_OBJECT. */
2971 font_get_name (Lisp_Object font_object
)
2973 font_assert (FONT_OBJECT_P (font_object
));
2974 return AREF (font_object
, FONT_NAME_INDEX
);
2978 /* Return the specification of FONT_OBJECT. */
2981 font_get_spec (Lisp_Object font_object
)
2983 Lisp_Object spec
= font_make_spec ();
2986 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2987 ASET (spec
, i
, AREF (font_object
, i
));
2988 ASET (spec
, FONT_SIZE_INDEX
,
2989 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2994 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2995 could not be parsed by font_parse_name, return Qnil. */
2998 font_spec_from_name (Lisp_Object font_name
)
3000 Lisp_Object spec
= Ffont_spec (0, NULL
);
3002 CHECK_STRING (font_name
);
3003 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3005 font_put_extra (spec
, QCname
, font_name
);
3006 font_put_extra (spec
, QCuser_spec
, font_name
);
3012 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3014 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3019 if (! NILP (Ffont_get (font
, QCname
)))
3021 font
= Fcopy_font_spec (font
);
3022 font_put_extra (font
, QCname
, Qnil
);
3025 if (NILP (AREF (font
, prop
))
3026 && prop
!= FONT_FAMILY_INDEX
3027 && prop
!= FONT_FOUNDRY_INDEX
3028 && prop
!= FONT_WIDTH_INDEX
3029 && prop
!= FONT_SIZE_INDEX
)
3031 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3032 font
= Fcopy_font_spec (font
);
3033 ASET (font
, prop
, Qnil
);
3034 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3036 if (prop
== FONT_FAMILY_INDEX
)
3038 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3039 /* If we are setting the font family, we must also clear
3040 FONT_WIDTH_INDEX to avoid rejecting families that lack
3041 support for some widths. */
3042 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3044 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3045 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3046 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3047 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3048 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3049 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3051 else if (prop
== FONT_SIZE_INDEX
)
3053 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3054 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3055 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3057 else if (prop
== FONT_WIDTH_INDEX
)
3058 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3059 attrs
[LFACE_FONT_INDEX
] = font
;
3062 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3063 supports C and matches best with ATTRS and PIXEL_SIZE. */
3066 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3068 Lisp_Object font_entity
;
3071 FRAME_PTR f
= XFRAME (frame
);
3073 if (NILP (XCDR (entities
))
3074 && ASIZE (XCAR (entities
)) == 1)
3076 font_entity
= AREF (XCAR (entities
), 0);
3078 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3083 /* Sort fonts by properties specified in ATTRS. */
3084 prefer
= scratch_font_prefer
;
3086 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3087 ASET (prefer
, i
, Qnil
);
3088 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3090 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3092 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3093 ASET (prefer
, i
, AREF (face_font
, i
));
3095 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3096 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3097 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3098 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3099 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3100 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3101 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3103 return font_sort_entities (entities
, prefer
, frame
, c
);
3106 /* Return a font-entity satisfying SPEC and best matching with face's
3107 font related attributes in ATTRS. C, if not negative, is a
3108 character that the entity must support. */
3111 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3114 Lisp_Object frame
, entities
, val
;
3115 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3119 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3120 if (NILP (registry
[0]))
3122 registry
[0] = DEFAULT_ENCODING
;
3123 registry
[1] = Qascii_0
;
3124 registry
[2] = null_vector
;
3127 registry
[1] = null_vector
;
3129 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3131 struct charset
*encoding
, *repertory
;
3133 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3134 &encoding
, &repertory
) < 0)
3137 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3139 else if (c
> encoding
->max_char
)
3143 work
= Fcopy_font_spec (spec
);
3144 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3145 XSETFRAME (frame
, f
);
3146 size
= AREF (spec
, FONT_SIZE_INDEX
);
3147 pixel_size
= font_pixel_size (f
, spec
);
3148 if (pixel_size
== 0)
3150 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3152 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3154 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3155 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3156 if (! NILP (foundry
[0]))
3157 foundry
[1] = null_vector
;
3158 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3160 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3161 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3163 foundry
[2] = null_vector
;
3166 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3168 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3169 if (! NILP (adstyle
[0]))
3170 adstyle
[1] = null_vector
;
3171 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3173 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3175 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3177 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3179 adstyle
[2] = null_vector
;
3182 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3185 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3188 val
= AREF (work
, FONT_FAMILY_INDEX
);
3189 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3191 val
= attrs
[LFACE_FAMILY_INDEX
];
3192 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3196 family
= alloca ((sizeof family
[0]) * 2);
3198 family
[1] = null_vector
; /* terminator. */
3203 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3204 /* Font family names are case-sensitive under NS. */
3212 if (! NILP (alters
))
3214 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3215 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3216 family
[i
] = XCAR (alters
);
3217 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3219 family
[i
] = null_vector
;
3223 family
= alloca ((sizeof family
[0]) * 3);
3226 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3228 family
[i
] = null_vector
;
3232 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3234 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3235 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3237 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3238 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3240 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3241 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3243 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3244 entities
= font_list_entities (frame
, work
);
3245 if (! NILP (entities
))
3247 val
= font_select_entity (frame
, entities
,
3248 attrs
, pixel_size
, c
);
3261 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3265 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3266 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3267 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3268 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3269 size
= font_pixel_size (f
, spec
);
3273 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3274 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3277 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3278 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3279 if (INTEGERP (height
))
3282 abort(); /* We should never end up here. */
3286 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3290 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3291 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3295 return font_open_entity (f
, entity
, size
);
3299 /* Find a font satisfying SPEC and best matching with face's
3300 attributes in ATTRS on FRAME, and return the opened
3304 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3306 Lisp_Object entity
, name
;
3308 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3311 /* No font is listed for SPEC, but each font-backend may have
3312 the different criteria about "font matching". So, try
3314 entity
= font_matching_entity (f
, attrs
, spec
);
3318 /* Don't lose the original name that was put in initially. We need
3319 it to re-apply the font when font parameters (like hinting or dpi) have
3321 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3324 name
= Ffont_get (spec
, QCuser_spec
);
3325 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3331 /* Make FACE on frame F ready to use the font opened for FACE. */
3334 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3336 if (face
->font
->driver
->prepare_face
)
3337 face
->font
->driver
->prepare_face (f
, face
);
3341 /* Make FACE on frame F stop using the font opened for FACE. */
3344 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3346 if (face
->font
->driver
->done_face
)
3347 face
->font
->driver
->done_face (f
, face
);
3352 /* Open a font matching with font-spec SPEC on frame F. If no proper
3353 font is found, return Qnil. */
3356 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3358 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3360 /* We set up the default font-related attributes of a face to prefer
3362 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3363 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3364 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3366 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3368 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3370 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3372 return font_load_for_lface (f
, attrs
, spec
);
3376 /* Open a font matching with NAME on frame F. If no proper font is
3377 found, return Qnil. */
3380 font_open_by_name (FRAME_PTR f
, const char *name
)
3382 Lisp_Object args
[2];
3383 Lisp_Object spec
, ret
;
3386 args
[1] = make_unibyte_string (name
, strlen (name
));
3387 spec
= Ffont_spec (2, args
);
3388 ret
= font_open_by_spec (f
, spec
);
3389 /* Do not lose name originally put in. */
3391 font_put_extra (ret
, QCuser_spec
, args
[1]);
3397 /* Register font-driver DRIVER. This function is used in two ways.
3399 The first is with frame F non-NULL. In this case, make DRIVER
3400 available (but not yet activated) on F. All frame creaters
3401 (e.g. Fx_create_frame) must call this function at least once with
3402 an available font-driver.
3404 The second is with frame F NULL. In this case, DRIVER is globally
3405 registered in the variable `font_driver_list'. All font-driver
3406 implementations must call this function in its syms_of_XXXX
3407 (e.g. syms_of_xfont). */
3410 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3412 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3413 struct font_driver_list
*prev
, *list
;
3415 if (f
&& ! driver
->draw
)
3416 error ("Unusable font driver for a frame: %s",
3417 SDATA (SYMBOL_NAME (driver
->type
)));
3419 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3420 if (EQ (list
->driver
->type
, driver
->type
))
3421 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3423 list
= xmalloc (sizeof (struct font_driver_list
));
3425 list
->driver
= driver
;
3430 f
->font_driver_list
= list
;
3432 font_driver_list
= list
;
3438 free_font_driver_list (FRAME_PTR f
)
3440 struct font_driver_list
*list
, *next
;
3442 for (list
= f
->font_driver_list
; list
; list
= next
)
3447 f
->font_driver_list
= NULL
;
3451 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3452 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3453 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3455 A caller must free all realized faces if any in advance. The
3456 return value is a list of font backends actually made used on
3460 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3462 Lisp_Object active_drivers
= Qnil
;
3463 struct font_driver
*driver
;
3464 struct font_driver_list
*list
;
3466 /* At first, turn off non-requested drivers, and turn on requested
3468 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3470 driver
= list
->driver
;
3471 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3476 if (driver
->end_for_frame
)
3477 driver
->end_for_frame (f
);
3478 font_finish_cache (f
, driver
);
3483 if (! driver
->start_for_frame
3484 || driver
->start_for_frame (f
) == 0)
3486 font_prepare_cache (f
, driver
);
3493 if (NILP (new_drivers
))
3496 if (! EQ (new_drivers
, Qt
))
3498 /* Re-order the driver list according to new_drivers. */
3499 struct font_driver_list
**list_table
, **next
;
3503 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3504 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3506 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3507 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3510 list_table
[i
++] = list
;
3512 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3514 list_table
[i
++] = list
;
3515 list_table
[i
] = NULL
;
3517 next
= &f
->font_driver_list
;
3518 for (i
= 0; list_table
[i
]; i
++)
3520 *next
= list_table
[i
];
3521 next
= &(*next
)->next
;
3525 if (! f
->font_driver_list
->on
)
3526 { /* None of the drivers is enabled: enable them all.
3527 Happens if you set the list of drivers to (xft x) in your .emacs
3528 and then use it under w32 or ns. */
3529 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3531 struct font_driver
*driver
= list
->driver
;
3532 eassert (! list
->on
);
3533 if (! driver
->start_for_frame
3534 || driver
->start_for_frame (f
) == 0)
3536 font_prepare_cache (f
, driver
);
3543 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3545 active_drivers
= nconc2 (active_drivers
,
3546 Fcons (list
->driver
->type
, Qnil
));
3547 return active_drivers
;
3551 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3553 struct font_data_list
*list
, *prev
;
3555 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3556 prev
= list
, list
= list
->next
)
3557 if (list
->driver
== driver
)
3564 prev
->next
= list
->next
;
3566 f
->font_data_list
= list
->next
;
3574 list
= xmalloc (sizeof (struct font_data_list
));
3575 list
->driver
= driver
;
3576 list
->next
= f
->font_data_list
;
3577 f
->font_data_list
= list
;
3585 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3587 struct font_data_list
*list
;
3589 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3590 if (list
->driver
== driver
)
3598 /* Sets attributes on a font. Any properties that appear in ALIST and
3599 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3600 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3601 arrays of strings. This function is intended for use by the font
3602 drivers to implement their specific font_filter_properties. */
3604 font_filter_properties (Lisp_Object font
,
3606 const char *const boolean_properties
[],
3607 const char *const non_boolean_properties
[])
3612 /* Set boolean values to Qt or Qnil */
3613 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3614 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3616 Lisp_Object key
= XCAR (XCAR (it
));
3617 Lisp_Object val
= XCDR (XCAR (it
));
3618 char *keystr
= SDATA (SYMBOL_NAME (key
));
3620 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3622 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3623 : SYMBOLP (val
) ? (const char *) SDATA (SYMBOL_NAME (val
))
3626 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3627 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3628 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3629 || strcmp ("Off", str
) == 0)
3634 Ffont_put (font
, key
, val
);
3638 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3639 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3641 Lisp_Object key
= XCAR (XCAR (it
));
3642 Lisp_Object val
= XCDR (XCAR (it
));
3643 char *keystr
= SDATA (SYMBOL_NAME (key
));
3644 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3645 Ffont_put (font
, key
, val
);
3650 /* Return the font used to draw character C by FACE at buffer position
3651 POS in window W. If STRING is non-nil, it is a string containing C
3652 at index POS. If C is negative, get C from the current buffer or
3656 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3661 Lisp_Object font_object
;
3663 multibyte
= (NILP (string
)
3664 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3665 : STRING_MULTIBYTE (string
));
3672 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3674 c
= FETCH_CHAR (pos_byte
);
3677 c
= FETCH_BYTE (pos
);
3683 multibyte
= STRING_MULTIBYTE (string
);
3686 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3688 str
= SDATA (string
) + pos_byte
;
3689 c
= STRING_CHAR (str
);
3692 c
= SDATA (string
)[pos
];
3696 f
= XFRAME (w
->frame
);
3697 if (! FRAME_WINDOW_P (f
))
3704 if (STRINGP (string
))
3705 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3706 DEFAULT_FACE_ID
, 0);
3708 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3710 face
= FACE_FROM_ID (f
, face_id
);
3714 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3715 face
= FACE_FROM_ID (f
, face_id
);
3720 XSETFONT (font_object
, face
->font
);
3725 #ifdef HAVE_WINDOW_SYSTEM
3727 /* Check how many characters after POS (at most to *LIMIT) can be
3728 displayed by the same font on the window W. FACE, if non-NULL, is
3729 the face selected for the character at POS. If STRING is not nil,
3730 it is the string to check instead of the current buffer. In that
3731 case, FACE must be not NULL.
3733 The return value is the font-object for the character at POS.
3734 *LIMIT is set to the position where that font can't be used.
3736 It is assured that the current buffer (or STRING) is multibyte. */
3739 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3741 EMACS_INT pos_byte
, ignore
;
3743 Lisp_Object font_object
= Qnil
;
3747 pos_byte
= CHAR_TO_BYTE (pos
);
3752 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3754 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3760 pos_byte
= string_char_to_byte (string
, pos
);
3763 while (pos
< *limit
)
3765 Lisp_Object category
;
3768 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3770 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3771 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3772 if (EQ (category
, QCf
)
3773 || CHAR_VARIATION_SELECTOR_P (c
))
3775 if (NILP (font_object
))
3777 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3778 if (NILP (font_object
))
3782 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3792 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3793 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3794 Return nil otherwise.
3795 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3796 which kind of font it is. It must be one of `font-spec', `font-entity',
3798 (Lisp_Object object
, Lisp_Object extra_type
)
3800 if (NILP (extra_type
))
3801 return (FONTP (object
) ? Qt
: Qnil
);
3802 if (EQ (extra_type
, Qfont_spec
))
3803 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3804 if (EQ (extra_type
, Qfont_entity
))
3805 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3806 if (EQ (extra_type
, Qfont_object
))
3807 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3808 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3811 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3812 doc
: /* Return a newly created font-spec with arguments as properties.
3814 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3815 valid font property name listed below:
3817 `:family', `:weight', `:slant', `:width'
3819 They are the same as face attributes of the same name. See
3820 `set-face-attribute'.
3824 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3828 VALUE must be a string or a symbol specifying the additional
3829 typographic style information of a font, e.g. ``sans''.
3833 VALUE must be a string or a symbol specifying the charset registry and
3834 encoding of a font, e.g. ``iso8859-1''.
3838 VALUE must be a non-negative integer or a floating point number
3839 specifying the font size. It specifies the font size in pixels (if
3840 VALUE is an integer), or in points (if VALUE is a float).
3844 VALUE must be a string of XLFD-style or fontconfig-style font name.
3848 VALUE must be a symbol representing a script that the font must
3849 support. It may be a symbol representing a subgroup of a script
3850 listed in the variable `script-representative-chars'.
3854 VALUE must be a symbol of two-letter ISO-639 language names,
3859 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3860 required OpenType features.
3862 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3863 LANGSYS-TAG: OpenType language system tag symbol,
3864 or nil for the default language system.
3865 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3866 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3868 GSUB and GPOS may contain `nil' element. In such a case, the font
3869 must not have any of the remaining elements.
3871 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3872 be an OpenType font, and whose GPOS table of `thai' script's default
3873 language system must contain `mark' feature.
3875 usage: (font-spec ARGS...) */)
3876 (int nargs
, Lisp_Object
*args
)
3878 Lisp_Object spec
= font_make_spec ();
3881 for (i
= 0; i
< nargs
; i
+= 2)
3883 Lisp_Object key
= args
[i
], val
;
3887 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3890 if (EQ (key
, QCname
))
3893 font_parse_name ((char *) SDATA (val
), spec
);
3894 font_put_extra (spec
, key
, val
);
3898 int idx
= get_font_prop_index (key
);
3902 val
= font_prop_validate (idx
, Qnil
, val
);
3903 if (idx
< FONT_EXTRA_INDEX
)
3904 ASET (spec
, idx
, val
);
3906 font_put_extra (spec
, key
, val
);
3909 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3915 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3916 doc
: /* Return a copy of FONT as a font-spec. */)
3919 Lisp_Object new_spec
, tail
, prev
, extra
;
3923 new_spec
= font_make_spec ();
3924 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3925 ASET (new_spec
, i
, AREF (font
, i
));
3926 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3927 /* We must remove :font-entity property. */
3928 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3929 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3932 extra
= XCDR (extra
);
3934 XSETCDR (prev
, XCDR (tail
));
3937 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3941 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3942 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3943 Every specified properties in FROM override the corresponding
3944 properties in TO. */)
3945 (Lisp_Object from
, Lisp_Object to
)
3947 Lisp_Object extra
, tail
;
3952 to
= Fcopy_font_spec (to
);
3953 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3954 ASET (to
, i
, AREF (from
, i
));
3955 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3956 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3957 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3959 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3962 XSETCDR (slot
, XCDR (XCAR (tail
)));
3964 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3966 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3970 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3971 doc
: /* Return the value of FONT's property KEY.
3972 FONT is a font-spec, a font-entity, or a font-object.
3973 KEY is any symbol, but these are reserved for specific meanings:
3974 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3975 :size, :name, :script, :otf
3976 See the documentation of `font-spec' for their meanings.
3977 In addition, if FONT is a font-entity or a font-object, values of
3978 :script and :otf are different from those of a font-spec as below:
3980 The value of :script may be a list of scripts that are supported by the font.
3982 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3983 representing the OpenType features supported by the font by this form:
3984 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3985 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3987 (Lisp_Object font
, Lisp_Object key
)
3995 idx
= get_font_prop_index (key
);
3996 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3997 return font_style_symbolic (font
, idx
, 0);
3998 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3999 return AREF (font
, idx
);
4000 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4001 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4003 struct font
*fontp
= XFONT_OBJECT (font
);
4005 if (fontp
->driver
->otf_capability
)
4006 val
= fontp
->driver
->otf_capability (fontp
);
4008 val
= Fcons (Qnil
, Qnil
);
4009 font_put_extra (font
, QCotf
, val
);
4016 #ifdef HAVE_WINDOW_SYSTEM
4018 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4019 doc
: /* Return a plist of face attributes generated by FONT.
4020 FONT is a font name, a font-spec, a font-entity, or a font-object.
4021 The return value is a list of the form
4023 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4025 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4026 compatible with `set-face-attribute'. Some of these key-attribute pairs
4027 may be omitted from the list if they are not specified by FONT.
4029 The optional argument FRAME specifies the frame that the face attributes
4030 are to be displayed on. If omitted, the selected frame is used. */)
4031 (Lisp_Object font
, Lisp_Object frame
)
4034 Lisp_Object plist
[10];
4039 frame
= selected_frame
;
4040 CHECK_LIVE_FRAME (frame
);
4045 int fontset
= fs_query_fontset (font
, 0);
4046 Lisp_Object name
= font
;
4048 font
= fontset_ascii (fontset
);
4049 font
= font_spec_from_name (name
);
4051 signal_error ("Invalid font name", name
);
4053 else if (! FONTP (font
))
4054 signal_error ("Invalid font object", font
);
4056 val
= AREF (font
, FONT_FAMILY_INDEX
);
4059 plist
[n
++] = QCfamily
;
4060 plist
[n
++] = SYMBOL_NAME (val
);
4063 val
= AREF (font
, FONT_SIZE_INDEX
);
4066 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4067 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4068 plist
[n
++] = QCheight
;
4069 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4071 else if (FLOATP (val
))
4073 plist
[n
++] = QCheight
;
4074 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4077 val
= FONT_WEIGHT_FOR_FACE (font
);
4080 plist
[n
++] = QCweight
;
4084 val
= FONT_SLANT_FOR_FACE (font
);
4087 plist
[n
++] = QCslant
;
4091 val
= FONT_WIDTH_FOR_FACE (font
);
4094 plist
[n
++] = QCwidth
;
4098 return Flist (n
, plist
);
4103 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4104 doc
: /* Set one property of FONT: give property KEY value VAL.
4105 FONT is a font-spec, a font-entity, or a font-object.
4107 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4108 accepted by the function `font-spec' (which see), VAL must be what
4109 allowed in `font-spec'.
4111 If FONT is a font-entity or a font-object, KEY must not be the one
4112 accepted by `font-spec'. */)
4113 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4117 idx
= get_font_prop_index (prop
);
4118 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4120 CHECK_FONT_SPEC (font
);
4121 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4125 if (EQ (prop
, QCname
)
4126 || EQ (prop
, QCscript
)
4127 || EQ (prop
, QClang
)
4128 || EQ (prop
, QCotf
))
4129 CHECK_FONT_SPEC (font
);
4132 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4137 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4138 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4139 Optional 2nd argument FRAME specifies the target frame.
4140 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4141 Optional 4th argument PREFER, if non-nil, is a font-spec to
4142 control the order of the returned list. Fonts are sorted by
4143 how close they are to PREFER. */)
4144 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4146 Lisp_Object vec
, list
;
4150 frame
= selected_frame
;
4151 CHECK_LIVE_FRAME (frame
);
4152 CHECK_FONT_SPEC (font_spec
);
4160 if (! NILP (prefer
))
4161 CHECK_FONT_SPEC (prefer
);
4163 list
= font_list_entities (frame
, font_spec
);
4166 if (NILP (XCDR (list
))
4167 && ASIZE (XCAR (list
)) == 1)
4168 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4170 if (! NILP (prefer
))
4171 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4173 vec
= font_vconcat_entity_vectors (list
);
4174 if (n
== 0 || n
>= ASIZE (vec
))
4176 Lisp_Object args
[2];
4180 list
= Fappend (2, args
);
4184 for (list
= Qnil
, n
--; n
>= 0; n
--)
4185 list
= Fcons (AREF (vec
, n
), list
);
4190 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4191 doc
: /* List available font families on the current frame.
4192 Optional argument FRAME, if non-nil, specifies the target frame. */)
4196 struct font_driver_list
*driver_list
;
4200 frame
= selected_frame
;
4201 CHECK_LIVE_FRAME (frame
);
4204 for (driver_list
= f
->font_driver_list
; driver_list
;
4205 driver_list
= driver_list
->next
)
4206 if (driver_list
->driver
->list_family
)
4208 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4209 Lisp_Object tail
= list
;
4211 for (; CONSP (val
); val
= XCDR (val
))
4212 if (NILP (Fmemq (XCAR (val
), tail
))
4213 && SYMBOLP (XCAR (val
)))
4214 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4219 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4220 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4221 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4222 (Lisp_Object font_spec
, Lisp_Object frame
)
4224 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4231 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4232 doc
: /* Return XLFD name of FONT.
4233 FONT is a font-spec, font-entity, or font-object.
4234 If the name is too long for XLFD (maximum 255 chars), return nil.
4235 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4236 the consecutive wildcards are folded to one. */)
4237 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4244 if (FONT_OBJECT_P (font
))
4246 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4248 if (STRINGP (font_name
)
4249 && SDATA (font_name
)[0] == '-')
4251 if (NILP (fold_wildcards
))
4253 strcpy (name
, (char *) SDATA (font_name
));
4256 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4258 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4261 if (! NILP (fold_wildcards
))
4263 char *p0
= name
, *p1
;
4265 while ((p1
= strstr (p0
, "-*-*")))
4267 strcpy (p1
, p1
+ 2);
4272 return build_string (name
);
4275 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4276 doc
: /* Clear font cache. */)
4279 Lisp_Object list
, frame
;
4281 FOR_EACH_FRAME (list
, frame
)
4283 FRAME_PTR f
= XFRAME (frame
);
4284 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4286 for (; driver_list
; driver_list
= driver_list
->next
)
4287 if (driver_list
->on
)
4289 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4290 Lisp_Object val
, tmp
;
4294 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4296 font_assert (! NILP (val
));
4297 tmp
= XCDR (XCAR (val
));
4298 if (XINT (XCAR (tmp
)) == 0)
4300 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4301 XSETCDR (cache
, XCDR (val
));
4311 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4313 struct font
*font
= XFONT_OBJECT (font_object
);
4315 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4316 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4317 struct font_metrics metrics
;
4319 LGLYPH_SET_CODE (glyph
, ecode
);
4321 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4322 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4323 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4324 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4325 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4326 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4330 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4331 doc
: /* Shape the glyph-string GSTRING.
4332 Shaping means substituting glyphs and/or adjusting positions of glyphs
4333 to get the correct visual image of character sequences set in the
4334 header of the glyph-string.
4336 If the shaping was successful, the value is GSTRING itself or a newly
4337 created glyph-string. Otherwise, the value is nil. */)
4338 (Lisp_Object gstring
)
4341 Lisp_Object font_object
, n
, glyph
;
4344 if (! composition_gstring_p (gstring
))
4345 signal_error ("Invalid glyph-string: ", gstring
);
4346 if (! NILP (LGSTRING_ID (gstring
)))
4348 font_object
= LGSTRING_FONT (gstring
);
4349 CHECK_FONT_OBJECT (font_object
);
4350 font
= XFONT_OBJECT (font_object
);
4351 if (! font
->driver
->shape
)
4354 /* Try at most three times with larger gstring each time. */
4355 for (i
= 0; i
< 3; i
++)
4357 n
= font
->driver
->shape (gstring
);
4360 gstring
= larger_vector (gstring
,
4361 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4364 if (i
== 3 || XINT (n
) == 0)
4366 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4367 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4369 glyph
= LGSTRING_GLYPH (gstring
, 0);
4370 from
= LGLYPH_FROM (glyph
);
4371 to
= LGLYPH_TO (glyph
);
4372 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4374 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4378 if (NILP (LGLYPH_ADJUSTMENT (this)))
4383 glyph
= LGSTRING_GLYPH (gstring
, j
);
4384 LGLYPH_SET_FROM (glyph
, from
);
4385 LGLYPH_SET_TO (glyph
, to
);
4387 from
= LGLYPH_FROM (this);
4388 to
= LGLYPH_TO (this);
4393 if (from
> LGLYPH_FROM (this))
4394 from
= LGLYPH_FROM (this);
4395 if (to
< LGLYPH_TO (this))
4396 to
= LGLYPH_TO (this);
4402 glyph
= LGSTRING_GLYPH (gstring
, j
);
4403 LGLYPH_SET_FROM (glyph
, from
);
4404 LGLYPH_SET_TO (glyph
, to
);
4406 return composition_gstring_put_cache (gstring
, XINT (n
));
4409 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4411 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4412 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4414 VARIATION-SELECTOR is a character code of variation selection
4415 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4416 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4417 (Lisp_Object font_object
, Lisp_Object character
)
4419 unsigned variations
[256];
4424 CHECK_FONT_OBJECT (font_object
);
4425 CHECK_CHARACTER (character
);
4426 font
= XFONT_OBJECT (font_object
);
4427 if (! font
->driver
->get_variation_glyphs
)
4429 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4433 for (i
= 0; i
< 255; i
++)
4437 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4438 /* Stops GCC whining about limited range of data type. */
4439 EMACS_INT var
= variations
[i
];
4441 if (var
> MOST_POSITIVE_FIXNUM
)
4442 code
= Fcons (make_number ((variations
[i
]) >> 16),
4443 make_number ((variations
[i
]) & 0xFFFF));
4445 code
= make_number (variations
[i
]);
4446 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4453 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4454 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4455 OTF-FEATURES specifies which features to apply in this format:
4456 (SCRIPT LANGSYS GSUB GPOS)
4458 SCRIPT is a symbol specifying a script tag of OpenType,
4459 LANGSYS is a symbol specifying a langsys tag of OpenType,
4460 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4462 If LANGYS is nil, the default langsys is selected.
4464 The features are applied in the order they appear in the list. The
4465 symbol `*' means to apply all available features not present in this
4466 list, and the remaining features are ignored. For instance, (vatu
4467 pstf * haln) is to apply vatu and pstf in this order, then to apply
4468 all available features other than vatu, pstf, and haln.
4470 The features are applied to the glyphs in the range FROM and TO of
4471 the glyph-string GSTRING-IN.
4473 If some feature is actually applicable, the resulting glyphs are
4474 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4475 this case, the value is the number of produced glyphs.
4477 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4480 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4481 produced in GSTRING-OUT, and the value is nil.
4483 See the documentation of `font-make-gstring' for the format of
4485 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4487 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4492 check_otf_features (otf_features
);
4493 CHECK_FONT_OBJECT (font_object
);
4494 font
= XFONT_OBJECT (font_object
);
4495 if (! font
->driver
->otf_drive
)
4496 error ("Font backend %s can't drive OpenType GSUB table",
4497 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4498 CHECK_CONS (otf_features
);
4499 CHECK_SYMBOL (XCAR (otf_features
));
4500 val
= XCDR (otf_features
);
4501 CHECK_SYMBOL (XCAR (val
));
4502 val
= XCDR (otf_features
);
4505 len
= check_gstring (gstring_in
);
4506 CHECK_VECTOR (gstring_out
);
4507 CHECK_NATNUM (from
);
4509 CHECK_NATNUM (index
);
4511 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4512 args_out_of_range_3 (from
, to
, make_number (len
));
4513 if (XINT (index
) >= ASIZE (gstring_out
))
4514 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4515 num
= font
->driver
->otf_drive (font
, otf_features
,
4516 gstring_in
, XINT (from
), XINT (to
),
4517 gstring_out
, XINT (index
), 0);
4520 return make_number (num
);
4523 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4525 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4526 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4528 (SCRIPT LANGSYS FEATURE ...)
4529 See the documentation of `font-drive-otf' for more detail.
4531 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4532 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4533 character code corresponding to the glyph or nil if there's no
4534 corresponding character. */)
4535 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4538 Lisp_Object gstring_in
, gstring_out
, g
;
4539 Lisp_Object alternates
;
4542 CHECK_FONT_GET_OBJECT (font_object
, font
);
4543 if (! font
->driver
->otf_drive
)
4544 error ("Font backend %s can't drive OpenType GSUB table",
4545 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4546 CHECK_CHARACTER (character
);
4547 CHECK_CONS (otf_features
);
4549 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4550 g
= LGSTRING_GLYPH (gstring_in
, 0);
4551 LGLYPH_SET_CHAR (g
, XINT (character
));
4552 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4553 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4554 gstring_out
, 0, 1)) < 0)
4555 gstring_out
= Ffont_make_gstring (font_object
,
4556 make_number (ASIZE (gstring_out
) * 2));
4558 for (i
= 0; i
< num
; i
++)
4560 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4561 int c
= LGLYPH_CHAR (g
);
4562 unsigned code
= LGLYPH_CODE (g
);
4564 alternates
= Fcons (Fcons (make_number (code
),
4565 c
> 0 ? make_number (c
) : Qnil
),
4568 return Fnreverse (alternates
);
4574 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4575 doc
: /* Open FONT-ENTITY. */)
4576 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4580 CHECK_FONT_ENTITY (font_entity
);
4582 frame
= selected_frame
;
4583 CHECK_LIVE_FRAME (frame
);
4586 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4589 CHECK_NUMBER_OR_FLOAT (size
);
4591 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4593 isize
= XINT (size
);
4597 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4600 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4601 doc
: /* Close FONT-OBJECT. */)
4602 (Lisp_Object font_object
, Lisp_Object frame
)
4604 CHECK_FONT_OBJECT (font_object
);
4606 frame
= selected_frame
;
4607 CHECK_LIVE_FRAME (frame
);
4608 font_close_object (XFRAME (frame
), font_object
);
4612 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4613 doc
: /* Return information about FONT-OBJECT.
4614 The value is a vector:
4615 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4618 NAME is a string of the font name (or nil if the font backend doesn't
4621 FILENAME is a string of the font file (or nil if the font backend
4622 doesn't provide a file name).
4624 PIXEL-SIZE is a pixel size by which the font is opened.
4626 SIZE is a maximum advance width of the font in pixels.
4628 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4631 CAPABILITY is a list whose first element is a symbol representing the
4632 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4633 remaining elements describe the details of the font capability.
4635 If the font is OpenType font, the form of the list is
4636 \(opentype GSUB GPOS)
4637 where GSUB shows which "GSUB" features the font supports, and GPOS
4638 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4639 lists of the format:
4640 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4642 If the font is not OpenType font, currently the length of the form is
4645 SCRIPT is a symbol representing OpenType script tag.
4647 LANGSYS is a symbol representing OpenType langsys tag, or nil
4648 representing the default langsys.
4650 FEATURE is a symbol representing OpenType feature tag.
4652 If the font is not OpenType font, CAPABILITY is nil. */)
4653 (Lisp_Object font_object
)
4658 CHECK_FONT_GET_OBJECT (font_object
, font
);
4660 val
= Fmake_vector (make_number (9), Qnil
);
4661 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4662 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4663 ASET (val
, 2, make_number (font
->pixel_size
));
4664 ASET (val
, 3, make_number (font
->max_width
));
4665 ASET (val
, 4, make_number (font
->ascent
));
4666 ASET (val
, 5, make_number (font
->descent
));
4667 ASET (val
, 6, make_number (font
->space_width
));
4668 ASET (val
, 7, make_number (font
->average_width
));
4669 if (font
->driver
->otf_capability
)
4670 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4674 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4676 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4677 FROM and TO are positions (integers or markers) specifying a region
4678 of the current buffer.
4679 If the optional fourth arg OBJECT is not nil, it is a string or a
4680 vector containing the target characters.
4682 Each element is a vector containing information of a glyph in this format:
4683 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4685 FROM is an index numbers of a character the glyph corresponds to.
4686 TO is the same as FROM.
4687 C is the character of the glyph.
4688 CODE is the glyph-code of C in FONT-OBJECT.
4689 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4690 ADJUSTMENT is always nil.
4691 If FONT-OBJECT doesn't have a glyph for a character,
4692 the corresponding element is nil. */)
4693 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4698 Lisp_Object
*chars
, vec
;
4701 CHECK_FONT_GET_OBJECT (font_object
, font
);
4704 EMACS_INT charpos
, bytepos
;
4706 validate_region (&from
, &to
);
4709 len
= XFASTINT (to
) - XFASTINT (from
);
4710 SAFE_ALLOCA_LISP (chars
, len
);
4711 charpos
= XFASTINT (from
);
4712 bytepos
= CHAR_TO_BYTE (charpos
);
4713 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4715 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4716 chars
[i
] = make_number (c
);
4719 else if (STRINGP (object
))
4721 const unsigned char *p
;
4723 CHECK_NUMBER (from
);
4725 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4726 || XINT (to
) > SCHARS (object
))
4727 args_out_of_range_3 (object
, from
, to
);
4730 len
= XFASTINT (to
) - XFASTINT (from
);
4731 SAFE_ALLOCA_LISP (chars
, len
);
4733 if (STRING_MULTIBYTE (object
))
4734 for (i
= 0; i
< len
; i
++)
4736 c
= STRING_CHAR_ADVANCE (p
);
4737 chars
[i
] = make_number (c
);
4740 for (i
= 0; i
< len
; i
++)
4741 chars
[i
] = make_number (p
[i
]);
4745 CHECK_VECTOR (object
);
4746 CHECK_NUMBER (from
);
4748 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4749 || XINT (to
) > ASIZE (object
))
4750 args_out_of_range_3 (object
, from
, to
);
4753 len
= XFASTINT (to
) - XFASTINT (from
);
4754 for (i
= 0; i
< len
; i
++)
4756 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4757 CHECK_CHARACTER (elt
);
4759 chars
= &(AREF (object
, XFASTINT (from
)));
4762 vec
= Fmake_vector (make_number (len
), Qnil
);
4763 for (i
= 0; i
< len
; i
++)
4766 int c
= XFASTINT (chars
[i
]);
4769 struct font_metrics metrics
;
4771 cod
= code
= font
->driver
->encode_char (font
, c
);
4772 if (code
== FONT_INVALID_CODE
)
4774 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4775 LGLYPH_SET_FROM (g
, i
);
4776 LGLYPH_SET_TO (g
, i
);
4777 LGLYPH_SET_CHAR (g
, c
);
4778 LGLYPH_SET_CODE (g
, code
);
4779 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4780 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4781 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4782 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4783 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4784 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4787 if (! VECTORP (object
))
4792 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4793 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4794 FONT is a font-spec, font-entity, or font-object. */)
4795 (Lisp_Object spec
, Lisp_Object font
)
4797 CHECK_FONT_SPEC (spec
);
4800 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4803 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4804 doc
: /* Return a font-object for displaying a character at POSITION.
4805 Optional second arg WINDOW, if non-nil, is a window displaying
4806 the current buffer. It defaults to the currently selected window. */)
4807 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4814 CHECK_NUMBER_COERCE_MARKER (position
);
4815 pos
= XINT (position
);
4816 if (pos
< BEGV
|| pos
>= ZV
)
4817 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4821 CHECK_NUMBER (position
);
4822 CHECK_STRING (string
);
4823 pos
= XINT (position
);
4824 if (pos
< 0 || pos
>= SCHARS (string
))
4825 args_out_of_range (string
, position
);
4828 window
= selected_window
;
4829 CHECK_LIVE_WINDOW (window
);
4830 w
= XWINDOW (window
);
4832 return font_at (-1, pos
, NULL
, w
, string
);
4836 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4837 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4838 The value is a number of glyphs drawn.
4839 Type C-l to recover what previously shown. */)
4840 (Lisp_Object font_object
, Lisp_Object string
)
4842 Lisp_Object frame
= selected_frame
;
4843 FRAME_PTR f
= XFRAME (frame
);
4849 CHECK_FONT_GET_OBJECT (font_object
, font
);
4850 CHECK_STRING (string
);
4851 len
= SCHARS (string
);
4852 code
= alloca (sizeof (unsigned) * len
);
4853 for (i
= 0; i
< len
; i
++)
4855 Lisp_Object ch
= Faref (string
, make_number (i
));
4859 code
[i
] = font
->driver
->encode_char (font
, c
);
4860 if (code
[i
] == FONT_INVALID_CODE
)
4863 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4865 if (font
->driver
->prepare_face
)
4866 font
->driver
->prepare_face (f
, face
);
4867 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4868 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4869 if (font
->driver
->done_face
)
4870 font
->driver
->done_face (f
, face
);
4872 return make_number (len
);
4876 #endif /* FONT_DEBUG */
4878 #ifdef HAVE_WINDOW_SYSTEM
4880 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4881 doc
: /* Return information about a font named NAME on frame FRAME.
4882 If FRAME is omitted or nil, use the selected frame.
4883 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4884 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4886 OPENED-NAME is the name used for opening the font,
4887 FULL-NAME is the full name of the font,
4888 SIZE is the pixelsize of the font,
4889 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4890 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4891 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4892 how to compose characters.
4893 If the named font is not yet loaded, return nil. */)
4894 (Lisp_Object name
, Lisp_Object frame
)
4899 Lisp_Object font_object
;
4901 (*check_window_system_func
) ();
4904 CHECK_STRING (name
);
4906 frame
= selected_frame
;
4907 CHECK_LIVE_FRAME (frame
);
4912 int fontset
= fs_query_fontset (name
, 0);
4915 name
= fontset_ascii (fontset
);
4916 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4918 else if (FONT_OBJECT_P (name
))
4920 else if (FONT_ENTITY_P (name
))
4921 font_object
= font_open_entity (f
, name
, 0);
4924 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4925 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4927 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4929 if (NILP (font_object
))
4931 font
= XFONT_OBJECT (font_object
);
4933 info
= Fmake_vector (make_number (7), Qnil
);
4934 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4935 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4936 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4937 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4938 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4939 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4940 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4943 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4944 close it now. Perhaps, we should manage font-objects
4945 by `reference-count'. */
4946 font_close_object (f
, font_object
);
4953 #define BUILD_STYLE_TABLE(TBL) \
4954 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4957 build_style_table (const struct table_entry
*entry
, int nelement
)
4960 Lisp_Object table
, elt
;
4962 table
= Fmake_vector (make_number (nelement
), Qnil
);
4963 for (i
= 0; i
< nelement
; i
++)
4965 for (j
= 0; entry
[i
].names
[j
]; j
++);
4966 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4967 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4968 for (j
= 0; entry
[i
].names
[j
]; j
++)
4969 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4970 ASET (table
, i
, elt
);
4975 /* The deferred font-log data of the form [ACTION ARG RESULT].
4976 If ACTION is not nil, that is added to the log when font_add_log is
4977 called next time. At that time, ACTION is set back to nil. */
4978 static Lisp_Object Vfont_log_deferred
;
4980 /* Prepend the font-related logging data in Vfont_log if it is not
4981 `t'. ACTION describes a kind of font-related action (e.g. listing,
4982 opening), ARG is the argument for the action, and RESULT is the
4983 result of the action. */
4985 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4987 Lisp_Object tail
, val
;
4990 if (EQ (Vfont_log
, Qt
))
4992 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4994 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
4996 ASET (Vfont_log_deferred
, 0, Qnil
);
4997 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4998 AREF (Vfont_log_deferred
, 2));
5003 Lisp_Object tail
, elt
;
5004 Lisp_Object equalstr
= build_string ("=");
5006 val
= Ffont_xlfd_name (arg
, Qt
);
5007 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5011 if (EQ (XCAR (elt
), QCscript
)
5012 && SYMBOLP (XCDR (elt
)))
5013 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5014 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5015 else if (EQ (XCAR (elt
), QClang
)
5016 && SYMBOLP (XCDR (elt
)))
5017 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5018 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5019 else if (EQ (XCAR (elt
), QCotf
)
5020 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5021 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5023 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5029 && VECTORP (XCAR (result
))
5030 && ASIZE (XCAR (result
)) > 0
5031 && FONTP (AREF (XCAR (result
), 0)))
5032 result
= font_vconcat_entity_vectors (result
);
5035 val
= Ffont_xlfd_name (result
, Qt
);
5036 if (! FONT_SPEC_P (result
))
5037 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5038 build_string (":"), val
);
5041 else if (CONSP (result
))
5043 result
= Fcopy_sequence (result
);
5044 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5048 val
= Ffont_xlfd_name (val
, Qt
);
5049 XSETCAR (tail
, val
);
5052 else if (VECTORP (result
))
5054 result
= Fcopy_sequence (result
);
5055 for (i
= 0; i
< ASIZE (result
); i
++)
5057 val
= AREF (result
, i
);
5059 val
= Ffont_xlfd_name (val
, Qt
);
5060 ASET (result
, i
, val
);
5063 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5066 /* Record a font-related logging data to be added to Vfont_log when
5067 font_add_log is called next time. ACTION, ARG, RESULT are the same
5071 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5073 if (EQ (Vfont_log
, Qt
))
5075 ASET (Vfont_log_deferred
, 0, build_string (action
));
5076 ASET (Vfont_log_deferred
, 1, arg
);
5077 ASET (Vfont_log_deferred
, 2, result
);
5083 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5084 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5085 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5086 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5087 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5088 /* Note that the other elements in sort_shift_bits are not used. */
5090 staticpro (&font_charset_alist
);
5091 font_charset_alist
= Qnil
;
5093 DEFSYM (Qopentype
, "opentype");
5095 DEFSYM (Qascii_0
, "ascii-0");
5096 DEFSYM (Qiso8859_1
, "iso8859-1");
5097 DEFSYM (Qiso10646_1
, "iso10646-1");
5098 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5099 DEFSYM (Qunicode_sip
, "unicode-sip");
5103 DEFSYM (QCotf
, ":otf");
5104 DEFSYM (QClang
, ":lang");
5105 DEFSYM (QCscript
, ":script");
5106 DEFSYM (QCantialias
, ":antialias");
5108 DEFSYM (QCfoundry
, ":foundry");
5109 DEFSYM (QCadstyle
, ":adstyle");
5110 DEFSYM (QCregistry
, ":registry");
5111 DEFSYM (QCspacing
, ":spacing");
5112 DEFSYM (QCdpi
, ":dpi");
5113 DEFSYM (QCscalable
, ":scalable");
5114 DEFSYM (QCavgwidth
, ":avgwidth");
5115 DEFSYM (QCfont_entity
, ":font-entity");
5116 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5126 DEFSYM (QCuser_spec
, "user-spec");
5128 staticpro (&null_vector
);
5129 null_vector
= Fmake_vector (make_number (0), Qnil
);
5131 staticpro (&scratch_font_spec
);
5132 scratch_font_spec
= Ffont_spec (0, NULL
);
5133 staticpro (&scratch_font_prefer
);
5134 scratch_font_prefer
= Ffont_spec (0, NULL
);
5136 staticpro (&Vfont_log_deferred
);
5137 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5141 staticpro (&otf_list
);
5143 #endif /* HAVE_LIBOTF */
5147 defsubr (&Sfont_spec
);
5148 defsubr (&Sfont_get
);
5149 #ifdef HAVE_WINDOW_SYSTEM
5150 defsubr (&Sfont_face_attributes
);
5152 defsubr (&Sfont_put
);
5153 defsubr (&Slist_fonts
);
5154 defsubr (&Sfont_family_list
);
5155 defsubr (&Sfind_font
);
5156 defsubr (&Sfont_xlfd_name
);
5157 defsubr (&Sclear_font_cache
);
5158 defsubr (&Sfont_shape_gstring
);
5159 defsubr (&Sfont_variation_glyphs
);
5161 defsubr (&Sfont_drive_otf
);
5162 defsubr (&Sfont_otf_alternates
);
5166 defsubr (&Sopen_font
);
5167 defsubr (&Sclose_font
);
5168 defsubr (&Squery_font
);
5169 defsubr (&Sfont_get_glyphs
);
5170 defsubr (&Sfont_match_p
);
5171 defsubr (&Sfont_at
);
5173 defsubr (&Sdraw_string
);
5175 #endif /* FONT_DEBUG */
5176 #ifdef HAVE_WINDOW_SYSTEM
5177 defsubr (&Sfont_info
);
5180 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5182 Alist of fontname patterns vs the corresponding encoding and repertory info.
5183 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5184 where ENCODING is a charset or a char-table,
5185 and REPERTORY is a charset, a char-table, or nil.
5187 If ENCODING and REPERTORY are the same, the element can have the form
5188 \(REGEXP . ENCODING).
5190 ENCODING is for converting a character to a glyph code of the font.
5191 If ENCODING is a charset, encoding a character by the charset gives
5192 the corresponding glyph code. If ENCODING is a char-table, looking up
5193 the table by a character gives the corresponding glyph code.
5195 REPERTORY specifies a repertory of characters supported by the font.
5196 If REPERTORY is a charset, all characters beloging to the charset are
5197 supported. If REPERTORY is a char-table, all characters who have a
5198 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5199 gets the repertory information by an opened font and ENCODING. */);
5200 Vfont_encoding_alist
= Qnil
;
5202 /* FIXME: These 3 vars are not quite what they appear: setq on them
5203 won't have any effect other than disconnect them from the style
5204 table used by the font display code. So we make them read-only,
5205 to avoid this confusing situation. */
5207 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5208 doc
: /* Vector of valid font weight values.
5209 Each element has the form:
5210 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5211 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5212 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5213 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5215 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5216 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5217 See `font-weight-table' for the format of the vector. */);
5218 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5219 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5221 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5222 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5223 See `font-weight-table' for the format of the vector. */);
5224 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5225 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5227 staticpro (&font_style_table
);
5228 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5229 ASET (font_style_table
, 0, Vfont_weight_table
);
5230 ASET (font_style_table
, 1, Vfont_slant_table
);
5231 ASET (font_style_table
, 2, Vfont_width_table
);
5233 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5234 *Logging list of font related actions and results.
5235 The value t means to suppress the logging.
5236 The initial value is set to nil if the environment variable
5237 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5240 #ifdef HAVE_WINDOW_SYSTEM
5241 #ifdef HAVE_FREETYPE
5243 #ifdef HAVE_X_WINDOWS
5248 #endif /* HAVE_XFT */
5249 #endif /* HAVE_X_WINDOWS */
5250 #else /* not HAVE_FREETYPE */
5251 #ifdef HAVE_X_WINDOWS
5253 #endif /* HAVE_X_WINDOWS */
5254 #endif /* not HAVE_FREETYPE */
5257 #endif /* HAVE_BDFFONT */
5260 #endif /* WINDOWSNT */
5263 #endif /* HAVE_NS */
5264 #endif /* HAVE_WINDOW_SYSTEM */
5270 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;