1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2011 Free Software Foundation, Inc.
4 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
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
;
130 static Lisp_Object QCfc_unknown_spec
;
131 /* Symbols representing values of font spacing property. */
132 static Lisp_Object Qc
, Qm
, Qd
;
134 /* Special ADSTYLE properties to avoid fonts used for Latin
135 characters; used in xfont.c and ftfont.c. */
136 Lisp_Object Qja
, Qko
;
138 static Lisp_Object QCuser_spec
;
140 /* Alist of font registry symbols and the corresponding charset
141 information. The information is retrieved from
142 Vfont_encoding_alist on demand.
144 Eash element has the form:
145 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
149 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
150 encodes a character code to a glyph code of a font, and
151 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
152 character is supported by a font.
154 The latter form means that the information for REGISTRY couldn't be
156 static Lisp_Object font_charset_alist
;
158 /* List of all font drivers. Each font-backend (XXXfont.c) calls
159 register_font_driver in syms_of_XXXfont to register its font-driver
161 static struct font_driver_list
*font_driver_list
;
165 /* Creaters of font-related Lisp object. */
168 font_make_spec (void)
170 Lisp_Object font_spec
;
171 struct font_spec
*spec
172 = ((struct font_spec
*)
173 allocate_pseudovector (VECSIZE (struct font_spec
),
174 FONT_SPEC_MAX
, PVEC_FONT
));
175 XSETFONT (font_spec
, spec
);
180 font_make_entity (void)
182 Lisp_Object font_entity
;
183 struct font_entity
*entity
184 = ((struct font_entity
*)
185 allocate_pseudovector (VECSIZE (struct font_entity
),
186 FONT_ENTITY_MAX
, PVEC_FONT
));
187 XSETFONT (font_entity
, entity
);
191 /* Create a font-object whose structure size is SIZE. If ENTITY is
192 not nil, copy properties from ENTITY to the font-object. If
193 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
195 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
197 Lisp_Object font_object
;
199 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
202 XSETFONT (font_object
, font
);
206 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
207 font
->props
[i
] = AREF (entity
, i
);
208 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
209 font
->props
[FONT_EXTRA_INDEX
]
210 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
213 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
219 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
220 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
221 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
223 static unsigned font_encode_char (Lisp_Object
, int);
225 /* Number of registered font drivers. */
226 static int num_font_drivers
;
229 /* Return a Lispy value of a font property value at STR and LEN bytes.
230 If STR is "*", return nil.
231 If FORCE_SYMBOL is zero and all characters in STR are digits,
232 return an integer. Otherwise, return a symbol interned from
236 font_intern_prop (const char *str
, ptrdiff_t len
, int force_symbol
)
241 ptrdiff_t nbytes
, nchars
;
243 if (len
== 1 && *str
== '*')
245 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
247 for (i
= 1; i
< len
; i
++)
248 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
255 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
258 return make_number (n
);
259 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
263 xsignal1 (Qoverflow_error
, make_string (str
, len
));
267 /* The following code is copied from the function intern (in
268 lread.c), and modified to suit our purpose. */
270 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
271 obarray
= check_obarray (obarray
);
272 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
273 if (len
== nchars
|| len
!= nbytes
)
274 /* CONTENTS contains no multibyte sequences or contains an invalid
275 multibyte sequence. We'll make a unibyte string. */
276 tem
= oblookup (obarray
, str
, len
, len
);
278 tem
= oblookup (obarray
, str
, nchars
, len
);
281 if (len
== nchars
|| len
!= nbytes
)
282 tem
= make_unibyte_string (str
, len
);
284 tem
= make_multibyte_string (str
, nchars
, len
);
285 return Fintern (tem
, obarray
);
288 /* Return a pixel size of font-spec SPEC on frame F. */
291 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
293 #ifdef HAVE_WINDOW_SYSTEM
294 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
303 font_assert (FLOATP (size
));
304 point_size
= XFLOAT_DATA (size
);
305 val
= AREF (spec
, FONT_DPI_INDEX
);
310 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
318 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
319 font vector. If VAL is not valid (i.e. not registered in
320 font_style_table), return -1 if NOERROR is zero, and return a
321 proper index if NOERROR is nonzero. In that case, register VAL in
322 font_style_table if VAL is a symbol, and return the closest index if
323 VAL is an integer. */
326 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
328 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
329 int len
= ASIZE (table
);
335 Lisp_Object args
[2], elt
;
337 /* At first try exact match. */
338 for (i
= 0; i
< len
; i
++)
339 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
340 if (EQ (val
, AREF (AREF (table
, i
), j
)))
341 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
342 | (i
<< 4) | (j
- 1));
343 /* Try also with case-folding match. */
344 s
= SSDATA (SYMBOL_NAME (val
));
345 for (i
= 0; i
< len
; i
++)
346 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
348 elt
= AREF (AREF (table
, i
), j
);
349 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
350 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
351 | (i
<< 4) | (j
- 1));
357 elt
= Fmake_vector (make_number (2), make_number (100));
360 args
[1] = Fmake_vector (make_number (1), elt
);
361 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
362 return (100 << 8) | (i
<< 4);
367 EMACS_INT numeric
= XINT (val
);
369 for (i
= 0, last_n
= -1; i
< len
; i
++)
371 int n
= XINT (AREF (AREF (table
, i
), 0));
374 return (n
<< 8) | (i
<< 4);
379 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
380 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
386 return ((last_n
<< 8) | ((i
- 1) << 4));
391 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
393 Lisp_Object val
= AREF (font
, prop
);
394 Lisp_Object table
, elt
;
399 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
400 i
= XINT (val
) & 0xFF;
401 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
402 elt
= AREF (table
, ((i
>> 4) & 0xF));
403 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
404 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
407 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
408 FONTNAME. ENCODING is a charset symbol that specifies the encoding
409 of the font. REPERTORY is a charset symbol or nil. */
412 find_font_encoding (Lisp_Object fontname
)
414 Lisp_Object tail
, elt
;
416 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
420 && STRINGP (XCAR (elt
))
421 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
422 && (SYMBOLP (XCDR (elt
))
423 ? CHARSETP (XCDR (elt
))
424 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
430 /* Return encoding charset and repertory charset for REGISTRY in
431 ENCODING and REPERTORY correspondingly. If correct information for
432 REGISTRY is available, return 0. Otherwise return -1. */
435 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
438 int encoding_id
, repertory_id
;
440 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
446 encoding_id
= XINT (XCAR (val
));
447 repertory_id
= XINT (XCDR (val
));
451 val
= find_font_encoding (SYMBOL_NAME (registry
));
452 if (SYMBOLP (val
) && CHARSETP (val
))
454 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
456 else if (CONSP (val
))
458 if (! CHARSETP (XCAR (val
)))
460 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
461 if (NILP (XCDR (val
)))
465 if (! CHARSETP (XCDR (val
)))
467 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
472 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
474 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
478 *encoding
= CHARSET_FROM_ID (encoding_id
);
480 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
485 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
490 /* Font property value validators. See the comment of
491 font_property_table for the meaning of the arguments. */
493 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
494 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
495 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
496 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
497 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
498 static int get_font_prop_index (Lisp_Object
);
501 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
504 val
= Fintern (val
, Qnil
);
507 else if (EQ (prop
, QCregistry
))
508 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
514 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
516 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
517 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
521 EMACS_INT n
= XINT (val
);
523 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
527 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
529 if ((n
& 0xF) + 1 >= ASIZE (elt
))
531 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
535 else if (SYMBOLP (val
))
537 int n
= font_style_to_value (prop
, val
, 0);
539 val
= n
>= 0 ? make_number (n
) : Qerror
;
547 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
549 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
554 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
556 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
558 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
560 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
562 if (spacing
== 'c' || spacing
== 'C')
563 return make_number (FONT_SPACING_CHARCELL
);
564 if (spacing
== 'm' || spacing
== 'M')
565 return make_number (FONT_SPACING_MONO
);
566 if (spacing
== 'p' || spacing
== 'P')
567 return make_number (FONT_SPACING_PROPORTIONAL
);
568 if (spacing
== 'd' || spacing
== 'D')
569 return make_number (FONT_SPACING_DUAL
);
575 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
577 Lisp_Object tail
, tmp
;
580 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
581 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
582 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
585 if (! SYMBOLP (XCAR (val
)))
590 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
592 for (i
= 0; i
< 2; i
++)
599 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
600 if (! SYMBOLP (XCAR (tmp
)))
608 /* Structure of known font property keys and validator of the
612 /* Pointer to the key symbol. */
614 /* Function to validate PROP's value VAL, or NULL if any value is
615 ok. The value is VAL or its regularized value if VAL is valid,
616 and Qerror if not. */
617 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
618 } font_property_table
[] =
619 { { &QCtype
, font_prop_validate_symbol
},
620 { &QCfoundry
, font_prop_validate_symbol
},
621 { &QCfamily
, font_prop_validate_symbol
},
622 { &QCadstyle
, font_prop_validate_symbol
},
623 { &QCregistry
, font_prop_validate_symbol
},
624 { &QCweight
, font_prop_validate_style
},
625 { &QCslant
, font_prop_validate_style
},
626 { &QCwidth
, font_prop_validate_style
},
627 { &QCsize
, font_prop_validate_non_neg
},
628 { &QCdpi
, font_prop_validate_non_neg
},
629 { &QCspacing
, font_prop_validate_spacing
},
630 { &QCavgwidth
, font_prop_validate_non_neg
},
631 /* The order of the above entries must match with enum
632 font_property_index. */
633 { &QClang
, font_prop_validate_symbol
},
634 { &QCscript
, font_prop_validate_symbol
},
635 { &QCotf
, font_prop_validate_otf
}
638 /* Size (number of elements) of the above table. */
639 #define FONT_PROPERTY_TABLE_SIZE \
640 ((sizeof font_property_table) / (sizeof *font_property_table))
642 /* Return an index number of font property KEY or -1 if KEY is not an
643 already known property. */
646 get_font_prop_index (Lisp_Object key
)
650 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
651 if (EQ (key
, *font_property_table
[i
].key
))
656 /* Validate the font property. The property key is specified by the
657 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
658 signal an error. The value is VAL or the regularized one. */
661 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
663 Lisp_Object validated
;
668 prop
= *font_property_table
[idx
].key
;
671 idx
= get_font_prop_index (prop
);
675 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
676 if (EQ (validated
, Qerror
))
677 signal_error ("invalid font property", Fcons (prop
, val
));
682 /* Store VAL as a value of extra font property PROP in FONT while
683 keeping the sorting order. Don't check the validity of VAL. */
686 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
688 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
689 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
693 Lisp_Object prev
= Qnil
;
696 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
697 prev
= extra
, extra
= XCDR (extra
);
700 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
702 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
708 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
713 /* Font name parser and unparser */
715 static int parse_matrix (const char *);
716 static int font_expand_wildcards (Lisp_Object
*, int);
717 static int font_parse_name (char *, Lisp_Object
);
719 /* An enumerator for each field of an XLFD font name. */
720 enum xlfd_field_index
739 /* An enumerator for mask bit corresponding to each XLFD field. */
742 XLFD_FOUNDRY_MASK
= 0x0001,
743 XLFD_FAMILY_MASK
= 0x0002,
744 XLFD_WEIGHT_MASK
= 0x0004,
745 XLFD_SLANT_MASK
= 0x0008,
746 XLFD_SWIDTH_MASK
= 0x0010,
747 XLFD_ADSTYLE_MASK
= 0x0020,
748 XLFD_PIXEL_MASK
= 0x0040,
749 XLFD_POINT_MASK
= 0x0080,
750 XLFD_RESX_MASK
= 0x0100,
751 XLFD_RESY_MASK
= 0x0200,
752 XLFD_SPACING_MASK
= 0x0400,
753 XLFD_AVGWIDTH_MASK
= 0x0800,
754 XLFD_REGISTRY_MASK
= 0x1000,
755 XLFD_ENCODING_MASK
= 0x2000
759 /* Parse P pointing to the pixel/point size field of the form
760 `[A B C D]' which specifies a transformation matrix:
766 by which all glyphs of the font are transformed. The spec says
767 that scalar value N for the pixel/point size is equivalent to:
768 A = N * resx/resy, B = C = 0, D = N.
770 Return the scalar value N if the form is valid. Otherwise return
774 parse_matrix (const char *p
)
780 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
783 matrix
[i
] = - strtod (p
+ 1, &end
);
785 matrix
[i
] = strtod (p
, &end
);
788 return (i
== 4 ? (int) matrix
[3] : -1);
791 /* Expand a wildcard field in FIELD (the first N fields are filled) to
792 multiple fields to fill in all 14 XLFD fields while restricting a
793 field position by its contents. */
796 font_expand_wildcards (Lisp_Object
*field
, int n
)
799 Lisp_Object tmp
[XLFD_LAST_INDEX
];
800 /* Array of information about where this element can go. Nth
801 element is for Nth element of FIELD. */
803 /* Minimum possible field. */
805 /* Maxinum possible field. */
807 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
809 } range
[XLFD_LAST_INDEX
];
811 int range_from
, range_to
;
814 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
815 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
816 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
817 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
818 | XLFD_AVGWIDTH_MASK)
819 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
821 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
822 field. The value is shifted to left one bit by one in the
824 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
825 range_mask
= (range_mask
<< 1) | 1;
827 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
828 position-based retriction for FIELD[I]. */
829 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
830 i
++, range_from
++, range_to
++, range_mask
<<= 1)
832 Lisp_Object val
= field
[i
];
838 range
[i
].from
= range_from
;
839 range
[i
].to
= range_to
;
840 range
[i
].mask
= range_mask
;
844 /* The triplet FROM, TO, and MASK is a value-based
845 retriction for FIELD[I]. */
851 EMACS_INT numeric
= XINT (val
);
854 from
= to
= XLFD_ENCODING_INDEX
,
855 mask
= XLFD_ENCODING_MASK
;
856 else if (numeric
== 0)
857 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
858 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
859 else if (numeric
<= 48)
860 from
= to
= XLFD_PIXEL_INDEX
,
861 mask
= XLFD_PIXEL_MASK
;
863 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
864 mask
= XLFD_LARGENUM_MASK
;
866 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
867 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
868 mask
= XLFD_NULL_MASK
;
870 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
873 Lisp_Object name
= SYMBOL_NAME (val
);
875 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
876 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
877 mask
= XLFD_REGENC_MASK
;
879 from
= to
= XLFD_ENCODING_INDEX
,
880 mask
= XLFD_ENCODING_MASK
;
882 else if (range_from
<= XLFD_WEIGHT_INDEX
883 && range_to
>= XLFD_WEIGHT_INDEX
884 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
885 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
886 else if (range_from
<= XLFD_SLANT_INDEX
887 && range_to
>= XLFD_SLANT_INDEX
888 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
889 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
890 else if (range_from
<= XLFD_SWIDTH_INDEX
891 && range_to
>= XLFD_SWIDTH_INDEX
892 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
893 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
896 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
897 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
899 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
900 mask
= XLFD_SYMBOL_MASK
;
903 /* Merge position-based and value-based restrictions. */
905 while (from
< range_from
)
906 mask
&= ~(1 << from
++);
907 while (from
< 14 && ! (mask
& (1 << from
)))
909 while (to
> range_to
)
910 mask
&= ~(1 << to
--);
911 while (to
>= 0 && ! (mask
& (1 << to
)))
915 range
[i
].from
= from
;
917 range
[i
].mask
= mask
;
919 if (from
> range_from
|| to
< range_to
)
921 /* The range is narrowed by value-based restrictions.
922 Reflect it to the other fields. */
924 /* Following fields should be after FROM. */
926 /* Preceding fields should be before TO. */
927 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
929 /* Check FROM for non-wildcard field. */
930 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
932 while (range
[j
].from
< from
)
933 range
[j
].mask
&= ~(1 << range
[j
].from
++);
934 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
936 range
[j
].from
= from
;
939 from
= range
[j
].from
;
940 if (range
[j
].to
> to
)
942 while (range
[j
].to
> to
)
943 range
[j
].mask
&= ~(1 << range
[j
].to
--);
944 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
957 /* Decide all fileds from restrictions in RANGE. */
958 for (i
= j
= 0; i
< n
; i
++)
960 if (j
< range
[i
].from
)
962 if (i
== 0 || ! NILP (tmp
[i
- 1]))
963 /* None of TMP[X] corresponds to Jth field. */
965 for (; j
< range
[i
].from
; j
++)
970 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
972 for (; j
< XLFD_LAST_INDEX
; j
++)
974 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
975 field
[XLFD_ENCODING_INDEX
]
976 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
981 /* Parse NAME (null terminated) as XLFD and store information in FONT
982 (font-spec or font-entity). Size property of FONT is set as
984 specified XLFD fields FONT property
985 --------------------- -------------
986 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
987 POINT_SIZE and RESY calculated pixel size (Lisp integer)
988 POINT_SIZE POINT_SIZE/10 (Lisp float)
990 If NAME is successfully parsed, return 0. Otherwise return -1.
992 FONT is usually a font-spec, but when this function is called from
993 X font backend driver, it is a font-entity. In that case, NAME is
994 a fully specified XLFD. */
997 font_parse_xlfd (char *name
, Lisp_Object font
)
999 ptrdiff_t len
= strlen (name
);
1001 char *f
[XLFD_LAST_INDEX
+ 1];
1005 if (len
> 255 || !len
)
1006 /* Maximum XLFD name length is 255. */
1008 /* Accept "*-.." as a fully specified XLFD. */
1009 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1010 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1013 for (p
= name
+ i
; *p
; p
++)
1017 if (i
== XLFD_LAST_INDEX
)
1022 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1023 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1025 if (i
== XLFD_LAST_INDEX
)
1027 /* Fully specified XLFD. */
1030 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1031 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1032 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1033 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1035 val
= INTERN_FIELD_SYM (i
);
1038 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1040 ASET (font
, j
, make_number (n
));
1043 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1044 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1045 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1047 ASET (font
, FONT_REGISTRY_INDEX
,
1048 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1049 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1051 p
= f
[XLFD_PIXEL_INDEX
];
1052 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1053 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1056 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1058 ASET (font
, FONT_SIZE_INDEX
, val
);
1059 else if (FONT_ENTITY_P (font
))
1063 double point_size
= -1;
1065 font_assert (FONT_SPEC_P (font
));
1066 p
= f
[XLFD_POINT_INDEX
];
1068 point_size
= parse_matrix (p
);
1069 else if (isdigit (*p
))
1070 point_size
= atoi (p
), point_size
/= 10;
1071 if (point_size
>= 0)
1072 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1076 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1077 if (! NILP (val
) && ! INTEGERP (val
))
1079 ASET (font
, FONT_DPI_INDEX
, val
);
1080 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1083 val
= font_prop_validate_spacing (QCspacing
, val
);
1084 if (! INTEGERP (val
))
1086 ASET (font
, FONT_SPACING_INDEX
, val
);
1088 p
= f
[XLFD_AVGWIDTH_INDEX
];
1091 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1092 if (! NILP (val
) && ! INTEGERP (val
))
1094 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1098 int wild_card_found
= 0;
1099 Lisp_Object prop
[XLFD_LAST_INDEX
];
1101 if (FONT_ENTITY_P (font
))
1103 for (j
= 0; j
< i
; j
++)
1107 if (f
[j
][1] && f
[j
][1] != '-')
1110 wild_card_found
= 1;
1113 prop
[j
] = INTERN_FIELD (j
);
1115 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1117 if (! wild_card_found
)
1119 if (font_expand_wildcards (prop
, i
) < 0)
1122 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1123 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1124 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1125 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1126 if (! NILP (prop
[i
]))
1128 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1130 ASET (font
, j
, make_number (n
));
1132 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1133 val
= prop
[XLFD_REGISTRY_INDEX
];
1136 val
= prop
[XLFD_ENCODING_INDEX
];
1138 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1140 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1141 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1143 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1144 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1146 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1148 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1149 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1150 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1152 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1154 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1157 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1158 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1159 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1161 val
= font_prop_validate_spacing (QCspacing
,
1162 prop
[XLFD_SPACING_INDEX
]);
1163 if (! INTEGERP (val
))
1165 ASET (font
, FONT_SPACING_INDEX
, val
);
1167 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1168 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1174 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1175 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1176 0, use PIXEL_SIZE instead. */
1179 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1182 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1186 font_assert (FONTP (font
));
1188 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1191 if (i
== FONT_ADSTYLE_INDEX
)
1192 j
= XLFD_ADSTYLE_INDEX
;
1193 else if (i
== FONT_REGISTRY_INDEX
)
1194 j
= XLFD_REGISTRY_INDEX
;
1195 val
= AREF (font
, i
);
1198 if (j
== XLFD_REGISTRY_INDEX
)
1206 val
= SYMBOL_NAME (val
);
1207 if (j
== XLFD_REGISTRY_INDEX
1208 && ! strchr (SSDATA (val
), '-'))
1210 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1211 ptrdiff_t alloc
= SBYTES (val
) + 4;
1212 if (nbytes
<= alloc
)
1214 f
[j
] = p
= alloca (alloc
);
1215 sprintf (p
, "%s%s-*", SDATA (val
),
1216 "*" + (SDATA (val
)[SBYTES (val
) - 1] == '*'));
1219 f
[j
] = SSDATA (val
);
1223 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1226 val
= font_style_symbolic (font
, i
, 0);
1231 val
= SYMBOL_NAME (val
);
1232 f
[j
] = SSDATA (val
);
1236 val
= AREF (font
, FONT_SIZE_INDEX
);
1237 font_assert (NUMBERP (val
) || NILP (val
));
1240 EMACS_INT v
= XINT (val
);
1245 f
[XLFD_PIXEL_INDEX
] = p
=
1246 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1247 sprintf (p
, "%"pI
"d-*", v
);
1250 f
[XLFD_PIXEL_INDEX
] = "*-*";
1252 else if (FLOATP (val
))
1254 double v
= XFLOAT_DATA (val
) * 10;
1255 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1256 sprintf (p
, "*-%.0f", v
);
1259 f
[XLFD_PIXEL_INDEX
] = "*-*";
1261 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1263 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1264 f
[XLFD_RESX_INDEX
] = p
=
1265 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1266 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1269 f
[XLFD_RESX_INDEX
] = "*-*";
1270 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1272 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1274 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1275 : spacing
<= FONT_SPACING_DUAL
? "d"
1276 : spacing
<= FONT_SPACING_MONO
? "m"
1280 f
[XLFD_SPACING_INDEX
] = "*";
1281 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1283 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1284 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1287 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1288 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1289 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1290 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1291 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1292 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1293 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1294 f
[XLFD_REGISTRY_INDEX
]);
1295 return len
< nbytes
? len
: -1;
1298 /* Parse NAME (null terminated) and store information in FONT
1299 (font-spec or font-entity). NAME is supplied in either the
1300 Fontconfig or GTK font name format. If NAME is successfully
1301 parsed, return 0. Otherwise return -1.
1303 The fontconfig format is
1305 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1309 FAMILY [PROPS...] [SIZE]
1311 This function tries to guess which format it is. */
1314 font_parse_fcname (char *name
, Lisp_Object font
)
1317 char *size_beg
= NULL
, *size_end
= NULL
;
1318 char *props_beg
= NULL
, *family_end
= NULL
;
1319 ptrdiff_t len
= strlen (name
);
1324 for (p
= name
; *p
; p
++)
1326 if (*p
== '\\' && p
[1])
1330 props_beg
= family_end
= p
;
1335 int decimal
= 0, size_found
= 1;
1336 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1339 if (*q
!= '.' || decimal
)
1358 Lisp_Object extra_props
= Qnil
;
1360 /* A fontconfig name with size and/or property data. */
1361 if (family_end
> name
)
1364 family
= font_intern_prop (name
, family_end
- name
, 1);
1365 ASET (font
, FONT_FAMILY_INDEX
, family
);
1369 double point_size
= strtod (size_beg
, &size_end
);
1370 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1371 if (*size_end
== ':' && size_end
[1])
1372 props_beg
= size_end
;
1376 /* Now parse ":KEY=VAL" patterns. */
1379 for (p
= props_beg
; *p
; p
= q
)
1381 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1384 /* Must be an enumerated value. */
1388 val
= font_intern_prop (p
, q
- p
, 1);
1390 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1391 && memcmp (p, STR, strlen (STR)) == 0)
1393 if (PROP_MATCH ("light")
1394 || PROP_MATCH ("medium")
1395 || PROP_MATCH ("demibold")
1396 || PROP_MATCH ("bold")
1397 || PROP_MATCH ("black"))
1398 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1399 else if (PROP_MATCH ("roman")
1400 || PROP_MATCH ("italic")
1401 || PROP_MATCH ("oblique"))
1402 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1403 else if (PROP_MATCH ("charcell"))
1404 ASET (font
, FONT_SPACING_INDEX
,
1405 make_number (FONT_SPACING_CHARCELL
));
1406 else if (PROP_MATCH ("mono"))
1407 ASET (font
, FONT_SPACING_INDEX
,
1408 make_number (FONT_SPACING_MONO
));
1409 else if (PROP_MATCH ("proportional"))
1410 ASET (font
, FONT_SPACING_INDEX
,
1411 make_number (FONT_SPACING_PROPORTIONAL
));
1420 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1421 prop
= FONT_SIZE_INDEX
;
1424 key
= font_intern_prop (p
, q
- p
, 1);
1425 prop
= get_font_prop_index (key
);
1429 for (q
= p
; *q
&& *q
!= ':'; q
++);
1430 val
= font_intern_prop (p
, q
- p
, 0);
1432 if (prop
>= FONT_FOUNDRY_INDEX
1433 && prop
< FONT_EXTRA_INDEX
)
1434 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1437 extra_props
= nconc2 (extra_props
,
1438 Fcons (Fcons (key
, val
), Qnil
));
1445 if (! NILP (extra_props
))
1447 struct font_driver_list
*driver_list
= font_driver_list
;
1448 for ( ; driver_list
; driver_list
= driver_list
->next
)
1449 if (driver_list
->driver
->filter_properties
)
1450 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1456 /* Either a fontconfig-style name with no size and property
1457 data, or a GTK-style name. */
1458 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1459 Lisp_Object width
= Qnil
, size
= Qnil
;
1463 /* Scan backwards from the end, looking for a size. */
1464 for (p
= name
+ len
- 1; p
>= name
; p
--)
1468 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1469 /* Found a font size. */
1470 size
= make_float (strtod (p
+ 1, NULL
));
1474 /* Now P points to the termination of the string, sans size.
1475 Scan backwards, looking for font properties. */
1476 for (; p
> name
; p
= q
)
1478 for (q
= p
- 1; q
>= name
; q
--)
1480 if (q
> name
&& *(q
-1) == '\\')
1481 --q
; /* Skip quoting backslashes. */
1487 word_len
= p
- word_start
;
1489 #define PROP_MATCH(STR) \
1490 (word_len == strlen (STR) \
1491 && memcmp (word_start, STR, strlen (STR)) == 0)
1492 #define PROP_SAVE(VAR, STR) \
1493 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1495 if (PROP_MATCH ("Ultra-Light"))
1496 PROP_SAVE (weight
, "ultra-light");
1497 else if (PROP_MATCH ("Light"))
1498 PROP_SAVE (weight
, "light");
1499 else if (PROP_MATCH ("Book"))
1500 PROP_SAVE (weight
, "book");
1501 else if (PROP_MATCH ("Medium"))
1502 PROP_SAVE (weight
, "medium");
1503 else if (PROP_MATCH ("Semi-Bold"))
1504 PROP_SAVE (weight
, "semi-bold");
1505 else if (PROP_MATCH ("Bold"))
1506 PROP_SAVE (weight
, "bold");
1507 else if (PROP_MATCH ("Italic"))
1508 PROP_SAVE (slant
, "italic");
1509 else if (PROP_MATCH ("Oblique"))
1510 PROP_SAVE (slant
, "oblique");
1511 else if (PROP_MATCH ("Semi-Condensed"))
1512 PROP_SAVE (width
, "semi-condensed");
1513 else if (PROP_MATCH ("Condensed"))
1514 PROP_SAVE (width
, "condensed");
1515 /* An unknown word must be part of the font name. */
1526 ASET (font
, FONT_FAMILY_INDEX
,
1527 font_intern_prop (name
, family_end
- name
, 1));
1529 ASET (font
, FONT_SIZE_INDEX
, size
);
1531 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1533 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1535 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1541 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1542 NAME (NBYTES length), and return the name length. If
1543 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1546 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1548 Lisp_Object family
, foundry
;
1554 Lisp_Object styles
[3];
1555 const char *style_names
[3] = { "weight", "slant", "width" };
1557 family
= AREF (font
, FONT_FAMILY_INDEX
);
1558 if (! NILP (family
))
1560 if (SYMBOLP (family
))
1561 family
= SYMBOL_NAME (family
);
1566 val
= AREF (font
, FONT_SIZE_INDEX
);
1569 if (XINT (val
) != 0)
1570 pixel_size
= XINT (val
);
1578 point_size
= (int) XFLOAT_DATA (val
);
1581 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1582 if (! NILP (foundry
))
1584 if (SYMBOLP (foundry
))
1585 foundry
= SYMBOL_NAME (foundry
);
1590 for (i
= 0; i
< 3; i
++)
1591 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1594 lim
= name
+ nbytes
;
1595 if (! NILP (family
))
1597 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1598 if (! (0 <= len
&& len
< lim
- p
))
1604 int len
= snprintf (p
, lim
- p
, "-%d" + (p
== name
), point_size
);
1605 if (! (0 <= len
&& len
< lim
- p
))
1609 else if (pixel_size
> 0)
1611 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1612 if (! (0 <= len
&& len
< lim
- p
))
1616 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1618 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1619 SSDATA (SYMBOL_NAME (AREF (font
,
1620 FONT_FOUNDRY_INDEX
))));
1621 if (! (0 <= len
&& len
< lim
- p
))
1625 for (i
= 0; i
< 3; i
++)
1626 if (! NILP (styles
[i
]))
1628 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1629 SSDATA (SYMBOL_NAME (styles
[i
])));
1630 if (! (0 <= len
&& len
< lim
- p
))
1635 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1637 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1638 XINT (AREF (font
, FONT_DPI_INDEX
)));
1639 if (! (0 <= len
&& len
< lim
- p
))
1644 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1646 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1647 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1648 if (! (0 <= len
&& len
< lim
- p
))
1653 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1655 int len
= snprintf (p
, lim
- p
,
1656 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1658 : ":scalable=false"));
1659 if (! (0 <= len
&& len
< lim
- p
))
1667 /* Parse NAME (null terminated) and store information in FONT
1668 (font-spec or font-entity). If NAME is successfully parsed, return
1669 0. Otherwise return -1. */
1672 font_parse_name (char *name
, Lisp_Object font
)
1674 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1675 return font_parse_xlfd (name
, font
);
1676 return font_parse_fcname (name
, font
);
1680 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1681 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1685 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1691 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1693 CHECK_STRING (family
);
1694 len
= SBYTES (family
);
1695 p0
= SSDATA (family
);
1696 p1
= strchr (p0
, '-');
1699 if ((*p0
!= '*' && p1
- p0
> 0)
1700 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1701 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1704 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1707 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1709 if (! NILP (registry
))
1711 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1712 CHECK_STRING (registry
);
1713 len
= SBYTES (registry
);
1714 p0
= SSDATA (registry
);
1715 p1
= strchr (p0
, '-');
1718 if (SDATA (registry
)[len
- 1] == '*')
1719 registry
= concat2 (registry
, build_string ("-*"));
1721 registry
= concat2 (registry
, build_string ("*-*"));
1723 registry
= Fdowncase (registry
);
1724 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1729 /* This part (through the next ^L) is still experimental and not
1730 tested much. We may drastically change codes. */
1736 #define LGSTRING_HEADER_SIZE 6
1737 #define LGSTRING_GLYPH_SIZE 8
1740 check_gstring (Lisp_Object gstring
)
1746 CHECK_VECTOR (gstring
);
1747 val
= AREF (gstring
, 0);
1749 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1751 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1752 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1753 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1754 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1755 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1756 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1757 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1758 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1759 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1760 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1761 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1763 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1765 val
= LGSTRING_GLYPH (gstring
, i
);
1767 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1769 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1771 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1772 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1773 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1774 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1775 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1776 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1777 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1778 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1780 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1782 if (ASIZE (val
) < 3)
1784 for (j
= 0; j
< 3; j
++)
1785 CHECK_NUMBER (AREF (val
, j
));
1790 error ("Invalid glyph-string format");
1795 check_otf_features (Lisp_Object otf_features
)
1799 CHECK_CONS (otf_features
);
1800 CHECK_SYMBOL (XCAR (otf_features
));
1801 otf_features
= XCDR (otf_features
);
1802 CHECK_CONS (otf_features
);
1803 CHECK_SYMBOL (XCAR (otf_features
));
1804 otf_features
= XCDR (otf_features
);
1805 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1807 CHECK_SYMBOL (Fcar (val
));
1808 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1809 error ("Invalid OTF GSUB feature: %s",
1810 SDATA (SYMBOL_NAME (XCAR (val
))));
1812 otf_features
= XCDR (otf_features
);
1813 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1815 CHECK_SYMBOL (Fcar (val
));
1816 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1817 error ("Invalid OTF GPOS feature: %s",
1818 SDATA (SYMBOL_NAME (XCAR (val
))));
1825 Lisp_Object otf_list
;
1828 otf_tag_symbol (OTF_Tag tag
)
1832 OTF_tag_name (tag
, name
);
1833 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1837 otf_open (Lisp_Object file
)
1839 Lisp_Object val
= Fassoc (file
, otf_list
);
1843 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1846 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1847 val
= make_save_value (otf
, 0);
1848 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1854 /* Return a list describing which scripts/languages FONT supports by
1855 which GSUB/GPOS features of OpenType tables. See the comment of
1856 (struct font_driver).otf_capability. */
1859 font_otf_capability (struct font
*font
)
1862 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1865 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1868 for (i
= 0; i
< 2; i
++)
1870 OTF_GSUB_GPOS
*gsub_gpos
;
1871 Lisp_Object script_list
= Qnil
;
1874 if (OTF_get_features (otf
, i
== 0) < 0)
1876 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1877 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1879 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1880 Lisp_Object langsys_list
= Qnil
;
1881 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1884 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1886 OTF_LangSys
*langsys
;
1887 Lisp_Object feature_list
= Qnil
;
1888 Lisp_Object langsys_tag
;
1891 if (k
== script
->LangSysCount
)
1893 langsys
= &script
->DefaultLangSys
;
1898 langsys
= script
->LangSys
+ k
;
1900 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1902 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1904 OTF_Feature
*feature
1905 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1906 Lisp_Object feature_tag
1907 = otf_tag_symbol (feature
->FeatureTag
);
1909 feature_list
= Fcons (feature_tag
, feature_list
);
1911 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1914 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1919 XSETCAR (capability
, script_list
);
1921 XSETCDR (capability
, script_list
);
1927 /* Parse OTF features in SPEC and write a proper features spec string
1928 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1929 assured that the sufficient memory has already allocated for
1933 generate_otf_features (Lisp_Object spec
, char *features
)
1941 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1947 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1952 else if (! asterisk
)
1954 val
= SYMBOL_NAME (val
);
1955 p
+= esprintf (p
, "%s", SDATA (val
));
1959 val
= SYMBOL_NAME (val
);
1960 p
+= esprintf (p
, "~%s", SDATA (val
));
1964 error ("OTF spec too long");
1968 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1970 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1972 return Fcons (make_number (len
),
1973 make_unibyte_string (device_table
->DeltaValue
, len
));
1977 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
1979 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1981 if (value_format
& OTF_XPlacement
)
1982 ASET (val
, 0, make_number (value_record
->XPlacement
));
1983 if (value_format
& OTF_YPlacement
)
1984 ASET (val
, 1, make_number (value_record
->YPlacement
));
1985 if (value_format
& OTF_XAdvance
)
1986 ASET (val
, 2, make_number (value_record
->XAdvance
));
1987 if (value_format
& OTF_YAdvance
)
1988 ASET (val
, 3, make_number (value_record
->YAdvance
));
1989 if (value_format
& OTF_XPlaDevice
)
1990 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1991 if (value_format
& OTF_YPlaDevice
)
1992 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1993 if (value_format
& OTF_XAdvDevice
)
1994 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1995 if (value_format
& OTF_YAdvDevice
)
1996 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2001 font_otf_Anchor (OTF_Anchor
*anchor
)
2005 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2006 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2007 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2008 if (anchor
->AnchorFormat
== 2)
2009 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2012 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2013 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2017 #endif /* HAVE_LIBOTF */
2023 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2024 static int font_compare (const void *, const void *);
2025 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2029 font_rescale_ratio (Lisp_Object font_entity
)
2031 Lisp_Object tail
, elt
;
2032 Lisp_Object name
= Qnil
;
2034 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2037 if (FLOATP (XCDR (elt
)))
2039 if (STRINGP (XCAR (elt
)))
2042 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2043 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2044 return XFLOAT_DATA (XCDR (elt
));
2046 else if (FONT_SPEC_P (XCAR (elt
)))
2048 if (font_match_p (XCAR (elt
), font_entity
))
2049 return XFLOAT_DATA (XCDR (elt
));
2056 /* We sort fonts by scoring each of them against a specified
2057 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2058 the value is, the closer the font is to the font-spec.
2060 The lowest 2 bits of the score are used for driver type. The font
2061 available by the most preferred font driver is 0.
2063 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2064 WEIGHT, SLANT, WIDTH, and SIZE. */
2066 /* How many bits to shift to store the difference value of each font
2067 property in a score. Note that floats for FONT_TYPE_INDEX and
2068 FONT_REGISTRY_INDEX are not used. */
2069 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2071 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2072 The return value indicates how different ENTITY is compared with
2076 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2081 /* Score three style numeric fields. Maximum difference is 127. */
2082 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2083 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2085 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2086 - (XINT (spec_prop
[i
]) >> 8));
2089 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2092 /* Score the size. Maximum difference is 127. */
2093 i
= FONT_SIZE_INDEX
;
2094 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2095 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2097 /* We use the higher 6-bit for the actual size difference. The
2098 lowest bit is set if the DPI is different. */
2100 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2102 if (CONSP (Vface_font_rescale_alist
))
2103 pixel_size
*= font_rescale_ratio (entity
);
2104 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2108 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2109 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2111 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2112 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2114 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2121 /* Concatenate all elements of LIST into one vector. LIST is a list
2122 of font-entity vectors. */
2125 font_vconcat_entity_vectors (Lisp_Object list
)
2127 int nargs
= XINT (Flength (list
));
2128 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2131 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2132 args
[i
] = XCAR (list
);
2133 return Fvconcat (nargs
, args
);
2137 /* The structure for elements being sorted by qsort. */
2138 struct font_sort_data
2141 int font_driver_preference
;
2146 /* The comparison function for qsort. */
2149 font_compare (const void *d1
, const void *d2
)
2151 const struct font_sort_data
*data1
= d1
;
2152 const struct font_sort_data
*data2
= d2
;
2154 if (data1
->score
< data2
->score
)
2156 else if (data1
->score
> data2
->score
)
2158 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2162 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2163 If PREFER specifies a point-size, calculate the corresponding
2164 pixel-size from QCdpi property of PREFER or from the Y-resolution
2165 of FRAME before sorting.
2167 If BEST-ONLY is nonzero, return the best matching entity (that
2168 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2169 if BEST-ONLY is negative). Otherwise, return the sorted result as
2170 a single vector of font-entities.
2172 This function does no optimization for the case that the total
2173 number of elements is 1. The caller should avoid calling this in
2177 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2179 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2181 struct font_sort_data
*data
;
2182 unsigned best_score
;
2183 Lisp_Object best_entity
;
2184 struct frame
*f
= XFRAME (frame
);
2185 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2188 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2189 prefer_prop
[i
] = AREF (prefer
, i
);
2190 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2191 prefer_prop
[FONT_SIZE_INDEX
]
2192 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2194 if (NILP (XCDR (list
)))
2196 /* What we have to take care of is this single vector. */
2198 maxlen
= ASIZE (vec
);
2202 /* We don't have to perform sort, so there's no need of creating
2203 a single vector. But, we must find the length of the longest
2206 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2207 if (maxlen
< ASIZE (XCAR (tail
)))
2208 maxlen
= ASIZE (XCAR (tail
));
2212 /* We have to create a single vector to sort it. */
2213 vec
= font_vconcat_entity_vectors (list
);
2214 maxlen
= ASIZE (vec
);
2217 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2218 best_score
= 0xFFFFFFFF;
2221 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2223 int font_driver_preference
= 0;
2224 Lisp_Object current_font_driver
;
2230 /* We are sure that the length of VEC > 0. */
2231 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2232 /* Score the elements. */
2233 for (i
= 0; i
< len
; i
++)
2235 data
[i
].entity
= AREF (vec
, i
);
2237 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2239 ? font_score (data
[i
].entity
, prefer_prop
)
2241 if (best_only
&& best_score
> data
[i
].score
)
2243 best_score
= data
[i
].score
;
2244 best_entity
= data
[i
].entity
;
2245 if (best_score
== 0)
2248 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2250 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2251 font_driver_preference
++;
2253 data
[i
].font_driver_preference
= font_driver_preference
;
2256 /* Sort if necessary. */
2259 qsort (data
, len
, sizeof *data
, font_compare
);
2260 for (i
= 0; i
< len
; i
++)
2261 ASET (vec
, i
, data
[i
].entity
);
2270 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2275 /* API of Font Service Layer. */
2277 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2278 sort_shift_bits. Finternal_set_font_selection_order calls this
2279 function with font_sort_order after setting up it. */
2282 font_update_sort_order (int *order
)
2286 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2288 int xlfd_idx
= order
[i
];
2290 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2291 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2292 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2293 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2294 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2295 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2297 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2302 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2307 table
= assq_no_quit (script
, table
);
2310 table
= XCDR (table
);
2311 if (! NILP (langsys
))
2313 table
= assq_no_quit (langsys
, table
);
2319 val
= assq_no_quit (Qnil
, table
);
2321 table
= XCAR (table
);
2325 table
= XCDR (table
);
2326 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2328 if (NILP (XCAR (features
)))
2333 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2339 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2342 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2344 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2346 script
= XCAR (spec
);
2350 langsys
= XCAR (spec
);
2361 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2362 XCAR (otf_capability
)))
2364 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2365 XCDR (otf_capability
)))
2372 /* Check if FONT (font-entity or font-object) matches with the font
2373 specification SPEC. */
2376 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2378 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2379 Lisp_Object extra
, font_extra
;
2382 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2383 if (! NILP (AREF (spec
, i
))
2384 && ! NILP (AREF (font
, i
))
2385 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2387 props
= XFONT_SPEC (spec
)->props
;
2388 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2390 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2391 prop
[i
] = AREF (spec
, i
);
2392 prop
[FONT_SIZE_INDEX
]
2393 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2397 if (font_score (font
, props
) > 0)
2399 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2400 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2401 for (; CONSP (extra
); extra
= XCDR (extra
))
2403 Lisp_Object key
= XCAR (XCAR (extra
));
2404 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2406 if (EQ (key
, QClang
))
2408 val2
= assq_no_quit (key
, font_extra
);
2417 if (NILP (Fmemq (val
, val2
)))
2422 ? NILP (Fmemq (val
, XCDR (val2
)))
2426 else if (EQ (key
, QCscript
))
2428 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2434 /* All characters in the list must be supported. */
2435 for (; CONSP (val2
); val2
= XCDR (val2
))
2437 if (! CHARACTERP (XCAR (val2
)))
2439 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2440 == FONT_INVALID_CODE
)
2444 else if (VECTORP (val2
))
2446 /* At most one character in the vector must be supported. */
2447 for (i
= 0; i
< ASIZE (val2
); i
++)
2449 if (! CHARACTERP (AREF (val2
, i
)))
2451 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2452 != FONT_INVALID_CODE
)
2455 if (i
== ASIZE (val2
))
2460 else if (EQ (key
, QCotf
))
2464 if (! FONT_OBJECT_P (font
))
2466 fontp
= XFONT_OBJECT (font
);
2467 if (! fontp
->driver
->otf_capability
)
2469 val2
= fontp
->driver
->otf_capability (fontp
);
2470 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2481 Each font backend has the callback function get_cache, and it
2482 returns a cons cell of which cdr part can be freely used for
2483 caching fonts. The cons cell may be shared by multiple frames
2484 and/or multiple font drivers. So, we arrange the cdr part as this:
2486 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2488 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2489 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2490 cons (FONT-SPEC FONT-ENTITY ...). */
2492 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2493 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2494 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2495 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2496 struct font_driver
*);
2499 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2501 Lisp_Object cache
, val
;
2503 cache
= driver
->get_cache (f
);
2505 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2509 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2510 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2514 val
= XCDR (XCAR (val
));
2515 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2521 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2523 Lisp_Object cache
, val
, tmp
;
2526 cache
= driver
->get_cache (f
);
2528 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2529 cache
= val
, val
= XCDR (val
);
2530 font_assert (! NILP (val
));
2531 tmp
= XCDR (XCAR (val
));
2532 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2533 if (XINT (XCAR (tmp
)) == 0)
2535 font_clear_cache (f
, XCAR (val
), driver
);
2536 XSETCDR (cache
, XCDR (val
));
2542 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2544 Lisp_Object val
= driver
->get_cache (f
);
2545 Lisp_Object type
= driver
->type
;
2547 font_assert (CONSP (val
));
2548 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2549 font_assert (CONSP (val
));
2550 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2551 val
= XCDR (XCAR (val
));
2555 static int num_fonts
;
2558 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2560 Lisp_Object tail
, elt
;
2561 Lisp_Object tail2
, entity
;
2563 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2564 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2567 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2568 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2570 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2572 entity
= XCAR (tail2
);
2574 if (FONT_ENTITY_P (entity
)
2575 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2577 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2579 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2581 Lisp_Object val
= XCAR (objlist
);
2582 struct font
*font
= XFONT_OBJECT (val
);
2584 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2586 font_assert (font
&& driver
== font
->driver
);
2587 driver
->close (f
, font
);
2591 if (driver
->free_entity
)
2592 driver
->free_entity (entity
);
2597 XSETCDR (cache
, Qnil
);
2601 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2603 /* Check each font-entity in VEC, and return a list of font-entities
2604 that satisfy these conditions:
2605 (1) matches with SPEC and SIZE if SPEC is not nil, and
2606 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2610 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2612 Lisp_Object entity
, val
;
2613 enum font_property_index prop
;
2616 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2618 entity
= AREF (vec
, i
);
2619 if (! NILP (Vface_ignored_fonts
))
2622 Lisp_Object tail
, regexp
;
2624 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2626 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2628 regexp
= XCAR (tail
);
2629 if (STRINGP (regexp
)
2630 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2639 val
= Fcons (entity
, val
);
2642 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2643 if (INTEGERP (AREF (spec
, prop
))
2644 && ((XINT (AREF (spec
, prop
)) >> 8)
2645 != (XINT (AREF (entity
, prop
)) >> 8)))
2646 prop
= FONT_SPEC_MAX
;
2647 if (prop
< FONT_SPEC_MAX
2649 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2651 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2654 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2655 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2656 prop
= FONT_SPEC_MAX
;
2658 if (prop
< FONT_SPEC_MAX
2659 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2660 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2661 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2662 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2663 prop
= FONT_SPEC_MAX
;
2664 if (prop
< FONT_SPEC_MAX
2665 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2666 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2667 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2668 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2669 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2670 prop
= FONT_SPEC_MAX
;
2671 if (prop
< FONT_SPEC_MAX
)
2672 val
= Fcons (entity
, val
);
2674 return (Fvconcat (1, &val
));
2678 /* Return a list of vectors of font-entities matching with SPEC on
2679 FRAME. Each elements in the list is a vector of entities from the
2680 same font-driver. */
2683 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2685 FRAME_PTR f
= XFRAME (frame
);
2686 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2687 Lisp_Object ftype
, val
;
2688 Lisp_Object list
= Qnil
;
2690 int need_filtering
= 0;
2693 font_assert (FONT_SPEC_P (spec
));
2695 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2696 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2697 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2698 size
= font_pixel_size (f
, spec
);
2702 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2703 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2704 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2705 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2706 if (i
!= FONT_SPACING_INDEX
)
2708 ASET (scratch_font_spec
, i
, Qnil
);
2709 if (! NILP (AREF (spec
, i
)))
2712 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2713 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2715 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2717 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2719 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2721 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2722 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2729 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2733 val
= Fvconcat (1, &val
);
2734 copy
= copy_font_spec (scratch_font_spec
);
2735 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2736 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2740 || ! NILP (Vface_ignored_fonts
)))
2741 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2742 if (ASIZE (val
) > 0)
2743 list
= Fcons (val
, list
);
2746 list
= Fnreverse (list
);
2747 FONT_ADD_LOG ("list", spec
, list
);
2752 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2753 nil, is an array of face's attributes, which specifies preferred
2754 font-related attributes. */
2757 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2759 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2760 Lisp_Object ftype
, size
, entity
;
2762 Lisp_Object work
= copy_font_spec (spec
);
2764 XSETFRAME (frame
, f
);
2765 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2766 size
= AREF (spec
, FONT_SIZE_INDEX
);
2769 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2770 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2771 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2772 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2775 for (; driver_list
; driver_list
= driver_list
->next
)
2777 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2779 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2782 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2783 entity
= assoc_no_quit (work
, XCDR (cache
));
2785 entity
= XCDR (entity
);
2788 entity
= driver_list
->driver
->match (frame
, work
);
2789 copy
= copy_font_spec (work
);
2790 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2791 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2793 if (! NILP (entity
))
2796 FONT_ADD_LOG ("match", work
, entity
);
2801 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2802 opened font object. */
2805 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2807 struct font_driver_list
*driver_list
;
2808 Lisp_Object objlist
, size
, val
, font_object
;
2810 int min_width
, height
;
2811 int scaled_pixel_size
= pixel_size
;
2813 font_assert (FONT_ENTITY_P (entity
));
2814 size
= AREF (entity
, FONT_SIZE_INDEX
);
2815 if (XINT (size
) != 0)
2816 scaled_pixel_size
= pixel_size
= XINT (size
);
2817 else if (CONSP (Vface_font_rescale_alist
))
2818 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2820 val
= AREF (entity
, FONT_TYPE_INDEX
);
2821 for (driver_list
= f
->font_driver_list
;
2822 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2823 driver_list
= driver_list
->next
);
2827 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2828 objlist
= XCDR (objlist
))
2830 Lisp_Object fn
= XCAR (objlist
);
2831 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2832 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2834 if (driver_list
->driver
->cached_font_ok
== NULL
2835 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2840 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2841 if (!NILP (font_object
))
2842 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2843 FONT_ADD_LOG ("open", entity
, font_object
);
2844 if (NILP (font_object
))
2846 ASET (entity
, FONT_OBJLIST_INDEX
,
2847 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2850 font
= XFONT_OBJECT (font_object
);
2851 min_width
= (font
->min_width
? font
->min_width
2852 : font
->average_width
? font
->average_width
2853 : font
->space_width
? font
->space_width
2855 height
= (font
->height
? font
->height
: 1);
2856 #ifdef HAVE_WINDOW_SYSTEM
2857 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2858 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2860 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2861 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2862 fonts_changed_p
= 1;
2866 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2867 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2868 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2869 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2877 /* Close FONT_OBJECT that is opened on frame F. */
2880 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2882 struct font
*font
= XFONT_OBJECT (font_object
);
2884 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2885 /* Already closed. */
2887 FONT_ADD_LOG ("close", font_object
, Qnil
);
2888 font
->driver
->close (f
, font
);
2889 #ifdef HAVE_WINDOW_SYSTEM
2890 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2891 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2897 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2898 FONT is a font-entity and it must be opened to check. */
2901 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2905 if (FONT_ENTITY_P (font
))
2907 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2908 struct font_driver_list
*driver_list
;
2910 for (driver_list
= f
->font_driver_list
;
2911 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2912 driver_list
= driver_list
->next
);
2915 if (! driver_list
->driver
->has_char
)
2917 return driver_list
->driver
->has_char (font
, c
);
2920 font_assert (FONT_OBJECT_P (font
));
2921 fontp
= XFONT_OBJECT (font
);
2922 if (fontp
->driver
->has_char
)
2924 int result
= fontp
->driver
->has_char (font
, c
);
2929 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2933 /* Return the glyph ID of FONT_OBJECT for character C. */
2936 font_encode_char (Lisp_Object font_object
, int c
)
2940 font_assert (FONT_OBJECT_P (font_object
));
2941 font
= XFONT_OBJECT (font_object
);
2942 return font
->driver
->encode_char (font
, c
);
2946 /* Return the name of FONT_OBJECT. */
2949 font_get_name (Lisp_Object font_object
)
2951 font_assert (FONT_OBJECT_P (font_object
));
2952 return AREF (font_object
, FONT_NAME_INDEX
);
2956 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2957 could not be parsed by font_parse_name, return Qnil. */
2960 font_spec_from_name (Lisp_Object font_name
)
2962 Lisp_Object spec
= Ffont_spec (0, NULL
);
2964 CHECK_STRING (font_name
);
2965 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2967 font_put_extra (spec
, QCname
, font_name
);
2968 font_put_extra (spec
, QCuser_spec
, font_name
);
2974 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2976 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2981 if (! NILP (Ffont_get (font
, QCname
)))
2983 font
= copy_font_spec (font
);
2984 font_put_extra (font
, QCname
, Qnil
);
2987 if (NILP (AREF (font
, prop
))
2988 && prop
!= FONT_FAMILY_INDEX
2989 && prop
!= FONT_FOUNDRY_INDEX
2990 && prop
!= FONT_WIDTH_INDEX
2991 && prop
!= FONT_SIZE_INDEX
)
2993 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
2994 font
= copy_font_spec (font
);
2995 ASET (font
, prop
, Qnil
);
2996 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2998 if (prop
== FONT_FAMILY_INDEX
)
3000 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3001 /* If we are setting the font family, we must also clear
3002 FONT_WIDTH_INDEX to avoid rejecting families that lack
3003 support for some widths. */
3004 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3006 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3007 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3008 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3009 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3010 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3011 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3013 else if (prop
== FONT_SIZE_INDEX
)
3015 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3016 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3017 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3019 else if (prop
== FONT_WIDTH_INDEX
)
3020 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3021 attrs
[LFACE_FONT_INDEX
] = font
;
3024 /* Select a font from ENTITIES (list of font-entity vectors) that
3025 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3028 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3030 Lisp_Object font_entity
;
3033 FRAME_PTR f
= XFRAME (frame
);
3035 if (NILP (XCDR (entities
))
3036 && ASIZE (XCAR (entities
)) == 1)
3038 font_entity
= AREF (XCAR (entities
), 0);
3040 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3045 /* Sort fonts by properties specified in ATTRS. */
3046 prefer
= scratch_font_prefer
;
3048 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3049 ASET (prefer
, i
, Qnil
);
3050 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3052 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3054 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3055 ASET (prefer
, i
, AREF (face_font
, i
));
3057 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3058 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3059 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3060 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3061 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3062 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3063 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3065 return font_sort_entities (entities
, prefer
, frame
, c
);
3068 /* Return a font-entity that satisfies SPEC and is the best match for
3069 face's font related attributes in ATTRS. C, if not negative, is a
3070 character that the entity must support. */
3073 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3076 Lisp_Object frame
, entities
, val
;
3077 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3082 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3083 if (NILP (registry
[0]))
3085 registry
[0] = DEFAULT_ENCODING
;
3086 registry
[1] = Qascii_0
;
3087 registry
[2] = null_vector
;
3090 registry
[1] = null_vector
;
3092 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3094 struct charset
*encoding
, *repertory
;
3096 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3097 &encoding
, &repertory
) < 0)
3100 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3102 else if (c
> encoding
->max_char
)
3106 work
= copy_font_spec (spec
);
3107 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3108 XSETFRAME (frame
, f
);
3109 pixel_size
= font_pixel_size (f
, spec
);
3110 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3112 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3114 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3116 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3117 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3118 if (! NILP (foundry
[0]))
3119 foundry
[1] = null_vector
;
3120 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3122 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3123 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3125 foundry
[2] = null_vector
;
3128 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3130 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3131 if (! NILP (adstyle
[0]))
3132 adstyle
[1] = null_vector
;
3133 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3135 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3137 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3139 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3141 adstyle
[2] = null_vector
;
3144 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3147 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3150 val
= AREF (work
, FONT_FAMILY_INDEX
);
3151 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3153 val
= attrs
[LFACE_FAMILY_INDEX
];
3154 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3158 family
= alloca ((sizeof family
[0]) * 2);
3160 family
[1] = null_vector
; /* terminator. */
3165 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3166 /* Font family names are case-sensitive under NS. */
3174 if (! NILP (alters
))
3176 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3177 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3178 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3179 family
[i
] = XCAR (alters
);
3180 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3182 family
[i
] = null_vector
;
3186 family
= alloca ((sizeof family
[0]) * 3);
3189 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3191 family
[i
] = null_vector
;
3195 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3197 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3198 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3200 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3201 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3203 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3204 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3206 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3207 entities
= font_list_entities (frame
, work
);
3208 if (! NILP (entities
))
3210 val
= font_select_entity (frame
, entities
,
3211 attrs
, pixel_size
, c
);
3226 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3230 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3231 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3232 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3233 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3234 size
= font_pixel_size (f
, spec
);
3238 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3239 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3242 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3243 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3244 if (INTEGERP (height
))
3247 abort (); /* We should never end up here. */
3251 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3255 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3256 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3260 return font_open_entity (f
, entity
, size
);
3264 /* Find a font that satisfies SPEC and is the best match for
3265 face's attributes in ATTRS on FRAME, and return the opened
3269 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3271 Lisp_Object entity
, name
;
3273 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3276 /* No font is listed for SPEC, but each font-backend may have
3277 different criteria about "font matching". So, try it. */
3278 entity
= font_matching_entity (f
, attrs
, spec
);
3282 /* Don't lose the original name that was put in initially. We need
3283 it to re-apply the font when font parameters (like hinting or dpi) have
3285 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3288 name
= Ffont_get (spec
, QCuser_spec
);
3289 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3295 /* Make FACE on frame F ready to use the font opened for FACE. */
3298 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3300 if (face
->font
->driver
->prepare_face
)
3301 face
->font
->driver
->prepare_face (f
, face
);
3305 /* Make FACE on frame F stop using the font opened for FACE. */
3308 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3310 if (face
->font
->driver
->done_face
)
3311 face
->font
->driver
->done_face (f
, face
);
3316 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3317 font is found, return Qnil. */
3320 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3322 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3324 /* We set up the default font-related attributes of a face to prefer
3326 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3327 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3328 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3330 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3332 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3334 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3336 return font_load_for_lface (f
, attrs
, spec
);
3340 /* Open a font that matches NAME on frame F. If no proper font is
3341 found, return Qnil. */
3344 font_open_by_name (FRAME_PTR f
, const char *name
)
3346 Lisp_Object args
[2];
3347 Lisp_Object spec
, ret
;
3350 args
[1] = make_unibyte_string (name
, strlen (name
));
3351 spec
= Ffont_spec (2, args
);
3352 ret
= font_open_by_spec (f
, spec
);
3353 /* Do not lose name originally put in. */
3355 font_put_extra (ret
, QCuser_spec
, args
[1]);
3361 /* Register font-driver DRIVER. This function is used in two ways.
3363 The first is with frame F non-NULL. In this case, make DRIVER
3364 available (but not yet activated) on F. All frame creators
3365 (e.g. Fx_create_frame) must call this function at least once with
3366 an available font-driver.
3368 The second is with frame F NULL. In this case, DRIVER is globally
3369 registered in the variable `font_driver_list'. All font-driver
3370 implementations must call this function in its syms_of_XXXX
3371 (e.g. syms_of_xfont). */
3374 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3376 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3377 struct font_driver_list
*prev
, *list
;
3379 if (f
&& ! driver
->draw
)
3380 error ("Unusable font driver for a frame: %s",
3381 SDATA (SYMBOL_NAME (driver
->type
)));
3383 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3384 if (EQ (list
->driver
->type
, driver
->type
))
3385 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3387 list
= xmalloc (sizeof (struct font_driver_list
));
3389 list
->driver
= driver
;
3394 f
->font_driver_list
= list
;
3396 font_driver_list
= list
;
3402 free_font_driver_list (FRAME_PTR f
)
3404 struct font_driver_list
*list
, *next
;
3406 for (list
= f
->font_driver_list
; list
; list
= next
)
3411 f
->font_driver_list
= NULL
;
3415 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3416 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3417 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3419 A caller must free all realized faces if any in advance. The
3420 return value is a list of font backends actually made used on
3424 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3426 Lisp_Object active_drivers
= Qnil
;
3427 struct font_driver_list
*list
;
3429 /* At first, turn off non-requested drivers, and turn on requested
3431 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3433 struct font_driver
*driver
= list
->driver
;
3434 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3439 if (driver
->end_for_frame
)
3440 driver
->end_for_frame (f
);
3441 font_finish_cache (f
, driver
);
3446 if (! driver
->start_for_frame
3447 || driver
->start_for_frame (f
) == 0)
3449 font_prepare_cache (f
, driver
);
3456 if (NILP (new_drivers
))
3459 if (! EQ (new_drivers
, Qt
))
3461 /* Re-order the driver list according to new_drivers. */
3462 struct font_driver_list
**list_table
, **next
;
3466 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3467 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3469 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3470 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3473 list_table
[i
++] = list
;
3475 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3477 list_table
[i
++] = list
;
3478 list_table
[i
] = NULL
;
3480 next
= &f
->font_driver_list
;
3481 for (i
= 0; list_table
[i
]; i
++)
3483 *next
= list_table
[i
];
3484 next
= &(*next
)->next
;
3488 if (! f
->font_driver_list
->on
)
3489 { /* None of the drivers is enabled: enable them all.
3490 Happens if you set the list of drivers to (xft x) in your .emacs
3491 and then use it under w32 or ns. */
3492 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3494 struct font_driver
*driver
= list
->driver
;
3495 eassert (! list
->on
);
3496 if (! driver
->start_for_frame
3497 || driver
->start_for_frame (f
) == 0)
3499 font_prepare_cache (f
, driver
);
3506 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3508 active_drivers
= nconc2 (active_drivers
,
3509 Fcons (list
->driver
->type
, Qnil
));
3510 return active_drivers
;
3514 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3516 struct font_data_list
*list
, *prev
;
3518 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3519 prev
= list
, list
= list
->next
)
3520 if (list
->driver
== driver
)
3527 prev
->next
= list
->next
;
3529 f
->font_data_list
= list
->next
;
3537 list
= xmalloc (sizeof (struct font_data_list
));
3538 list
->driver
= driver
;
3539 list
->next
= f
->font_data_list
;
3540 f
->font_data_list
= list
;
3548 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3550 struct font_data_list
*list
;
3552 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3553 if (list
->driver
== driver
)
3561 /* Sets attributes on a font. Any properties that appear in ALIST and
3562 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3563 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3564 arrays of strings. This function is intended for use by the font
3565 drivers to implement their specific font_filter_properties. */
3567 font_filter_properties (Lisp_Object font
,
3569 const char *const boolean_properties
[],
3570 const char *const non_boolean_properties
[])
3575 /* Set boolean values to Qt or Qnil */
3576 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3577 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3579 Lisp_Object key
= XCAR (XCAR (it
));
3580 Lisp_Object val
= XCDR (XCAR (it
));
3581 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3583 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3585 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3586 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3589 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3590 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3591 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3592 || strcmp ("Off", str
) == 0)
3597 Ffont_put (font
, key
, val
);
3601 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3602 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3604 Lisp_Object key
= XCAR (XCAR (it
));
3605 Lisp_Object val
= XCDR (XCAR (it
));
3606 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3607 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3608 Ffont_put (font
, key
, val
);
3613 /* Return the font used to draw character C by FACE at buffer position
3614 POS in window W. If STRING is non-nil, it is a string containing C
3615 at index POS. If C is negative, get C from the current buffer or
3619 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3624 Lisp_Object font_object
;
3626 multibyte
= (NILP (string
)
3627 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3628 : STRING_MULTIBYTE (string
));
3635 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3637 c
= FETCH_CHAR (pos_byte
);
3640 c
= FETCH_BYTE (pos
);
3646 multibyte
= STRING_MULTIBYTE (string
);
3649 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3651 str
= SDATA (string
) + pos_byte
;
3652 c
= STRING_CHAR (str
);
3655 c
= SDATA (string
)[pos
];
3659 f
= XFRAME (w
->frame
);
3660 if (! FRAME_WINDOW_P (f
))
3667 if (STRINGP (string
))
3668 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3669 DEFAULT_FACE_ID
, 0);
3671 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3673 face
= FACE_FROM_ID (f
, face_id
);
3677 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3678 face
= FACE_FROM_ID (f
, face_id
);
3683 XSETFONT (font_object
, face
->font
);
3688 #ifdef HAVE_WINDOW_SYSTEM
3690 /* Check how many characters after POS (at most to *LIMIT) can be
3691 displayed by the same font in the window W. FACE, if non-NULL, is
3692 the face selected for the character at POS. If STRING is not nil,
3693 it is the string to check instead of the current buffer. In that
3694 case, FACE must be not NULL.
3696 The return value is the font-object for the character at POS.
3697 *LIMIT is set to the position where that font can't be used.
3699 It is assured that the current buffer (or STRING) is multibyte. */
3702 font_range (ptrdiff_t pos
, ptrdiff_t *limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3704 ptrdiff_t pos_byte
, ignore
;
3706 Lisp_Object font_object
= Qnil
;
3710 pos_byte
= CHAR_TO_BYTE (pos
);
3715 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3717 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3723 pos_byte
= string_char_to_byte (string
, pos
);
3726 while (pos
< *limit
)
3728 Lisp_Object category
;
3731 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3733 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3734 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3735 if (INTEGERP (category
)
3736 && (XINT (category
) == UNICODE_CATEGORY_Cf
3737 || CHAR_VARIATION_SELECTOR_P (c
)))
3739 if (NILP (font_object
))
3741 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3742 if (NILP (font_object
))
3746 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3756 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3757 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3758 Return nil otherwise.
3759 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3760 which kind of font it is. It must be one of `font-spec', `font-entity',
3762 (Lisp_Object object
, Lisp_Object extra_type
)
3764 if (NILP (extra_type
))
3765 return (FONTP (object
) ? Qt
: Qnil
);
3766 if (EQ (extra_type
, Qfont_spec
))
3767 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3768 if (EQ (extra_type
, Qfont_entity
))
3769 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3770 if (EQ (extra_type
, Qfont_object
))
3771 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3772 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3775 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3776 doc
: /* Return a newly created font-spec with arguments as properties.
3778 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3779 valid font property name listed below:
3781 `:family', `:weight', `:slant', `:width'
3783 They are the same as face attributes of the same name. See
3784 `set-face-attribute'.
3788 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3792 VALUE must be a string or a symbol specifying the additional
3793 typographic style information of a font, e.g. ``sans''.
3797 VALUE must be a string or a symbol specifying the charset registry and
3798 encoding of a font, e.g. ``iso8859-1''.
3802 VALUE must be a non-negative integer or a floating point number
3803 specifying the font size. It specifies the font size in pixels (if
3804 VALUE is an integer), or in points (if VALUE is a float).
3808 VALUE must be a string of XLFD-style or fontconfig-style font name.
3812 VALUE must be a symbol representing a script that the font must
3813 support. It may be a symbol representing a subgroup of a script
3814 listed in the variable `script-representative-chars'.
3818 VALUE must be a symbol of two-letter ISO-639 language names,
3823 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3824 required OpenType features.
3826 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3827 LANGSYS-TAG: OpenType language system tag symbol,
3828 or nil for the default language system.
3829 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3830 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3832 GSUB and GPOS may contain `nil' element. In such a case, the font
3833 must not have any of the remaining elements.
3835 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3836 be an OpenType font whose GPOS table of `thai' script's default
3837 language system must contain `mark' feature.
3839 usage: (font-spec ARGS...) */)
3840 (ptrdiff_t nargs
, Lisp_Object
*args
)
3842 Lisp_Object spec
= font_make_spec ();
3845 for (i
= 0; i
< nargs
; i
+= 2)
3847 Lisp_Object key
= args
[i
], val
;
3851 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3854 if (EQ (key
, QCname
))
3857 font_parse_name (SSDATA (val
), spec
);
3858 font_put_extra (spec
, key
, val
);
3862 int idx
= get_font_prop_index (key
);
3866 val
= font_prop_validate (idx
, Qnil
, val
);
3867 if (idx
< FONT_EXTRA_INDEX
)
3868 ASET (spec
, idx
, val
);
3870 font_put_extra (spec
, key
, val
);
3873 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3879 /* Return a copy of FONT as a font-spec. */
3881 copy_font_spec (Lisp_Object font
)
3883 Lisp_Object new_spec
, tail
, prev
, extra
;
3887 new_spec
= font_make_spec ();
3888 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3889 ASET (new_spec
, i
, AREF (font
, i
));
3890 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3891 /* We must remove :font-entity property. */
3892 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3893 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3896 extra
= XCDR (extra
);
3898 XSETCDR (prev
, XCDR (tail
));
3901 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3905 /* Merge font-specs FROM and TO, and return a new font-spec.
3906 Every specified property in FROM overrides the corresponding
3909 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3911 Lisp_Object extra
, tail
;
3916 to
= copy_font_spec (to
);
3917 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3918 ASET (to
, i
, AREF (from
, i
));
3919 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3920 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3921 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3923 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3926 XSETCDR (slot
, XCDR (XCAR (tail
)));
3928 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3930 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3934 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3935 doc
: /* Return the value of FONT's property KEY.
3936 FONT is a font-spec, a font-entity, or a font-object.
3937 KEY is any symbol, but these are reserved for specific meanings:
3938 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3939 :size, :name, :script, :otf
3940 See the documentation of `font-spec' for their meanings.
3941 In addition, if FONT is a font-entity or a font-object, values of
3942 :script and :otf are different from those of a font-spec as below:
3944 The value of :script may be a list of scripts that are supported by the font.
3946 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3947 representing the OpenType features supported by the font by this form:
3948 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3949 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3951 (Lisp_Object font
, Lisp_Object key
)
3959 idx
= get_font_prop_index (key
);
3960 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3961 return font_style_symbolic (font
, idx
, 0);
3962 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3963 return AREF (font
, idx
);
3964 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3965 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3967 struct font
*fontp
= XFONT_OBJECT (font
);
3969 if (fontp
->driver
->otf_capability
)
3970 val
= fontp
->driver
->otf_capability (fontp
);
3972 val
= Fcons (Qnil
, Qnil
);
3979 #ifdef HAVE_WINDOW_SYSTEM
3981 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3982 doc
: /* Return a plist of face attributes generated by FONT.
3983 FONT is a font name, a font-spec, a font-entity, or a font-object.
3984 The return value is a list of the form
3986 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3988 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3989 compatible with `set-face-attribute'. Some of these key-attribute pairs
3990 may be omitted from the list if they are not specified by FONT.
3992 The optional argument FRAME specifies the frame that the face attributes
3993 are to be displayed on. If omitted, the selected frame is used. */)
3994 (Lisp_Object font
, Lisp_Object frame
)
3997 Lisp_Object plist
[10];
4002 frame
= selected_frame
;
4003 CHECK_LIVE_FRAME (frame
);
4008 int fontset
= fs_query_fontset (font
, 0);
4009 Lisp_Object name
= font
;
4011 font
= fontset_ascii (fontset
);
4012 font
= font_spec_from_name (name
);
4014 signal_error ("Invalid font name", name
);
4016 else if (! FONTP (font
))
4017 signal_error ("Invalid font object", font
);
4019 val
= AREF (font
, FONT_FAMILY_INDEX
);
4022 plist
[n
++] = QCfamily
;
4023 plist
[n
++] = SYMBOL_NAME (val
);
4026 val
= AREF (font
, FONT_SIZE_INDEX
);
4029 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4030 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4031 plist
[n
++] = QCheight
;
4032 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4034 else if (FLOATP (val
))
4036 plist
[n
++] = QCheight
;
4037 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4040 val
= FONT_WEIGHT_FOR_FACE (font
);
4043 plist
[n
++] = QCweight
;
4047 val
= FONT_SLANT_FOR_FACE (font
);
4050 plist
[n
++] = QCslant
;
4054 val
= FONT_WIDTH_FOR_FACE (font
);
4057 plist
[n
++] = QCwidth
;
4061 return Flist (n
, plist
);
4066 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4067 doc
: /* Set one property of FONT: give property KEY value VAL.
4068 FONT is a font-spec, a font-entity, or a font-object.
4070 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4071 accepted by the function `font-spec' (which see), VAL must be what
4072 allowed in `font-spec'.
4074 If FONT is a font-entity or a font-object, KEY must not be the one
4075 accepted by `font-spec'. */)
4076 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4080 idx
= get_font_prop_index (prop
);
4081 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4083 CHECK_FONT_SPEC (font
);
4084 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4088 if (EQ (prop
, QCname
)
4089 || EQ (prop
, QCscript
)
4090 || EQ (prop
, QClang
)
4091 || EQ (prop
, QCotf
))
4092 CHECK_FONT_SPEC (font
);
4095 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4100 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4101 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4102 Optional 2nd argument FRAME specifies the target frame.
4103 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4104 Optional 4th argument PREFER, if non-nil, is a font-spec to
4105 control the order of the returned list. Fonts are sorted by
4106 how close they are to PREFER. */)
4107 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4109 Lisp_Object vec
, list
;
4113 frame
= selected_frame
;
4114 CHECK_LIVE_FRAME (frame
);
4115 CHECK_FONT_SPEC (font_spec
);
4123 if (! NILP (prefer
))
4124 CHECK_FONT_SPEC (prefer
);
4126 list
= font_list_entities (frame
, font_spec
);
4129 if (NILP (XCDR (list
))
4130 && ASIZE (XCAR (list
)) == 1)
4131 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4133 if (! NILP (prefer
))
4134 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4136 vec
= font_vconcat_entity_vectors (list
);
4137 if (n
== 0 || n
>= ASIZE (vec
))
4139 Lisp_Object args
[2];
4143 list
= Fappend (2, args
);
4147 for (list
= Qnil
, n
--; n
>= 0; n
--)
4148 list
= Fcons (AREF (vec
, n
), list
);
4153 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4154 doc
: /* List available font families on the current frame.
4155 Optional argument FRAME, if non-nil, specifies the target frame. */)
4159 struct font_driver_list
*driver_list
;
4163 frame
= selected_frame
;
4164 CHECK_LIVE_FRAME (frame
);
4167 for (driver_list
= f
->font_driver_list
; driver_list
;
4168 driver_list
= driver_list
->next
)
4169 if (driver_list
->driver
->list_family
)
4171 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4172 Lisp_Object tail
= list
;
4174 for (; CONSP (val
); val
= XCDR (val
))
4175 if (NILP (Fmemq (XCAR (val
), tail
))
4176 && SYMBOLP (XCAR (val
)))
4177 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4182 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4183 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4184 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4185 (Lisp_Object font_spec
, Lisp_Object frame
)
4187 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4194 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4195 doc
: /* Return XLFD name of FONT.
4196 FONT is a font-spec, font-entity, or font-object.
4197 If the name is too long for XLFD (maximum 255 chars), return nil.
4198 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4199 the consecutive wildcards are folded into one. */)
4200 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4207 if (FONT_OBJECT_P (font
))
4209 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4211 if (STRINGP (font_name
)
4212 && SDATA (font_name
)[0] == '-')
4214 if (NILP (fold_wildcards
))
4216 strcpy (name
, SSDATA (font_name
));
4219 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4221 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4224 if (! NILP (fold_wildcards
))
4226 char *p0
= name
, *p1
;
4228 while ((p1
= strstr (p0
, "-*-*")))
4230 strcpy (p1
, p1
+ 2);
4235 return build_string (name
);
4238 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4239 doc
: /* Clear font cache. */)
4242 Lisp_Object list
, frame
;
4244 FOR_EACH_FRAME (list
, frame
)
4246 FRAME_PTR f
= XFRAME (frame
);
4247 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4249 for (; driver_list
; driver_list
= driver_list
->next
)
4250 if (driver_list
->on
)
4252 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4253 Lisp_Object val
, tmp
;
4257 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4259 font_assert (! NILP (val
));
4260 tmp
= XCDR (XCAR (val
));
4261 if (XINT (XCAR (tmp
)) == 0)
4263 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4264 XSETCDR (cache
, XCDR (val
));
4274 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4276 struct font
*font
= XFONT_OBJECT (font_object
);
4277 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4278 struct font_metrics metrics
;
4280 LGLYPH_SET_CODE (glyph
, code
);
4281 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4282 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4283 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4284 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4285 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4286 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4290 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4291 doc
: /* Shape the glyph-string GSTRING.
4292 Shaping means substituting glyphs and/or adjusting positions of glyphs
4293 to get the correct visual image of character sequences set in the
4294 header of the glyph-string.
4296 If the shaping was successful, the value is GSTRING itself or a newly
4297 created glyph-string. Otherwise, the value is nil. */)
4298 (Lisp_Object gstring
)
4301 Lisp_Object font_object
, n
, glyph
;
4302 ptrdiff_t i
, j
, from
, to
;
4304 if (! composition_gstring_p (gstring
))
4305 signal_error ("Invalid glyph-string: ", gstring
);
4306 if (! NILP (LGSTRING_ID (gstring
)))
4308 font_object
= LGSTRING_FONT (gstring
);
4309 CHECK_FONT_OBJECT (font_object
);
4310 font
= XFONT_OBJECT (font_object
);
4311 if (! font
->driver
->shape
)
4314 /* Try at most three times with larger gstring each time. */
4315 for (i
= 0; i
< 3; i
++)
4317 n
= font
->driver
->shape (gstring
);
4320 gstring
= larger_vector (gstring
,
4321 LGSTRING_GLYPH_LEN (gstring
), -1);
4323 if (i
== 3 || XINT (n
) == 0)
4325 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4326 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4328 glyph
= LGSTRING_GLYPH (gstring
, 0);
4329 from
= LGLYPH_FROM (glyph
);
4330 to
= LGLYPH_TO (glyph
);
4331 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4333 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4337 if (NILP (LGLYPH_ADJUSTMENT (this)))
4342 glyph
= LGSTRING_GLYPH (gstring
, j
);
4343 LGLYPH_SET_FROM (glyph
, from
);
4344 LGLYPH_SET_TO (glyph
, to
);
4346 from
= LGLYPH_FROM (this);
4347 to
= LGLYPH_TO (this);
4352 if (from
> LGLYPH_FROM (this))
4353 from
= LGLYPH_FROM (this);
4354 if (to
< LGLYPH_TO (this))
4355 to
= LGLYPH_TO (this);
4361 glyph
= LGSTRING_GLYPH (gstring
, j
);
4362 LGLYPH_SET_FROM (glyph
, from
);
4363 LGLYPH_SET_TO (glyph
, to
);
4365 return composition_gstring_put_cache (gstring
, XINT (n
));
4368 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4370 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4371 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4373 VARIATION-SELECTOR is a character code of variation selection
4374 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4375 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4376 (Lisp_Object font_object
, Lisp_Object character
)
4378 unsigned variations
[256];
4383 CHECK_FONT_OBJECT (font_object
);
4384 CHECK_CHARACTER (character
);
4385 font
= XFONT_OBJECT (font_object
);
4386 if (! font
->driver
->get_variation_glyphs
)
4388 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4392 for (i
= 0; i
< 255; i
++)
4395 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4396 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4397 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4404 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4405 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4406 OTF-FEATURES specifies which features to apply in this format:
4407 (SCRIPT LANGSYS GSUB GPOS)
4409 SCRIPT is a symbol specifying a script tag of OpenType,
4410 LANGSYS is a symbol specifying a langsys tag of OpenType,
4411 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4413 If LANGYS is nil, the default langsys is selected.
4415 The features are applied in the order they appear in the list. The
4416 symbol `*' means to apply all available features not present in this
4417 list, and the remaining features are ignored. For instance, (vatu
4418 pstf * haln) is to apply vatu and pstf in this order, then to apply
4419 all available features other than vatu, pstf, and haln.
4421 The features are applied to the glyphs in the range FROM and TO of
4422 the glyph-string GSTRING-IN.
4424 If some feature is actually applicable, the resulting glyphs are
4425 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4426 this case, the value is the number of produced glyphs.
4428 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4431 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4432 produced in GSTRING-OUT, and the value is nil.
4434 See the documentation of `composition-get-gstring' for the format of
4436 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4438 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4443 check_otf_features (otf_features
);
4444 CHECK_FONT_OBJECT (font_object
);
4445 font
= XFONT_OBJECT (font_object
);
4446 if (! font
->driver
->otf_drive
)
4447 error ("Font backend %s can't drive OpenType GSUB table",
4448 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4449 CHECK_CONS (otf_features
);
4450 CHECK_SYMBOL (XCAR (otf_features
));
4451 val
= XCDR (otf_features
);
4452 CHECK_SYMBOL (XCAR (val
));
4453 val
= XCDR (otf_features
);
4456 len
= check_gstring (gstring_in
);
4457 CHECK_VECTOR (gstring_out
);
4458 CHECK_NATNUM (from
);
4460 CHECK_NATNUM (index
);
4462 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4463 args_out_of_range_3 (from
, to
, make_number (len
));
4464 if (XINT (index
) >= ASIZE (gstring_out
))
4465 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4466 num
= font
->driver
->otf_drive (font
, otf_features
,
4467 gstring_in
, XINT (from
), XINT (to
),
4468 gstring_out
, XINT (index
), 0);
4471 return make_number (num
);
4474 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4476 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4477 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4479 (SCRIPT LANGSYS FEATURE ...)
4480 See the documentation of `font-drive-otf' for more detail.
4482 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4483 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4484 character code corresponding to the glyph or nil if there's no
4485 corresponding character. */)
4486 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4489 Lisp_Object gstring_in
, gstring_out
, g
;
4490 Lisp_Object alternates
;
4493 CHECK_FONT_GET_OBJECT (font_object
, font
);
4494 if (! font
->driver
->otf_drive
)
4495 error ("Font backend %s can't drive OpenType GSUB table",
4496 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4497 CHECK_CHARACTER (character
);
4498 CHECK_CONS (otf_features
);
4500 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4501 g
= LGSTRING_GLYPH (gstring_in
, 0);
4502 LGLYPH_SET_CHAR (g
, XINT (character
));
4503 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4504 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4505 gstring_out
, 0, 1)) < 0)
4506 gstring_out
= Ffont_make_gstring (font_object
,
4507 make_number (ASIZE (gstring_out
) * 2));
4509 for (i
= 0; i
< num
; i
++)
4511 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4512 int c
= LGLYPH_CHAR (g
);
4513 unsigned code
= LGLYPH_CODE (g
);
4515 alternates
= Fcons (Fcons (make_number (code
),
4516 c
> 0 ? make_number (c
) : Qnil
),
4519 return Fnreverse (alternates
);
4525 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4526 doc
: /* Open FONT-ENTITY. */)
4527 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4531 CHECK_FONT_ENTITY (font_entity
);
4533 frame
= selected_frame
;
4534 CHECK_LIVE_FRAME (frame
);
4537 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4540 CHECK_NUMBER_OR_FLOAT (size
);
4542 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4544 isize
= XINT (size
);
4545 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4546 args_out_of_range (font_entity
, size
);
4550 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4553 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4554 doc
: /* Close FONT-OBJECT. */)
4555 (Lisp_Object font_object
, Lisp_Object frame
)
4557 CHECK_FONT_OBJECT (font_object
);
4559 frame
= selected_frame
;
4560 CHECK_LIVE_FRAME (frame
);
4561 font_close_object (XFRAME (frame
), font_object
);
4565 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4566 doc
: /* Return information about FONT-OBJECT.
4567 The value is a vector:
4568 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4571 NAME is the font name, a string (or nil if the font backend doesn't
4574 FILENAME is the font file name, a string (or nil if the font backend
4575 doesn't provide a file name).
4577 PIXEL-SIZE is a pixel size by which the font is opened.
4579 SIZE is a maximum advance width of the font in pixels.
4581 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4584 CAPABILITY is a list whose first element is a symbol representing the
4585 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4586 remaining elements describe the details of the font capability.
4588 If the font is OpenType font, the form of the list is
4589 \(opentype GSUB GPOS)
4590 where GSUB shows which "GSUB" features the font supports, and GPOS
4591 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4592 lists of the format:
4593 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4595 If the font is not OpenType font, currently the length of the form is
4598 SCRIPT is a symbol representing OpenType script tag.
4600 LANGSYS is a symbol representing OpenType langsys tag, or nil
4601 representing the default langsys.
4603 FEATURE is a symbol representing OpenType feature tag.
4605 If the font is not OpenType font, CAPABILITY is nil. */)
4606 (Lisp_Object font_object
)
4611 CHECK_FONT_GET_OBJECT (font_object
, font
);
4613 val
= Fmake_vector (make_number (9), Qnil
);
4614 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4615 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4616 ASET (val
, 2, make_number (font
->pixel_size
));
4617 ASET (val
, 3, make_number (font
->max_width
));
4618 ASET (val
, 4, make_number (font
->ascent
));
4619 ASET (val
, 5, make_number (font
->descent
));
4620 ASET (val
, 6, make_number (font
->space_width
));
4621 ASET (val
, 7, make_number (font
->average_width
));
4622 if (font
->driver
->otf_capability
)
4623 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4627 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4629 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4630 FROM and TO are positions (integers or markers) specifying a region
4631 of the current buffer.
4632 If the optional fourth arg OBJECT is not nil, it is a string or a
4633 vector containing the target characters.
4635 Each element is a vector containing information of a glyph in this format:
4636 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4638 FROM is an index numbers of a character the glyph corresponds to.
4639 TO is the same as FROM.
4640 C is the character of the glyph.
4641 CODE is the glyph-code of C in FONT-OBJECT.
4642 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4643 ADJUSTMENT is always nil.
4644 If FONT-OBJECT doesn't have a glyph for a character,
4645 the corresponding element is nil. */)
4646 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4651 Lisp_Object
*chars
, vec
;
4654 CHECK_FONT_GET_OBJECT (font_object
, font
);
4657 ptrdiff_t charpos
, bytepos
;
4659 validate_region (&from
, &to
);
4662 len
= XFASTINT (to
) - XFASTINT (from
);
4663 SAFE_ALLOCA_LISP (chars
, len
);
4664 charpos
= XFASTINT (from
);
4665 bytepos
= CHAR_TO_BYTE (charpos
);
4666 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4669 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4670 chars
[i
] = make_number (c
);
4673 else if (STRINGP (object
))
4675 const unsigned char *p
;
4677 CHECK_NUMBER (from
);
4679 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4680 || XINT (to
) > SCHARS (object
))
4681 args_out_of_range_3 (object
, from
, to
);
4684 len
= XFASTINT (to
) - XFASTINT (from
);
4685 SAFE_ALLOCA_LISP (chars
, len
);
4687 if (STRING_MULTIBYTE (object
))
4688 for (i
= 0; i
< len
; i
++)
4690 int c
= STRING_CHAR_ADVANCE (p
);
4691 chars
[i
] = make_number (c
);
4694 for (i
= 0; i
< len
; i
++)
4695 chars
[i
] = make_number (p
[i
]);
4699 CHECK_VECTOR (object
);
4700 CHECK_NUMBER (from
);
4702 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4703 || XINT (to
) > ASIZE (object
))
4704 args_out_of_range_3 (object
, from
, to
);
4707 len
= XFASTINT (to
) - XFASTINT (from
);
4708 for (i
= 0; i
< len
; i
++)
4710 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4711 CHECK_CHARACTER (elt
);
4713 chars
= &(AREF (object
, XFASTINT (from
)));
4716 vec
= Fmake_vector (make_number (len
), Qnil
);
4717 for (i
= 0; i
< len
; i
++)
4720 int c
= XFASTINT (chars
[i
]);
4722 struct font_metrics metrics
;
4724 code
= font
->driver
->encode_char (font
, c
);
4725 if (code
== FONT_INVALID_CODE
)
4727 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4728 LGLYPH_SET_FROM (g
, i
);
4729 LGLYPH_SET_TO (g
, i
);
4730 LGLYPH_SET_CHAR (g
, c
);
4731 LGLYPH_SET_CODE (g
, code
);
4732 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4733 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4734 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4735 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4736 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4737 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4740 if (! VECTORP (object
))
4745 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4746 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4747 FONT is a font-spec, font-entity, or font-object. */)
4748 (Lisp_Object spec
, Lisp_Object font
)
4750 CHECK_FONT_SPEC (spec
);
4753 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4756 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4757 doc
: /* Return a font-object for displaying a character at POSITION.
4758 Optional second arg WINDOW, if non-nil, is a window displaying
4759 the current buffer. It defaults to the currently selected window. */)
4760 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4767 CHECK_NUMBER_COERCE_MARKER (position
);
4768 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4769 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4770 pos
= XINT (position
);
4774 CHECK_NUMBER (position
);
4775 CHECK_STRING (string
);
4776 if (! (0 < XINT (position
) && XINT (position
) < SCHARS (string
)))
4777 args_out_of_range (string
, position
);
4778 pos
= XINT (position
);
4781 window
= selected_window
;
4782 CHECK_LIVE_WINDOW (window
);
4783 w
= XWINDOW (window
);
4785 return font_at (-1, pos
, NULL
, w
, string
);
4789 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4790 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4791 The value is a number of glyphs drawn.
4792 Type C-l to recover what previously shown. */)
4793 (Lisp_Object font_object
, Lisp_Object string
)
4795 Lisp_Object frame
= selected_frame
;
4796 FRAME_PTR f
= XFRAME (frame
);
4802 CHECK_FONT_GET_OBJECT (font_object
, font
);
4803 CHECK_STRING (string
);
4804 len
= SCHARS (string
);
4805 code
= alloca (sizeof (unsigned) * len
);
4806 for (i
= 0; i
< len
; i
++)
4808 Lisp_Object ch
= Faref (string
, make_number (i
));
4812 code
[i
] = font
->driver
->encode_char (font
, c
);
4813 if (code
[i
] == FONT_INVALID_CODE
)
4816 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4818 if (font
->driver
->prepare_face
)
4819 font
->driver
->prepare_face (f
, face
);
4820 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4821 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4822 if (font
->driver
->done_face
)
4823 font
->driver
->done_face (f
, face
);
4825 return make_number (len
);
4829 #endif /* FONT_DEBUG */
4831 #ifdef HAVE_WINDOW_SYSTEM
4833 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4834 doc
: /* Return information about a font named NAME on frame FRAME.
4835 If FRAME is omitted or nil, use the selected frame.
4836 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4837 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4839 OPENED-NAME is the name used for opening the font,
4840 FULL-NAME is the full name of the font,
4841 SIZE is the pixelsize of the font,
4842 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4843 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4844 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4845 how to compose characters.
4846 If the named font is not yet loaded, return nil. */)
4847 (Lisp_Object name
, Lisp_Object frame
)
4852 Lisp_Object font_object
;
4854 (*check_window_system_func
) ();
4857 CHECK_STRING (name
);
4859 frame
= selected_frame
;
4860 CHECK_LIVE_FRAME (frame
);
4865 int fontset
= fs_query_fontset (name
, 0);
4868 name
= fontset_ascii (fontset
);
4869 font_object
= font_open_by_name (f
, SSDATA (name
));
4871 else if (FONT_OBJECT_P (name
))
4873 else if (FONT_ENTITY_P (name
))
4874 font_object
= font_open_entity (f
, name
, 0);
4877 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4878 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4880 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4882 if (NILP (font_object
))
4884 font
= XFONT_OBJECT (font_object
);
4886 info
= Fmake_vector (make_number (7), Qnil
);
4887 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4888 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4889 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4890 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4891 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4892 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4893 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4896 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4897 close it now. Perhaps, we should manage font-objects
4898 by `reference-count'. */
4899 font_close_object (f
, font_object
);
4906 #define BUILD_STYLE_TABLE(TBL) \
4907 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4910 build_style_table (const struct table_entry
*entry
, int nelement
)
4913 Lisp_Object table
, elt
;
4915 table
= Fmake_vector (make_number (nelement
), Qnil
);
4916 for (i
= 0; i
< nelement
; i
++)
4918 for (j
= 0; entry
[i
].names
[j
]; j
++);
4919 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4920 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4921 for (j
= 0; entry
[i
].names
[j
]; j
++)
4922 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4923 ASET (table
, i
, elt
);
4928 /* The deferred font-log data of the form [ACTION ARG RESULT].
4929 If ACTION is not nil, that is added to the log when font_add_log is
4930 called next time. At that time, ACTION is set back to nil. */
4931 static Lisp_Object Vfont_log_deferred
;
4933 /* Prepend the font-related logging data in Vfont_log if it is not
4934 `t'. ACTION describes a kind of font-related action (e.g. listing,
4935 opening), ARG is the argument for the action, and RESULT is the
4936 result of the action. */
4938 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4943 if (EQ (Vfont_log
, Qt
))
4945 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4947 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4949 ASET (Vfont_log_deferred
, 0, Qnil
);
4950 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4951 AREF (Vfont_log_deferred
, 2));
4956 Lisp_Object tail
, elt
;
4957 Lisp_Object equalstr
= build_string ("=");
4959 val
= Ffont_xlfd_name (arg
, Qt
);
4960 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4964 if (EQ (XCAR (elt
), QCscript
)
4965 && SYMBOLP (XCDR (elt
)))
4966 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4967 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4968 else if (EQ (XCAR (elt
), QClang
)
4969 && SYMBOLP (XCDR (elt
)))
4970 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4971 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4972 else if (EQ (XCAR (elt
), QCotf
)
4973 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4974 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4976 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4982 && VECTORP (XCAR (result
))
4983 && ASIZE (XCAR (result
)) > 0
4984 && FONTP (AREF (XCAR (result
), 0)))
4985 result
= font_vconcat_entity_vectors (result
);
4988 val
= Ffont_xlfd_name (result
, Qt
);
4989 if (! FONT_SPEC_P (result
))
4990 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4991 build_string (":"), val
);
4994 else if (CONSP (result
))
4997 result
= Fcopy_sequence (result
);
4998 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5002 val
= Ffont_xlfd_name (val
, Qt
);
5003 XSETCAR (tail
, val
);
5006 else if (VECTORP (result
))
5008 result
= Fcopy_sequence (result
);
5009 for (i
= 0; i
< ASIZE (result
); i
++)
5011 val
= AREF (result
, i
);
5013 val
= Ffont_xlfd_name (val
, Qt
);
5014 ASET (result
, i
, val
);
5017 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5020 /* Record a font-related logging data to be added to Vfont_log when
5021 font_add_log is called next time. ACTION, ARG, RESULT are the same
5025 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5027 if (EQ (Vfont_log
, Qt
))
5029 ASET (Vfont_log_deferred
, 0, build_string (action
));
5030 ASET (Vfont_log_deferred
, 1, arg
);
5031 ASET (Vfont_log_deferred
, 2, result
);
5037 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5038 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5039 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5040 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5041 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5042 /* Note that the other elements in sort_shift_bits are not used. */
5044 staticpro (&font_charset_alist
);
5045 font_charset_alist
= Qnil
;
5047 DEFSYM (Qopentype
, "opentype");
5049 DEFSYM (Qascii_0
, "ascii-0");
5050 DEFSYM (Qiso8859_1
, "iso8859-1");
5051 DEFSYM (Qiso10646_1
, "iso10646-1");
5052 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5053 DEFSYM (Qunicode_sip
, "unicode-sip");
5057 DEFSYM (QCotf
, ":otf");
5058 DEFSYM (QClang
, ":lang");
5059 DEFSYM (QCscript
, ":script");
5060 DEFSYM (QCantialias
, ":antialias");
5062 DEFSYM (QCfoundry
, ":foundry");
5063 DEFSYM (QCadstyle
, ":adstyle");
5064 DEFSYM (QCregistry
, ":registry");
5065 DEFSYM (QCspacing
, ":spacing");
5066 DEFSYM (QCdpi
, ":dpi");
5067 DEFSYM (QCscalable
, ":scalable");
5068 DEFSYM (QCavgwidth
, ":avgwidth");
5069 DEFSYM (QCfont_entity
, ":font-entity");
5070 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5080 DEFSYM (QCuser_spec
, "user-spec");
5082 staticpro (&null_vector
);
5083 null_vector
= Fmake_vector (make_number (0), Qnil
);
5085 staticpro (&scratch_font_spec
);
5086 scratch_font_spec
= Ffont_spec (0, NULL
);
5087 staticpro (&scratch_font_prefer
);
5088 scratch_font_prefer
= Ffont_spec (0, NULL
);
5090 staticpro (&Vfont_log_deferred
);
5091 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5095 staticpro (&otf_list
);
5097 #endif /* HAVE_LIBOTF */
5101 defsubr (&Sfont_spec
);
5102 defsubr (&Sfont_get
);
5103 #ifdef HAVE_WINDOW_SYSTEM
5104 defsubr (&Sfont_face_attributes
);
5106 defsubr (&Sfont_put
);
5107 defsubr (&Slist_fonts
);
5108 defsubr (&Sfont_family_list
);
5109 defsubr (&Sfind_font
);
5110 defsubr (&Sfont_xlfd_name
);
5111 defsubr (&Sclear_font_cache
);
5112 defsubr (&Sfont_shape_gstring
);
5113 defsubr (&Sfont_variation_glyphs
);
5115 defsubr (&Sfont_drive_otf
);
5116 defsubr (&Sfont_otf_alternates
);
5120 defsubr (&Sopen_font
);
5121 defsubr (&Sclose_font
);
5122 defsubr (&Squery_font
);
5123 defsubr (&Sfont_get_glyphs
);
5124 defsubr (&Sfont_match_p
);
5125 defsubr (&Sfont_at
);
5127 defsubr (&Sdraw_string
);
5129 #endif /* FONT_DEBUG */
5130 #ifdef HAVE_WINDOW_SYSTEM
5131 defsubr (&Sfont_info
);
5134 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5136 Alist of fontname patterns vs the corresponding encoding and repertory info.
5137 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5138 where ENCODING is a charset or a char-table,
5139 and REPERTORY is a charset, a char-table, or nil.
5141 If ENCODING and REPERTORY are the same, the element can have the form
5142 \(REGEXP . ENCODING).
5144 ENCODING is for converting a character to a glyph code of the font.
5145 If ENCODING is a charset, encoding a character by the charset gives
5146 the corresponding glyph code. If ENCODING is a char-table, looking up
5147 the table by a character gives the corresponding glyph code.
5149 REPERTORY specifies a repertory of characters supported by the font.
5150 If REPERTORY is a charset, all characters beloging to the charset are
5151 supported. If REPERTORY is a char-table, all characters who have a
5152 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5153 gets the repertory information by an opened font and ENCODING. */);
5154 Vfont_encoding_alist
= Qnil
;
5156 /* FIXME: These 3 vars are not quite what they appear: setq on them
5157 won't have any effect other than disconnect them from the style
5158 table used by the font display code. So we make them read-only,
5159 to avoid this confusing situation. */
5161 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5162 doc
: /* Vector of valid font weight values.
5163 Each element has the form:
5164 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5165 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5166 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5167 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5169 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5170 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5171 See `font-weight-table' for the format of the vector. */);
5172 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5173 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5175 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5176 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5177 See `font-weight-table' for the format of the vector. */);
5178 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5179 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5181 staticpro (&font_style_table
);
5182 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5183 ASET (font_style_table
, 0, Vfont_weight_table
);
5184 ASET (font_style_table
, 1, Vfont_slant_table
);
5185 ASET (font_style_table
, 2, Vfont_width_table
);
5187 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5188 *Logging list of font related actions and results.
5189 The value t means to suppress the logging.
5190 The initial value is set to nil if the environment variable
5191 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5194 #ifdef HAVE_WINDOW_SYSTEM
5195 #ifdef HAVE_FREETYPE
5197 #ifdef HAVE_X_WINDOWS
5202 #endif /* HAVE_XFT */
5203 #endif /* HAVE_X_WINDOWS */
5204 #else /* not HAVE_FREETYPE */
5205 #ifdef HAVE_X_WINDOWS
5207 #endif /* HAVE_X_WINDOWS */
5208 #endif /* not HAVE_FREETYPE */
5211 #endif /* HAVE_BDFFONT */
5214 #endif /* WINDOWSNT */
5217 #endif /* HAVE_NS */
5218 #endif /* HAVE_WINDOW_SYSTEM */
5224 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;