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 EMACS_INT 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 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
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 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
= esnprintf (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
- 1 ? -1 : len
;
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
))
1596 p
+= esnprintf (p
, lim
- p
, "%s", SSDATA (family
));
1598 p
+= esnprintf (p
, lim
- p
, "-%d" + (p
== name
), point_size
);
1599 else if (pixel_size
> 0)
1600 p
+= esnprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1601 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1602 p
+= esnprintf (p
, lim
- p
, ":foundry=%s",
1603 SSDATA (SYMBOL_NAME (AREF (font
,
1604 FONT_FOUNDRY_INDEX
))));
1605 for (i
= 0; i
< 3; i
++)
1606 if (! NILP (styles
[i
]))
1607 p
+= esnprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1608 SSDATA (SYMBOL_NAME (styles
[i
])));
1609 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1610 p
+= esnprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1611 XINT (AREF (font
, FONT_DPI_INDEX
)));
1612 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1613 p
+= esnprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1614 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1615 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1616 p
+= esnprintf (p
, lim
- p
,
1617 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1619 : ":scalable=false"));
1620 return lim
- p
== 1 ? -1 : p
- name
;
1623 /* Parse NAME (null terminated) and store information in FONT
1624 (font-spec or font-entity). If NAME is successfully parsed, return
1625 0. Otherwise return -1. */
1628 font_parse_name (char *name
, Lisp_Object font
)
1630 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1631 return font_parse_xlfd (name
, font
);
1632 return font_parse_fcname (name
, font
);
1636 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1637 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1641 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1647 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1649 CHECK_STRING (family
);
1650 len
= SBYTES (family
);
1651 p0
= SSDATA (family
);
1652 p1
= strchr (p0
, '-');
1655 if ((*p0
!= '*' && p1
- p0
> 0)
1656 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1657 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1660 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1663 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1665 if (! NILP (registry
))
1667 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1668 CHECK_STRING (registry
);
1669 len
= SBYTES (registry
);
1670 p0
= SSDATA (registry
);
1671 p1
= strchr (p0
, '-');
1674 if (SDATA (registry
)[len
- 1] == '*')
1675 registry
= concat2 (registry
, build_string ("-*"));
1677 registry
= concat2 (registry
, build_string ("*-*"));
1679 registry
= Fdowncase (registry
);
1680 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1685 /* This part (through the next ^L) is still experimental and not
1686 tested much. We may drastically change codes. */
1692 #define LGSTRING_HEADER_SIZE 6
1693 #define LGSTRING_GLYPH_SIZE 8
1696 check_gstring (Lisp_Object gstring
)
1701 CHECK_VECTOR (gstring
);
1702 val
= AREF (gstring
, 0);
1704 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1706 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1707 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1708 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1709 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1710 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1711 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1712 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1713 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1714 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1715 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1716 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1718 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1720 val
= LGSTRING_GLYPH (gstring
, i
);
1722 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1724 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1726 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1727 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1728 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1729 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1730 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1731 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1732 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1733 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1735 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1737 if (ASIZE (val
) < 3)
1739 for (j
= 0; j
< 3; j
++)
1740 CHECK_NUMBER (AREF (val
, j
));
1745 error ("Invalid glyph-string format");
1750 check_otf_features (Lisp_Object otf_features
)
1754 CHECK_CONS (otf_features
);
1755 CHECK_SYMBOL (XCAR (otf_features
));
1756 otf_features
= XCDR (otf_features
);
1757 CHECK_CONS (otf_features
);
1758 CHECK_SYMBOL (XCAR (otf_features
));
1759 otf_features
= XCDR (otf_features
);
1760 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1762 CHECK_SYMBOL (Fcar (val
));
1763 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1764 error ("Invalid OTF GSUB feature: %s",
1765 SDATA (SYMBOL_NAME (XCAR (val
))));
1767 otf_features
= XCDR (otf_features
);
1768 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1770 CHECK_SYMBOL (Fcar (val
));
1771 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1772 error ("Invalid OTF GPOS feature: %s",
1773 SDATA (SYMBOL_NAME (XCAR (val
))));
1780 Lisp_Object otf_list
;
1783 otf_tag_symbol (OTF_Tag tag
)
1787 OTF_tag_name (tag
, name
);
1788 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1792 otf_open (Lisp_Object file
)
1794 Lisp_Object val
= Fassoc (file
, otf_list
);
1798 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1801 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1802 val
= make_save_value (otf
, 0);
1803 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1809 /* Return a list describing which scripts/languages FONT supports by
1810 which GSUB/GPOS features of OpenType tables. See the comment of
1811 (struct font_driver).otf_capability. */
1814 font_otf_capability (struct font
*font
)
1817 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1820 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1823 for (i
= 0; i
< 2; i
++)
1825 OTF_GSUB_GPOS
*gsub_gpos
;
1826 Lisp_Object script_list
= Qnil
;
1829 if (OTF_get_features (otf
, i
== 0) < 0)
1831 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1832 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1834 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1835 Lisp_Object langsys_list
= Qnil
;
1836 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1839 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1841 OTF_LangSys
*langsys
;
1842 Lisp_Object feature_list
= Qnil
;
1843 Lisp_Object langsys_tag
;
1846 if (k
== script
->LangSysCount
)
1848 langsys
= &script
->DefaultLangSys
;
1853 langsys
= script
->LangSys
+ k
;
1855 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1857 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1859 OTF_Feature
*feature
1860 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1861 Lisp_Object feature_tag
1862 = otf_tag_symbol (feature
->FeatureTag
);
1864 feature_list
= Fcons (feature_tag
, feature_list
);
1866 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1869 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1874 XSETCAR (capability
, script_list
);
1876 XSETCDR (capability
, script_list
);
1882 /* Parse OTF features in SPEC and write a proper features spec string
1883 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1884 assured that the sufficient memory has already allocated for
1888 generate_otf_features (Lisp_Object spec
, char *features
)
1896 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1902 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1907 else if (! asterisk
)
1909 val
= SYMBOL_NAME (val
);
1910 p
+= esprintf (p
, "%s", SDATA (val
));
1914 val
= SYMBOL_NAME (val
);
1915 p
+= esprintf (p
, "~%s", SDATA (val
));
1919 error ("OTF spec too long");
1923 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1925 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1927 return Fcons (make_number (len
),
1928 make_unibyte_string (device_table
->DeltaValue
, len
));
1932 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
1934 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1936 if (value_format
& OTF_XPlacement
)
1937 ASET (val
, 0, make_number (value_record
->XPlacement
));
1938 if (value_format
& OTF_YPlacement
)
1939 ASET (val
, 1, make_number (value_record
->YPlacement
));
1940 if (value_format
& OTF_XAdvance
)
1941 ASET (val
, 2, make_number (value_record
->XAdvance
));
1942 if (value_format
& OTF_YAdvance
)
1943 ASET (val
, 3, make_number (value_record
->YAdvance
));
1944 if (value_format
& OTF_XPlaDevice
)
1945 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1946 if (value_format
& OTF_YPlaDevice
)
1947 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1948 if (value_format
& OTF_XAdvDevice
)
1949 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1950 if (value_format
& OTF_YAdvDevice
)
1951 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1956 font_otf_Anchor (OTF_Anchor
*anchor
)
1960 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1961 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1962 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1963 if (anchor
->AnchorFormat
== 2)
1964 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1967 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1968 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1972 #endif /* HAVE_LIBOTF */
1978 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
1979 static int font_compare (const void *, const void *);
1980 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
1984 font_rescale_ratio (Lisp_Object font_entity
)
1986 Lisp_Object tail
, elt
;
1987 Lisp_Object name
= Qnil
;
1989 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
1992 if (FLOATP (XCDR (elt
)))
1994 if (STRINGP (XCAR (elt
)))
1997 name
= Ffont_xlfd_name (font_entity
, Qnil
);
1998 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
1999 return XFLOAT_DATA (XCDR (elt
));
2001 else if (FONT_SPEC_P (XCAR (elt
)))
2003 if (font_match_p (XCAR (elt
), font_entity
))
2004 return XFLOAT_DATA (XCDR (elt
));
2011 /* We sort fonts by scoring each of them against a specified
2012 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2013 the value is, the closer the font is to the font-spec.
2015 The lowest 2 bits of the score are used for driver type. The font
2016 available by the most preferred font driver is 0.
2018 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2019 WEIGHT, SLANT, WIDTH, and SIZE. */
2021 /* How many bits to shift to store the difference value of each font
2022 property in a score. Note that floats for FONT_TYPE_INDEX and
2023 FONT_REGISTRY_INDEX are not used. */
2024 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2026 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2027 The return value indicates how different ENTITY is compared with
2031 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2036 /* Score three style numeric fields. Maximum difference is 127. */
2037 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2038 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2040 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2041 - (XINT (spec_prop
[i
]) >> 8));
2044 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2047 /* Score the size. Maximum difference is 127. */
2048 i
= FONT_SIZE_INDEX
;
2049 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2050 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2052 /* We use the higher 6-bit for the actual size difference. The
2053 lowest bit is set if the DPI is different. */
2055 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2057 if (CONSP (Vface_font_rescale_alist
))
2058 pixel_size
*= font_rescale_ratio (entity
);
2059 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2063 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2064 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2066 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2067 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2069 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2076 /* Concatenate all elements of LIST into one vector. LIST is a list
2077 of font-entity vectors. */
2080 font_vconcat_entity_vectors (Lisp_Object list
)
2082 int nargs
= XINT (Flength (list
));
2083 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2086 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2087 args
[i
] = XCAR (list
);
2088 return Fvconcat (nargs
, args
);
2092 /* The structure for elements being sorted by qsort. */
2093 struct font_sort_data
2096 int font_driver_preference
;
2101 /* The comparison function for qsort. */
2104 font_compare (const void *d1
, const void *d2
)
2106 const struct font_sort_data
*data1
= d1
;
2107 const struct font_sort_data
*data2
= d2
;
2109 if (data1
->score
< data2
->score
)
2111 else if (data1
->score
> data2
->score
)
2113 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2117 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2118 If PREFER specifies a point-size, calculate the corresponding
2119 pixel-size from QCdpi property of PREFER or from the Y-resolution
2120 of FRAME before sorting.
2122 If BEST-ONLY is nonzero, return the best matching entity (that
2123 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2124 if BEST-ONLY is negative). Otherwise, return the sorted result as
2125 a single vector of font-entities.
2127 This function does no optimization for the case that the total
2128 number of elements is 1. The caller should avoid calling this in
2132 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2134 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2136 struct font_sort_data
*data
;
2137 unsigned best_score
;
2138 Lisp_Object best_entity
;
2139 struct frame
*f
= XFRAME (frame
);
2140 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2143 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2144 prefer_prop
[i
] = AREF (prefer
, i
);
2145 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2146 prefer_prop
[FONT_SIZE_INDEX
]
2147 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2149 if (NILP (XCDR (list
)))
2151 /* What we have to take care of is this single vector. */
2153 maxlen
= ASIZE (vec
);
2157 /* We don't have to perform sort, so there's no need of creating
2158 a single vector. But, we must find the length of the longest
2161 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2162 if (maxlen
< ASIZE (XCAR (tail
)))
2163 maxlen
= ASIZE (XCAR (tail
));
2167 /* We have to create a single vector to sort it. */
2168 vec
= font_vconcat_entity_vectors (list
);
2169 maxlen
= ASIZE (vec
);
2172 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2173 best_score
= 0xFFFFFFFF;
2176 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2178 int font_driver_preference
= 0;
2179 Lisp_Object current_font_driver
;
2185 /* We are sure that the length of VEC > 0. */
2186 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2187 /* Score the elements. */
2188 for (i
= 0; i
< len
; i
++)
2190 data
[i
].entity
= AREF (vec
, i
);
2192 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2194 ? font_score (data
[i
].entity
, prefer_prop
)
2196 if (best_only
&& best_score
> data
[i
].score
)
2198 best_score
= data
[i
].score
;
2199 best_entity
= data
[i
].entity
;
2200 if (best_score
== 0)
2203 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2205 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2206 font_driver_preference
++;
2208 data
[i
].font_driver_preference
= font_driver_preference
;
2211 /* Sort if necessary. */
2214 qsort (data
, len
, sizeof *data
, font_compare
);
2215 for (i
= 0; i
< len
; i
++)
2216 ASET (vec
, i
, data
[i
].entity
);
2225 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2230 /* API of Font Service Layer. */
2232 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2233 sort_shift_bits. Finternal_set_font_selection_order calls this
2234 function with font_sort_order after setting up it. */
2237 font_update_sort_order (int *order
)
2241 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2243 int xlfd_idx
= order
[i
];
2245 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2246 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2247 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2248 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2249 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2250 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2252 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2257 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2262 table
= assq_no_quit (script
, table
);
2265 table
= XCDR (table
);
2266 if (! NILP (langsys
))
2268 table
= assq_no_quit (langsys
, table
);
2274 val
= assq_no_quit (Qnil
, table
);
2276 table
= XCAR (table
);
2280 table
= XCDR (table
);
2281 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2283 if (NILP (XCAR (features
)))
2288 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2294 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2297 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2299 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2301 script
= XCAR (spec
);
2305 langsys
= XCAR (spec
);
2316 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2317 XCAR (otf_capability
)))
2319 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2320 XCDR (otf_capability
)))
2327 /* Check if FONT (font-entity or font-object) matches with the font
2328 specification SPEC. */
2331 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2333 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2334 Lisp_Object extra
, font_extra
;
2337 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2338 if (! NILP (AREF (spec
, i
))
2339 && ! NILP (AREF (font
, i
))
2340 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2342 props
= XFONT_SPEC (spec
)->props
;
2343 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2345 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2346 prop
[i
] = AREF (spec
, i
);
2347 prop
[FONT_SIZE_INDEX
]
2348 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2352 if (font_score (font
, props
) > 0)
2354 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2355 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2356 for (; CONSP (extra
); extra
= XCDR (extra
))
2358 Lisp_Object key
= XCAR (XCAR (extra
));
2359 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2361 if (EQ (key
, QClang
))
2363 val2
= assq_no_quit (key
, font_extra
);
2372 if (NILP (Fmemq (val
, val2
)))
2377 ? NILP (Fmemq (val
, XCDR (val2
)))
2381 else if (EQ (key
, QCscript
))
2383 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2389 /* All characters in the list must be supported. */
2390 for (; CONSP (val2
); val2
= XCDR (val2
))
2392 if (! NATNUMP (XCAR (val2
)))
2394 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2395 == FONT_INVALID_CODE
)
2399 else if (VECTORP (val2
))
2401 /* At most one character in the vector must be supported. */
2402 for (i
= 0; i
< ASIZE (val2
); i
++)
2404 if (! NATNUMP (AREF (val2
, i
)))
2406 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2407 != FONT_INVALID_CODE
)
2410 if (i
== ASIZE (val2
))
2415 else if (EQ (key
, QCotf
))
2419 if (! FONT_OBJECT_P (font
))
2421 fontp
= XFONT_OBJECT (font
);
2422 if (! fontp
->driver
->otf_capability
)
2424 val2
= fontp
->driver
->otf_capability (fontp
);
2425 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2436 Each font backend has the callback function get_cache, and it
2437 returns a cons cell of which cdr part can be freely used for
2438 caching fonts. The cons cell may be shared by multiple frames
2439 and/or multiple font drivers. So, we arrange the cdr part as this:
2441 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2443 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2444 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2445 cons (FONT-SPEC FONT-ENTITY ...). */
2447 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2448 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2449 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2450 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2451 struct font_driver
*);
2454 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2456 Lisp_Object cache
, val
;
2458 cache
= driver
->get_cache (f
);
2460 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2464 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2465 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2469 val
= XCDR (XCAR (val
));
2470 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2476 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2478 Lisp_Object cache
, val
, tmp
;
2481 cache
= driver
->get_cache (f
);
2483 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2484 cache
= val
, val
= XCDR (val
);
2485 font_assert (! NILP (val
));
2486 tmp
= XCDR (XCAR (val
));
2487 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2488 if (XINT (XCAR (tmp
)) == 0)
2490 font_clear_cache (f
, XCAR (val
), driver
);
2491 XSETCDR (cache
, XCDR (val
));
2497 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2499 Lisp_Object val
= driver
->get_cache (f
);
2500 Lisp_Object type
= driver
->type
;
2502 font_assert (CONSP (val
));
2503 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2504 font_assert (CONSP (val
));
2505 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2506 val
= XCDR (XCAR (val
));
2510 static int num_fonts
;
2513 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2515 Lisp_Object tail
, elt
;
2516 Lisp_Object tail2
, entity
;
2518 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2519 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2522 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2523 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2525 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2527 entity
= XCAR (tail2
);
2529 if (FONT_ENTITY_P (entity
)
2530 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2532 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2534 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2536 Lisp_Object val
= XCAR (objlist
);
2537 struct font
*font
= XFONT_OBJECT (val
);
2539 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2541 font_assert (font
&& driver
== font
->driver
);
2542 driver
->close (f
, font
);
2546 if (driver
->free_entity
)
2547 driver
->free_entity (entity
);
2552 XSETCDR (cache
, Qnil
);
2556 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2558 /* Check each font-entity in VEC, and return a list of font-entities
2559 that satisfy these conditions:
2560 (1) matches with SPEC and SIZE if SPEC is not nil, and
2561 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2565 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2567 Lisp_Object entity
, val
;
2568 enum font_property_index prop
;
2571 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2573 entity
= AREF (vec
, i
);
2574 if (! NILP (Vface_ignored_fonts
))
2577 Lisp_Object tail
, regexp
;
2579 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2581 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2583 regexp
= XCAR (tail
);
2584 if (STRINGP (regexp
)
2585 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2594 val
= Fcons (entity
, val
);
2597 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2598 if (INTEGERP (AREF (spec
, prop
))
2599 && ((XINT (AREF (spec
, prop
)) >> 8)
2600 != (XINT (AREF (entity
, prop
)) >> 8)))
2601 prop
= FONT_SPEC_MAX
;
2602 if (prop
< FONT_SPEC_MAX
2604 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2606 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2609 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2610 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2611 prop
= FONT_SPEC_MAX
;
2613 if (prop
< FONT_SPEC_MAX
2614 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2615 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2616 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2617 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2618 prop
= FONT_SPEC_MAX
;
2619 if (prop
< FONT_SPEC_MAX
2620 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2621 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2622 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2623 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2624 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2625 prop
= FONT_SPEC_MAX
;
2626 if (prop
< FONT_SPEC_MAX
)
2627 val
= Fcons (entity
, val
);
2629 return (Fvconcat (1, &val
));
2633 /* Return a list of vectors of font-entities matching with SPEC on
2634 FRAME. Each elements in the list is a vector of entities from the
2635 same font-driver. */
2638 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2640 FRAME_PTR f
= XFRAME (frame
);
2641 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2642 Lisp_Object ftype
, val
;
2643 Lisp_Object list
= Qnil
;
2645 int need_filtering
= 0;
2648 font_assert (FONT_SPEC_P (spec
));
2650 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2651 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2652 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2653 size
= font_pixel_size (f
, spec
);
2657 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2658 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2659 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2660 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2661 if (i
!= FONT_SPACING_INDEX
)
2663 ASET (scratch_font_spec
, i
, Qnil
);
2664 if (! NILP (AREF (spec
, i
)))
2667 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2668 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2670 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2672 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2674 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2676 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2677 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2684 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2688 val
= Fvconcat (1, &val
);
2689 copy
= copy_font_spec (scratch_font_spec
);
2690 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2691 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2695 || ! NILP (Vface_ignored_fonts
)))
2696 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2697 if (ASIZE (val
) > 0)
2698 list
= Fcons (val
, list
);
2701 list
= Fnreverse (list
);
2702 FONT_ADD_LOG ("list", spec
, list
);
2707 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2708 nil, is an array of face's attributes, which specifies preferred
2709 font-related attributes. */
2712 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2714 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2715 Lisp_Object ftype
, size
, entity
;
2717 Lisp_Object work
= copy_font_spec (spec
);
2719 XSETFRAME (frame
, f
);
2720 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2721 size
= AREF (spec
, FONT_SIZE_INDEX
);
2724 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2725 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2726 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2727 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2730 for (; driver_list
; driver_list
= driver_list
->next
)
2732 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2734 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2737 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2738 entity
= assoc_no_quit (work
, XCDR (cache
));
2740 entity
= XCDR (entity
);
2743 entity
= driver_list
->driver
->match (frame
, work
);
2744 copy
= copy_font_spec (work
);
2745 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2746 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2748 if (! NILP (entity
))
2751 FONT_ADD_LOG ("match", work
, entity
);
2756 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2757 opened font object. */
2760 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2762 struct font_driver_list
*driver_list
;
2763 Lisp_Object objlist
, size
, val
, font_object
;
2765 int min_width
, height
;
2766 int scaled_pixel_size
= pixel_size
;
2768 font_assert (FONT_ENTITY_P (entity
));
2769 size
= AREF (entity
, FONT_SIZE_INDEX
);
2770 if (XINT (size
) != 0)
2771 scaled_pixel_size
= pixel_size
= XINT (size
);
2772 else if (CONSP (Vface_font_rescale_alist
))
2773 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2775 val
= AREF (entity
, FONT_TYPE_INDEX
);
2776 for (driver_list
= f
->font_driver_list
;
2777 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2778 driver_list
= driver_list
->next
);
2782 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2783 objlist
= XCDR (objlist
))
2785 Lisp_Object fn
= XCAR (objlist
);
2786 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2787 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2789 if (driver_list
->driver
->cached_font_ok
== NULL
2790 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2795 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2796 if (!NILP (font_object
))
2797 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2798 FONT_ADD_LOG ("open", entity
, font_object
);
2799 if (NILP (font_object
))
2801 ASET (entity
, FONT_OBJLIST_INDEX
,
2802 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2805 font
= XFONT_OBJECT (font_object
);
2806 min_width
= (font
->min_width
? font
->min_width
2807 : font
->average_width
? font
->average_width
2808 : font
->space_width
? font
->space_width
2810 height
= (font
->height
? font
->height
: 1);
2811 #ifdef HAVE_WINDOW_SYSTEM
2812 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2813 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2815 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2816 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2817 fonts_changed_p
= 1;
2821 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2822 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2823 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2824 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2832 /* Close FONT_OBJECT that is opened on frame F. */
2835 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2837 struct font
*font
= XFONT_OBJECT (font_object
);
2839 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2840 /* Already closed. */
2842 FONT_ADD_LOG ("close", font_object
, Qnil
);
2843 font
->driver
->close (f
, font
);
2844 #ifdef HAVE_WINDOW_SYSTEM
2845 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2846 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2852 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2853 FONT is a font-entity and it must be opened to check. */
2856 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2860 if (FONT_ENTITY_P (font
))
2862 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2863 struct font_driver_list
*driver_list
;
2865 for (driver_list
= f
->font_driver_list
;
2866 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2867 driver_list
= driver_list
->next
);
2870 if (! driver_list
->driver
->has_char
)
2872 return driver_list
->driver
->has_char (font
, c
);
2875 font_assert (FONT_OBJECT_P (font
));
2876 fontp
= XFONT_OBJECT (font
);
2877 if (fontp
->driver
->has_char
)
2879 int result
= fontp
->driver
->has_char (font
, c
);
2884 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2888 /* Return the glyph ID of FONT_OBJECT for character C. */
2891 font_encode_char (Lisp_Object font_object
, int c
)
2895 font_assert (FONT_OBJECT_P (font_object
));
2896 font
= XFONT_OBJECT (font_object
);
2897 return font
->driver
->encode_char (font
, c
);
2901 /* Return the name of FONT_OBJECT. */
2904 font_get_name (Lisp_Object font_object
)
2906 font_assert (FONT_OBJECT_P (font_object
));
2907 return AREF (font_object
, FONT_NAME_INDEX
);
2911 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2912 could not be parsed by font_parse_name, return Qnil. */
2915 font_spec_from_name (Lisp_Object font_name
)
2917 Lisp_Object spec
= Ffont_spec (0, NULL
);
2919 CHECK_STRING (font_name
);
2920 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2922 font_put_extra (spec
, QCname
, font_name
);
2923 font_put_extra (spec
, QCuser_spec
, font_name
);
2929 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2931 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2936 if (! NILP (Ffont_get (font
, QCname
)))
2938 font
= copy_font_spec (font
);
2939 font_put_extra (font
, QCname
, Qnil
);
2942 if (NILP (AREF (font
, prop
))
2943 && prop
!= FONT_FAMILY_INDEX
2944 && prop
!= FONT_FOUNDRY_INDEX
2945 && prop
!= FONT_WIDTH_INDEX
2946 && prop
!= FONT_SIZE_INDEX
)
2948 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
2949 font
= copy_font_spec (font
);
2950 ASET (font
, prop
, Qnil
);
2951 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2953 if (prop
== FONT_FAMILY_INDEX
)
2955 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2956 /* If we are setting the font family, we must also clear
2957 FONT_WIDTH_INDEX to avoid rejecting families that lack
2958 support for some widths. */
2959 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
2961 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2962 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2963 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2964 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2965 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2966 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2968 else if (prop
== FONT_SIZE_INDEX
)
2970 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2971 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2972 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2974 else if (prop
== FONT_WIDTH_INDEX
)
2975 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2976 attrs
[LFACE_FONT_INDEX
] = font
;
2979 /* Select a font from ENTITIES (list of font-entity vectors) that
2980 supports C and is the best match for ATTRS and PIXEL_SIZE. */
2983 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
2985 Lisp_Object font_entity
;
2988 FRAME_PTR f
= XFRAME (frame
);
2990 if (NILP (XCDR (entities
))
2991 && ASIZE (XCAR (entities
)) == 1)
2993 font_entity
= AREF (XCAR (entities
), 0);
2995 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3000 /* Sort fonts by properties specified in ATTRS. */
3001 prefer
= scratch_font_prefer
;
3003 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3004 ASET (prefer
, i
, Qnil
);
3005 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3007 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3009 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3010 ASET (prefer
, i
, AREF (face_font
, i
));
3012 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3013 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3014 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3015 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3016 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3017 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3018 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3020 return font_sort_entities (entities
, prefer
, frame
, c
);
3023 /* Return a font-entity that satisfies SPEC and is the best match for
3024 face's font related attributes in ATTRS. C, if not negative, is a
3025 character that the entity must support. */
3028 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3031 Lisp_Object frame
, entities
, val
;
3032 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3036 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3037 if (NILP (registry
[0]))
3039 registry
[0] = DEFAULT_ENCODING
;
3040 registry
[1] = Qascii_0
;
3041 registry
[2] = null_vector
;
3044 registry
[1] = null_vector
;
3046 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3048 struct charset
*encoding
, *repertory
;
3050 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3051 &encoding
, &repertory
) < 0)
3054 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3056 else if (c
> encoding
->max_char
)
3060 work
= copy_font_spec (spec
);
3061 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3062 XSETFRAME (frame
, f
);
3063 pixel_size
= font_pixel_size (f
, spec
);
3064 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3066 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3068 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3070 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3071 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3072 if (! NILP (foundry
[0]))
3073 foundry
[1] = null_vector
;
3074 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3076 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3077 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3079 foundry
[2] = null_vector
;
3082 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3084 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3085 if (! NILP (adstyle
[0]))
3086 adstyle
[1] = null_vector
;
3087 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3089 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3091 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3093 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3095 adstyle
[2] = null_vector
;
3098 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3101 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3104 val
= AREF (work
, FONT_FAMILY_INDEX
);
3105 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3107 val
= attrs
[LFACE_FAMILY_INDEX
];
3108 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3112 family
= alloca ((sizeof family
[0]) * 2);
3114 family
[1] = null_vector
; /* terminator. */
3119 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3120 /* Font family names are case-sensitive under NS. */
3128 if (! NILP (alters
))
3130 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3131 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3132 family
[i
] = XCAR (alters
);
3133 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3135 family
[i
] = null_vector
;
3139 family
= alloca ((sizeof family
[0]) * 3);
3142 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3144 family
[i
] = null_vector
;
3148 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3150 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3151 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3153 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3154 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3156 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3157 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3159 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3160 entities
= font_list_entities (frame
, work
);
3161 if (! NILP (entities
))
3163 val
= font_select_entity (frame
, entities
,
3164 attrs
, pixel_size
, c
);
3177 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3181 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3182 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3183 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3184 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3185 size
= font_pixel_size (f
, spec
);
3189 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3190 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3193 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3194 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3195 if (INTEGERP (height
))
3198 abort(); /* We should never end up here. */
3202 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3206 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3207 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3211 return font_open_entity (f
, entity
, size
);
3215 /* Find a font that satisfies SPEC and is the best match for
3216 face's attributes in ATTRS on FRAME, and return the opened
3220 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3222 Lisp_Object entity
, name
;
3224 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3227 /* No font is listed for SPEC, but each font-backend may have
3228 different criteria about "font matching". So, try it. */
3229 entity
= font_matching_entity (f
, attrs
, spec
);
3233 /* Don't lose the original name that was put in initially. We need
3234 it to re-apply the font when font parameters (like hinting or dpi) have
3236 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3239 name
= Ffont_get (spec
, QCuser_spec
);
3240 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3246 /* Make FACE on frame F ready to use the font opened for FACE. */
3249 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3251 if (face
->font
->driver
->prepare_face
)
3252 face
->font
->driver
->prepare_face (f
, face
);
3256 /* Make FACE on frame F stop using the font opened for FACE. */
3259 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3261 if (face
->font
->driver
->done_face
)
3262 face
->font
->driver
->done_face (f
, face
);
3267 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3268 font is found, return Qnil. */
3271 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3273 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3275 /* We set up the default font-related attributes of a face to prefer
3277 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3278 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3279 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3281 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3283 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3285 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3287 return font_load_for_lface (f
, attrs
, spec
);
3291 /* Open a font that matches NAME on frame F. If no proper font is
3292 found, return Qnil. */
3295 font_open_by_name (FRAME_PTR f
, const char *name
)
3297 Lisp_Object args
[2];
3298 Lisp_Object spec
, ret
;
3301 args
[1] = make_unibyte_string (name
, strlen (name
));
3302 spec
= Ffont_spec (2, args
);
3303 ret
= font_open_by_spec (f
, spec
);
3304 /* Do not lose name originally put in. */
3306 font_put_extra (ret
, QCuser_spec
, args
[1]);
3312 /* Register font-driver DRIVER. This function is used in two ways.
3314 The first is with frame F non-NULL. In this case, make DRIVER
3315 available (but not yet activated) on F. All frame creators
3316 (e.g. Fx_create_frame) must call this function at least once with
3317 an available font-driver.
3319 The second is with frame F NULL. In this case, DRIVER is globally
3320 registered in the variable `font_driver_list'. All font-driver
3321 implementations must call this function in its syms_of_XXXX
3322 (e.g. syms_of_xfont). */
3325 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3327 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3328 struct font_driver_list
*prev
, *list
;
3330 if (f
&& ! driver
->draw
)
3331 error ("Unusable font driver for a frame: %s",
3332 SDATA (SYMBOL_NAME (driver
->type
)));
3334 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3335 if (EQ (list
->driver
->type
, driver
->type
))
3336 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3338 list
= xmalloc (sizeof (struct font_driver_list
));
3340 list
->driver
= driver
;
3345 f
->font_driver_list
= list
;
3347 font_driver_list
= list
;
3353 free_font_driver_list (FRAME_PTR f
)
3355 struct font_driver_list
*list
, *next
;
3357 for (list
= f
->font_driver_list
; list
; list
= next
)
3362 f
->font_driver_list
= NULL
;
3366 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3367 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3368 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3370 A caller must free all realized faces if any in advance. The
3371 return value is a list of font backends actually made used on
3375 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3377 Lisp_Object active_drivers
= Qnil
;
3378 struct font_driver_list
*list
;
3380 /* At first, turn off non-requested drivers, and turn on requested
3382 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3384 struct font_driver
*driver
= list
->driver
;
3385 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3390 if (driver
->end_for_frame
)
3391 driver
->end_for_frame (f
);
3392 font_finish_cache (f
, driver
);
3397 if (! driver
->start_for_frame
3398 || driver
->start_for_frame (f
) == 0)
3400 font_prepare_cache (f
, driver
);
3407 if (NILP (new_drivers
))
3410 if (! EQ (new_drivers
, Qt
))
3412 /* Re-order the driver list according to new_drivers. */
3413 struct font_driver_list
**list_table
, **next
;
3417 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3418 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3420 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3421 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3424 list_table
[i
++] = list
;
3426 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3428 list_table
[i
++] = list
;
3429 list_table
[i
] = NULL
;
3431 next
= &f
->font_driver_list
;
3432 for (i
= 0; list_table
[i
]; i
++)
3434 *next
= list_table
[i
];
3435 next
= &(*next
)->next
;
3439 if (! f
->font_driver_list
->on
)
3440 { /* None of the drivers is enabled: enable them all.
3441 Happens if you set the list of drivers to (xft x) in your .emacs
3442 and then use it under w32 or ns. */
3443 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3445 struct font_driver
*driver
= list
->driver
;
3446 eassert (! list
->on
);
3447 if (! driver
->start_for_frame
3448 || driver
->start_for_frame (f
) == 0)
3450 font_prepare_cache (f
, driver
);
3457 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3459 active_drivers
= nconc2 (active_drivers
,
3460 Fcons (list
->driver
->type
, Qnil
));
3461 return active_drivers
;
3465 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3467 struct font_data_list
*list
, *prev
;
3469 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3470 prev
= list
, list
= list
->next
)
3471 if (list
->driver
== driver
)
3478 prev
->next
= list
->next
;
3480 f
->font_data_list
= list
->next
;
3488 list
= xmalloc (sizeof (struct font_data_list
));
3489 list
->driver
= driver
;
3490 list
->next
= f
->font_data_list
;
3491 f
->font_data_list
= list
;
3499 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3501 struct font_data_list
*list
;
3503 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3504 if (list
->driver
== driver
)
3512 /* Sets attributes on a font. Any properties that appear in ALIST and
3513 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3514 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3515 arrays of strings. This function is intended for use by the font
3516 drivers to implement their specific font_filter_properties. */
3518 font_filter_properties (Lisp_Object font
,
3520 const char *const boolean_properties
[],
3521 const char *const non_boolean_properties
[])
3526 /* Set boolean values to Qt or Qnil */
3527 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3528 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3530 Lisp_Object key
= XCAR (XCAR (it
));
3531 Lisp_Object val
= XCDR (XCAR (it
));
3532 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3534 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3536 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3537 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3540 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3541 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3542 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3543 || strcmp ("Off", str
) == 0)
3548 Ffont_put (font
, key
, val
);
3552 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3553 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3555 Lisp_Object key
= XCAR (XCAR (it
));
3556 Lisp_Object val
= XCDR (XCAR (it
));
3557 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3558 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3559 Ffont_put (font
, key
, val
);
3564 /* Return the font used to draw character C by FACE at buffer position
3565 POS in window W. If STRING is non-nil, it is a string containing C
3566 at index POS. If C is negative, get C from the current buffer or
3570 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3575 Lisp_Object font_object
;
3577 multibyte
= (NILP (string
)
3578 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3579 : STRING_MULTIBYTE (string
));
3586 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3588 c
= FETCH_CHAR (pos_byte
);
3591 c
= FETCH_BYTE (pos
);
3597 multibyte
= STRING_MULTIBYTE (string
);
3600 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3602 str
= SDATA (string
) + pos_byte
;
3603 c
= STRING_CHAR (str
);
3606 c
= SDATA (string
)[pos
];
3610 f
= XFRAME (w
->frame
);
3611 if (! FRAME_WINDOW_P (f
))
3618 if (STRINGP (string
))
3619 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3620 DEFAULT_FACE_ID
, 0);
3622 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3624 face
= FACE_FROM_ID (f
, face_id
);
3628 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3629 face
= FACE_FROM_ID (f
, face_id
);
3634 XSETFONT (font_object
, face
->font
);
3639 #ifdef HAVE_WINDOW_SYSTEM
3641 /* Check how many characters after POS (at most to *LIMIT) can be
3642 displayed by the same font in the window W. FACE, if non-NULL, is
3643 the face selected for the character at POS. If STRING is not nil,
3644 it is the string to check instead of the current buffer. In that
3645 case, FACE must be not NULL.
3647 The return value is the font-object for the character at POS.
3648 *LIMIT is set to the position where that font can't be used.
3650 It is assured that the current buffer (or STRING) is multibyte. */
3653 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3655 EMACS_INT pos_byte
, ignore
;
3657 Lisp_Object font_object
= Qnil
;
3661 pos_byte
= CHAR_TO_BYTE (pos
);
3666 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3668 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3674 pos_byte
= string_char_to_byte (string
, pos
);
3677 while (pos
< *limit
)
3679 Lisp_Object category
;
3682 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3684 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3685 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3686 if (INTEGERP (category
)
3687 && (XINT (category
) == UNICODE_CATEGORY_Cf
3688 || CHAR_VARIATION_SELECTOR_P (c
)))
3690 if (NILP (font_object
))
3692 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3693 if (NILP (font_object
))
3697 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3707 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3708 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3709 Return nil otherwise.
3710 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3711 which kind of font it is. It must be one of `font-spec', `font-entity',
3713 (Lisp_Object object
, Lisp_Object extra_type
)
3715 if (NILP (extra_type
))
3716 return (FONTP (object
) ? Qt
: Qnil
);
3717 if (EQ (extra_type
, Qfont_spec
))
3718 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3719 if (EQ (extra_type
, Qfont_entity
))
3720 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3721 if (EQ (extra_type
, Qfont_object
))
3722 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3723 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3726 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3727 doc
: /* Return a newly created font-spec with arguments as properties.
3729 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3730 valid font property name listed below:
3732 `:family', `:weight', `:slant', `:width'
3734 They are the same as face attributes of the same name. See
3735 `set-face-attribute'.
3739 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3743 VALUE must be a string or a symbol specifying the additional
3744 typographic style information of a font, e.g. ``sans''.
3748 VALUE must be a string or a symbol specifying the charset registry and
3749 encoding of a font, e.g. ``iso8859-1''.
3753 VALUE must be a non-negative integer or a floating point number
3754 specifying the font size. It specifies the font size in pixels (if
3755 VALUE is an integer), or in points (if VALUE is a float).
3759 VALUE must be a string of XLFD-style or fontconfig-style font name.
3763 VALUE must be a symbol representing a script that the font must
3764 support. It may be a symbol representing a subgroup of a script
3765 listed in the variable `script-representative-chars'.
3769 VALUE must be a symbol of two-letter ISO-639 language names,
3774 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3775 required OpenType features.
3777 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3778 LANGSYS-TAG: OpenType language system tag symbol,
3779 or nil for the default language system.
3780 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3781 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3783 GSUB and GPOS may contain `nil' element. In such a case, the font
3784 must not have any of the remaining elements.
3786 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3787 be an OpenType font whose GPOS table of `thai' script's default
3788 language system must contain `mark' feature.
3790 usage: (font-spec ARGS...) */)
3791 (ptrdiff_t nargs
, Lisp_Object
*args
)
3793 Lisp_Object spec
= font_make_spec ();
3796 for (i
= 0; i
< nargs
; i
+= 2)
3798 Lisp_Object key
= args
[i
], val
;
3802 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3805 if (EQ (key
, QCname
))
3808 font_parse_name (SSDATA (val
), spec
);
3809 font_put_extra (spec
, key
, val
);
3813 int idx
= get_font_prop_index (key
);
3817 val
= font_prop_validate (idx
, Qnil
, val
);
3818 if (idx
< FONT_EXTRA_INDEX
)
3819 ASET (spec
, idx
, val
);
3821 font_put_extra (spec
, key
, val
);
3824 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3830 /* Return a copy of FONT as a font-spec. */
3832 copy_font_spec (Lisp_Object font
)
3834 Lisp_Object new_spec
, tail
, prev
, extra
;
3838 new_spec
= font_make_spec ();
3839 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3840 ASET (new_spec
, i
, AREF (font
, i
));
3841 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3842 /* We must remove :font-entity property. */
3843 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3844 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3847 extra
= XCDR (extra
);
3849 XSETCDR (prev
, XCDR (tail
));
3852 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3856 /* Merge font-specs FROM and TO, and return a new font-spec.
3857 Every specified property in FROM overrides the corresponding
3860 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3862 Lisp_Object extra
, tail
;
3867 to
= copy_font_spec (to
);
3868 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3869 ASET (to
, i
, AREF (from
, i
));
3870 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3871 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3872 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3874 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3877 XSETCDR (slot
, XCDR (XCAR (tail
)));
3879 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3881 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3885 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3886 doc
: /* Return the value of FONT's property KEY.
3887 FONT is a font-spec, a font-entity, or a font-object.
3888 KEY is any symbol, but these are reserved for specific meanings:
3889 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3890 :size, :name, :script, :otf
3891 See the documentation of `font-spec' for their meanings.
3892 In addition, if FONT is a font-entity or a font-object, values of
3893 :script and :otf are different from those of a font-spec as below:
3895 The value of :script may be a list of scripts that are supported by the font.
3897 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3898 representing the OpenType features supported by the font by this form:
3899 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3900 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3902 (Lisp_Object font
, Lisp_Object key
)
3910 idx
= get_font_prop_index (key
);
3911 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3912 return font_style_symbolic (font
, idx
, 0);
3913 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3914 return AREF (font
, idx
);
3915 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3916 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3918 struct font
*fontp
= XFONT_OBJECT (font
);
3920 if (fontp
->driver
->otf_capability
)
3921 val
= fontp
->driver
->otf_capability (fontp
);
3923 val
= Fcons (Qnil
, Qnil
);
3930 #ifdef HAVE_WINDOW_SYSTEM
3932 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3933 doc
: /* Return a plist of face attributes generated by FONT.
3934 FONT is a font name, a font-spec, a font-entity, or a font-object.
3935 The return value is a list of the form
3937 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3939 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3940 compatible with `set-face-attribute'. Some of these key-attribute pairs
3941 may be omitted from the list if they are not specified by FONT.
3943 The optional argument FRAME specifies the frame that the face attributes
3944 are to be displayed on. If omitted, the selected frame is used. */)
3945 (Lisp_Object font
, Lisp_Object frame
)
3948 Lisp_Object plist
[10];
3953 frame
= selected_frame
;
3954 CHECK_LIVE_FRAME (frame
);
3959 int fontset
= fs_query_fontset (font
, 0);
3960 Lisp_Object name
= font
;
3962 font
= fontset_ascii (fontset
);
3963 font
= font_spec_from_name (name
);
3965 signal_error ("Invalid font name", name
);
3967 else if (! FONTP (font
))
3968 signal_error ("Invalid font object", font
);
3970 val
= AREF (font
, FONT_FAMILY_INDEX
);
3973 plist
[n
++] = QCfamily
;
3974 plist
[n
++] = SYMBOL_NAME (val
);
3977 val
= AREF (font
, FONT_SIZE_INDEX
);
3980 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3981 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3982 plist
[n
++] = QCheight
;
3983 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
3985 else if (FLOATP (val
))
3987 plist
[n
++] = QCheight
;
3988 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3991 val
= FONT_WEIGHT_FOR_FACE (font
);
3994 plist
[n
++] = QCweight
;
3998 val
= FONT_SLANT_FOR_FACE (font
);
4001 plist
[n
++] = QCslant
;
4005 val
= FONT_WIDTH_FOR_FACE (font
);
4008 plist
[n
++] = QCwidth
;
4012 return Flist (n
, plist
);
4017 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4018 doc
: /* Set one property of FONT: give property KEY value VAL.
4019 FONT is a font-spec, a font-entity, or a font-object.
4021 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4022 accepted by the function `font-spec' (which see), VAL must be what
4023 allowed in `font-spec'.
4025 If FONT is a font-entity or a font-object, KEY must not be the one
4026 accepted by `font-spec'. */)
4027 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4031 idx
= get_font_prop_index (prop
);
4032 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4034 CHECK_FONT_SPEC (font
);
4035 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4039 if (EQ (prop
, QCname
)
4040 || EQ (prop
, QCscript
)
4041 || EQ (prop
, QClang
)
4042 || EQ (prop
, QCotf
))
4043 CHECK_FONT_SPEC (font
);
4046 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4051 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4052 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4053 Optional 2nd argument FRAME specifies the target frame.
4054 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4055 Optional 4th argument PREFER, if non-nil, is a font-spec to
4056 control the order of the returned list. Fonts are sorted by
4057 how close they are to PREFER. */)
4058 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4060 Lisp_Object vec
, list
;
4064 frame
= selected_frame
;
4065 CHECK_LIVE_FRAME (frame
);
4066 CHECK_FONT_SPEC (font_spec
);
4074 if (! NILP (prefer
))
4075 CHECK_FONT_SPEC (prefer
);
4077 list
= font_list_entities (frame
, font_spec
);
4080 if (NILP (XCDR (list
))
4081 && ASIZE (XCAR (list
)) == 1)
4082 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4084 if (! NILP (prefer
))
4085 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4087 vec
= font_vconcat_entity_vectors (list
);
4088 if (n
== 0 || n
>= ASIZE (vec
))
4090 Lisp_Object args
[2];
4094 list
= Fappend (2, args
);
4098 for (list
= Qnil
, n
--; n
>= 0; n
--)
4099 list
= Fcons (AREF (vec
, n
), list
);
4104 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4105 doc
: /* List available font families on the current frame.
4106 Optional argument FRAME, if non-nil, specifies the target frame. */)
4110 struct font_driver_list
*driver_list
;
4114 frame
= selected_frame
;
4115 CHECK_LIVE_FRAME (frame
);
4118 for (driver_list
= f
->font_driver_list
; driver_list
;
4119 driver_list
= driver_list
->next
)
4120 if (driver_list
->driver
->list_family
)
4122 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4123 Lisp_Object tail
= list
;
4125 for (; CONSP (val
); val
= XCDR (val
))
4126 if (NILP (Fmemq (XCAR (val
), tail
))
4127 && SYMBOLP (XCAR (val
)))
4128 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4133 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4134 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4135 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4136 (Lisp_Object font_spec
, Lisp_Object frame
)
4138 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4145 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4146 doc
: /* Return XLFD name of FONT.
4147 FONT is a font-spec, font-entity, or font-object.
4148 If the name is too long for XLFD (maximum 255 chars), return nil.
4149 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4150 the consecutive wildcards are folded into one. */)
4151 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4158 if (FONT_OBJECT_P (font
))
4160 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4162 if (STRINGP (font_name
)
4163 && SDATA (font_name
)[0] == '-')
4165 if (NILP (fold_wildcards
))
4167 strcpy (name
, SSDATA (font_name
));
4170 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4172 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4175 if (! NILP (fold_wildcards
))
4177 char *p0
= name
, *p1
;
4179 while ((p1
= strstr (p0
, "-*-*")))
4181 strcpy (p1
, p1
+ 2);
4186 return build_string (name
);
4189 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4190 doc
: /* Clear font cache. */)
4193 Lisp_Object list
, frame
;
4195 FOR_EACH_FRAME (list
, frame
)
4197 FRAME_PTR f
= XFRAME (frame
);
4198 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4200 for (; driver_list
; driver_list
= driver_list
->next
)
4201 if (driver_list
->on
)
4203 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4204 Lisp_Object val
, tmp
;
4208 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4210 font_assert (! NILP (val
));
4211 tmp
= XCDR (XCAR (val
));
4212 if (XINT (XCAR (tmp
)) == 0)
4214 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4215 XSETCDR (cache
, XCDR (val
));
4225 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4227 struct font
*font
= XFONT_OBJECT (font_object
);
4229 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4230 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4231 struct font_metrics metrics
;
4233 LGLYPH_SET_CODE (glyph
, ecode
);
4235 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4236 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4237 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4238 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4239 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4240 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4244 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4245 doc
: /* Shape the glyph-string GSTRING.
4246 Shaping means substituting glyphs and/or adjusting positions of glyphs
4247 to get the correct visual image of character sequences set in the
4248 header of the glyph-string.
4250 If the shaping was successful, the value is GSTRING itself or a newly
4251 created glyph-string. Otherwise, the value is nil. */)
4252 (Lisp_Object gstring
)
4255 Lisp_Object font_object
, n
, glyph
;
4256 EMACS_INT i
, j
, from
, to
;
4258 if (! composition_gstring_p (gstring
))
4259 signal_error ("Invalid glyph-string: ", gstring
);
4260 if (! NILP (LGSTRING_ID (gstring
)))
4262 font_object
= LGSTRING_FONT (gstring
);
4263 CHECK_FONT_OBJECT (font_object
);
4264 font
= XFONT_OBJECT (font_object
);
4265 if (! font
->driver
->shape
)
4268 /* Try at most three times with larger gstring each time. */
4269 for (i
= 0; i
< 3; i
++)
4271 n
= font
->driver
->shape (gstring
);
4274 gstring
= larger_vector (gstring
,
4275 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4278 if (i
== 3 || XINT (n
) == 0)
4280 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4281 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4283 glyph
= LGSTRING_GLYPH (gstring
, 0);
4284 from
= LGLYPH_FROM (glyph
);
4285 to
= LGLYPH_TO (glyph
);
4286 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4288 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4292 if (NILP (LGLYPH_ADJUSTMENT (this)))
4297 glyph
= LGSTRING_GLYPH (gstring
, j
);
4298 LGLYPH_SET_FROM (glyph
, from
);
4299 LGLYPH_SET_TO (glyph
, to
);
4301 from
= LGLYPH_FROM (this);
4302 to
= LGLYPH_TO (this);
4307 if (from
> LGLYPH_FROM (this))
4308 from
= LGLYPH_FROM (this);
4309 if (to
< LGLYPH_TO (this))
4310 to
= LGLYPH_TO (this);
4316 glyph
= LGSTRING_GLYPH (gstring
, j
);
4317 LGLYPH_SET_FROM (glyph
, from
);
4318 LGLYPH_SET_TO (glyph
, to
);
4320 return composition_gstring_put_cache (gstring
, XINT (n
));
4323 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4325 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4326 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4328 VARIATION-SELECTOR is a character code of variation selection
4329 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4330 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4331 (Lisp_Object font_object
, Lisp_Object character
)
4333 unsigned variations
[256];
4338 CHECK_FONT_OBJECT (font_object
);
4339 CHECK_CHARACTER (character
);
4340 font
= XFONT_OBJECT (font_object
);
4341 if (! font
->driver
->get_variation_glyphs
)
4343 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4347 for (i
= 0; i
< 255; i
++)
4350 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4351 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4352 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4359 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4360 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4361 OTF-FEATURES specifies which features to apply in this format:
4362 (SCRIPT LANGSYS GSUB GPOS)
4364 SCRIPT is a symbol specifying a script tag of OpenType,
4365 LANGSYS is a symbol specifying a langsys tag of OpenType,
4366 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4368 If LANGYS is nil, the default langsys is selected.
4370 The features are applied in the order they appear in the list. The
4371 symbol `*' means to apply all available features not present in this
4372 list, and the remaining features are ignored. For instance, (vatu
4373 pstf * haln) is to apply vatu and pstf in this order, then to apply
4374 all available features other than vatu, pstf, and haln.
4376 The features are applied to the glyphs in the range FROM and TO of
4377 the glyph-string GSTRING-IN.
4379 If some feature is actually applicable, the resulting glyphs are
4380 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4381 this case, the value is the number of produced glyphs.
4383 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4386 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4387 produced in GSTRING-OUT, and the value is nil.
4389 See the documentation of `composition-get-gstring' for the format of
4391 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4393 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4398 check_otf_features (otf_features
);
4399 CHECK_FONT_OBJECT (font_object
);
4400 font
= XFONT_OBJECT (font_object
);
4401 if (! font
->driver
->otf_drive
)
4402 error ("Font backend %s can't drive OpenType GSUB table",
4403 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4404 CHECK_CONS (otf_features
);
4405 CHECK_SYMBOL (XCAR (otf_features
));
4406 val
= XCDR (otf_features
);
4407 CHECK_SYMBOL (XCAR (val
));
4408 val
= XCDR (otf_features
);
4411 len
= check_gstring (gstring_in
);
4412 CHECK_VECTOR (gstring_out
);
4413 CHECK_NATNUM (from
);
4415 CHECK_NATNUM (index
);
4417 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4418 args_out_of_range_3 (from
, to
, make_number (len
));
4419 if (XINT (index
) >= ASIZE (gstring_out
))
4420 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4421 num
= font
->driver
->otf_drive (font
, otf_features
,
4422 gstring_in
, XINT (from
), XINT (to
),
4423 gstring_out
, XINT (index
), 0);
4426 return make_number (num
);
4429 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4431 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4432 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4434 (SCRIPT LANGSYS FEATURE ...)
4435 See the documentation of `font-drive-otf' for more detail.
4437 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4438 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4439 character code corresponding to the glyph or nil if there's no
4440 corresponding character. */)
4441 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4444 Lisp_Object gstring_in
, gstring_out
, g
;
4445 Lisp_Object alternates
;
4448 CHECK_FONT_GET_OBJECT (font_object
, font
);
4449 if (! font
->driver
->otf_drive
)
4450 error ("Font backend %s can't drive OpenType GSUB table",
4451 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4452 CHECK_CHARACTER (character
);
4453 CHECK_CONS (otf_features
);
4455 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4456 g
= LGSTRING_GLYPH (gstring_in
, 0);
4457 LGLYPH_SET_CHAR (g
, XINT (character
));
4458 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4459 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4460 gstring_out
, 0, 1)) < 0)
4461 gstring_out
= Ffont_make_gstring (font_object
,
4462 make_number (ASIZE (gstring_out
) * 2));
4464 for (i
= 0; i
< num
; i
++)
4466 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4467 int c
= LGLYPH_CHAR (g
);
4468 unsigned code
= LGLYPH_CODE (g
);
4470 alternates
= Fcons (Fcons (make_number (code
),
4471 c
> 0 ? make_number (c
) : Qnil
),
4474 return Fnreverse (alternates
);
4480 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4481 doc
: /* Open FONT-ENTITY. */)
4482 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4486 CHECK_FONT_ENTITY (font_entity
);
4488 frame
= selected_frame
;
4489 CHECK_LIVE_FRAME (frame
);
4492 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4495 CHECK_NUMBER_OR_FLOAT (size
);
4497 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4499 isize
= XINT (size
);
4503 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4506 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4507 doc
: /* Close FONT-OBJECT. */)
4508 (Lisp_Object font_object
, Lisp_Object frame
)
4510 CHECK_FONT_OBJECT (font_object
);
4512 frame
= selected_frame
;
4513 CHECK_LIVE_FRAME (frame
);
4514 font_close_object (XFRAME (frame
), font_object
);
4518 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4519 doc
: /* Return information about FONT-OBJECT.
4520 The value is a vector:
4521 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4524 NAME is the font name, a string (or nil if the font backend doesn't
4527 FILENAME is the font file name, a string (or nil if the font backend
4528 doesn't provide a file name).
4530 PIXEL-SIZE is a pixel size by which the font is opened.
4532 SIZE is a maximum advance width of the font in pixels.
4534 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4537 CAPABILITY is a list whose first element is a symbol representing the
4538 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4539 remaining elements describe the details of the font capability.
4541 If the font is OpenType font, the form of the list is
4542 \(opentype GSUB GPOS)
4543 where GSUB shows which "GSUB" features the font supports, and GPOS
4544 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4545 lists of the format:
4546 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4548 If the font is not OpenType font, currently the length of the form is
4551 SCRIPT is a symbol representing OpenType script tag.
4553 LANGSYS is a symbol representing OpenType langsys tag, or nil
4554 representing the default langsys.
4556 FEATURE is a symbol representing OpenType feature tag.
4558 If the font is not OpenType font, CAPABILITY is nil. */)
4559 (Lisp_Object font_object
)
4564 CHECK_FONT_GET_OBJECT (font_object
, font
);
4566 val
= Fmake_vector (make_number (9), Qnil
);
4567 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4568 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4569 ASET (val
, 2, make_number (font
->pixel_size
));
4570 ASET (val
, 3, make_number (font
->max_width
));
4571 ASET (val
, 4, make_number (font
->ascent
));
4572 ASET (val
, 5, make_number (font
->descent
));
4573 ASET (val
, 6, make_number (font
->space_width
));
4574 ASET (val
, 7, make_number (font
->average_width
));
4575 if (font
->driver
->otf_capability
)
4576 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4580 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4582 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4583 FROM and TO are positions (integers or markers) specifying a region
4584 of the current buffer.
4585 If the optional fourth arg OBJECT is not nil, it is a string or a
4586 vector containing the target characters.
4588 Each element is a vector containing information of a glyph in this format:
4589 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4591 FROM is an index numbers of a character the glyph corresponds to.
4592 TO is the same as FROM.
4593 C is the character of the glyph.
4594 CODE is the glyph-code of C in FONT-OBJECT.
4595 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4596 ADJUSTMENT is always nil.
4597 If FONT-OBJECT doesn't have a glyph for a character,
4598 the corresponding element is nil. */)
4599 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4604 Lisp_Object
*chars
, vec
;
4607 CHECK_FONT_GET_OBJECT (font_object
, font
);
4610 EMACS_INT charpos
, bytepos
;
4612 validate_region (&from
, &to
);
4615 len
= XFASTINT (to
) - XFASTINT (from
);
4616 SAFE_ALLOCA_LISP (chars
, len
);
4617 charpos
= XFASTINT (from
);
4618 bytepos
= CHAR_TO_BYTE (charpos
);
4619 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4622 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4623 chars
[i
] = make_number (c
);
4626 else if (STRINGP (object
))
4628 const unsigned char *p
;
4630 CHECK_NUMBER (from
);
4632 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4633 || XINT (to
) > SCHARS (object
))
4634 args_out_of_range_3 (object
, from
, to
);
4637 len
= XFASTINT (to
) - XFASTINT (from
);
4638 SAFE_ALLOCA_LISP (chars
, len
);
4640 if (STRING_MULTIBYTE (object
))
4641 for (i
= 0; i
< len
; i
++)
4643 int c
= STRING_CHAR_ADVANCE (p
);
4644 chars
[i
] = make_number (c
);
4647 for (i
= 0; i
< len
; i
++)
4648 chars
[i
] = make_number (p
[i
]);
4652 CHECK_VECTOR (object
);
4653 CHECK_NUMBER (from
);
4655 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4656 || XINT (to
) > ASIZE (object
))
4657 args_out_of_range_3 (object
, from
, to
);
4660 len
= XFASTINT (to
) - XFASTINT (from
);
4661 for (i
= 0; i
< len
; i
++)
4663 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4664 CHECK_CHARACTER (elt
);
4666 chars
= &(AREF (object
, XFASTINT (from
)));
4669 vec
= Fmake_vector (make_number (len
), Qnil
);
4670 for (i
= 0; i
< len
; i
++)
4673 int c
= XFASTINT (chars
[i
]);
4675 struct font_metrics metrics
;
4677 code
= font
->driver
->encode_char (font
, c
);
4678 if (code
== FONT_INVALID_CODE
)
4680 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4681 LGLYPH_SET_FROM (g
, i
);
4682 LGLYPH_SET_TO (g
, i
);
4683 LGLYPH_SET_CHAR (g
, c
);
4684 LGLYPH_SET_CODE (g
, code
);
4685 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4686 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4687 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4688 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4689 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4690 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4693 if (! VECTORP (object
))
4698 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4699 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4700 FONT is a font-spec, font-entity, or font-object. */)
4701 (Lisp_Object spec
, Lisp_Object font
)
4703 CHECK_FONT_SPEC (spec
);
4706 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4709 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4710 doc
: /* Return a font-object for displaying a character at POSITION.
4711 Optional second arg WINDOW, if non-nil, is a window displaying
4712 the current buffer. It defaults to the currently selected window. */)
4713 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4720 CHECK_NUMBER_COERCE_MARKER (position
);
4721 pos
= XINT (position
);
4722 if (pos
< BEGV
|| pos
>= ZV
)
4723 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4727 CHECK_NUMBER (position
);
4728 CHECK_STRING (string
);
4729 pos
= XINT (position
);
4730 if (pos
< 0 || pos
>= SCHARS (string
))
4731 args_out_of_range (string
, position
);
4734 window
= selected_window
;
4735 CHECK_LIVE_WINDOW (window
);
4736 w
= XWINDOW (window
);
4738 return font_at (-1, pos
, NULL
, w
, string
);
4742 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4743 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4744 The value is a number of glyphs drawn.
4745 Type C-l to recover what previously shown. */)
4746 (Lisp_Object font_object
, Lisp_Object string
)
4748 Lisp_Object frame
= selected_frame
;
4749 FRAME_PTR f
= XFRAME (frame
);
4755 CHECK_FONT_GET_OBJECT (font_object
, font
);
4756 CHECK_STRING (string
);
4757 len
= SCHARS (string
);
4758 code
= alloca (sizeof (unsigned) * len
);
4759 for (i
= 0; i
< len
; i
++)
4761 Lisp_Object ch
= Faref (string
, make_number (i
));
4765 code
[i
] = font
->driver
->encode_char (font
, c
);
4766 if (code
[i
] == FONT_INVALID_CODE
)
4769 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4771 if (font
->driver
->prepare_face
)
4772 font
->driver
->prepare_face (f
, face
);
4773 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4774 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4775 if (font
->driver
->done_face
)
4776 font
->driver
->done_face (f
, face
);
4778 return make_number (len
);
4782 #endif /* FONT_DEBUG */
4784 #ifdef HAVE_WINDOW_SYSTEM
4786 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4787 doc
: /* Return information about a font named NAME on frame FRAME.
4788 If FRAME is omitted or nil, use the selected frame.
4789 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4790 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4792 OPENED-NAME is the name used for opening the font,
4793 FULL-NAME is the full name of the font,
4794 SIZE is the pixelsize of the font,
4795 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4796 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4797 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4798 how to compose characters.
4799 If the named font is not yet loaded, return nil. */)
4800 (Lisp_Object name
, Lisp_Object frame
)
4805 Lisp_Object font_object
;
4807 (*check_window_system_func
) ();
4810 CHECK_STRING (name
);
4812 frame
= selected_frame
;
4813 CHECK_LIVE_FRAME (frame
);
4818 int fontset
= fs_query_fontset (name
, 0);
4821 name
= fontset_ascii (fontset
);
4822 font_object
= font_open_by_name (f
, SSDATA (name
));
4824 else if (FONT_OBJECT_P (name
))
4826 else if (FONT_ENTITY_P (name
))
4827 font_object
= font_open_entity (f
, name
, 0);
4830 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4831 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4833 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4835 if (NILP (font_object
))
4837 font
= XFONT_OBJECT (font_object
);
4839 info
= Fmake_vector (make_number (7), Qnil
);
4840 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4841 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4842 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4843 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4844 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4845 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4846 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4849 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4850 close it now. Perhaps, we should manage font-objects
4851 by `reference-count'. */
4852 font_close_object (f
, font_object
);
4859 #define BUILD_STYLE_TABLE(TBL) \
4860 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4863 build_style_table (const struct table_entry
*entry
, int nelement
)
4866 Lisp_Object table
, elt
;
4868 table
= Fmake_vector (make_number (nelement
), Qnil
);
4869 for (i
= 0; i
< nelement
; i
++)
4871 for (j
= 0; entry
[i
].names
[j
]; j
++);
4872 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4873 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4874 for (j
= 0; entry
[i
].names
[j
]; j
++)
4875 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4876 ASET (table
, i
, elt
);
4881 /* The deferred font-log data of the form [ACTION ARG RESULT].
4882 If ACTION is not nil, that is added to the log when font_add_log is
4883 called next time. At that time, ACTION is set back to nil. */
4884 static Lisp_Object Vfont_log_deferred
;
4886 /* Prepend the font-related logging data in Vfont_log if it is not
4887 `t'. ACTION describes a kind of font-related action (e.g. listing,
4888 opening), ARG is the argument for the action, and RESULT is the
4889 result of the action. */
4891 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4896 if (EQ (Vfont_log
, Qt
))
4898 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4900 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4902 ASET (Vfont_log_deferred
, 0, Qnil
);
4903 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4904 AREF (Vfont_log_deferred
, 2));
4909 Lisp_Object tail
, elt
;
4910 Lisp_Object equalstr
= build_string ("=");
4912 val
= Ffont_xlfd_name (arg
, Qt
);
4913 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4917 if (EQ (XCAR (elt
), QCscript
)
4918 && SYMBOLP (XCDR (elt
)))
4919 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4920 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4921 else if (EQ (XCAR (elt
), QClang
)
4922 && SYMBOLP (XCDR (elt
)))
4923 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4924 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4925 else if (EQ (XCAR (elt
), QCotf
)
4926 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4927 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4929 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4935 && VECTORP (XCAR (result
))
4936 && ASIZE (XCAR (result
)) > 0
4937 && FONTP (AREF (XCAR (result
), 0)))
4938 result
= font_vconcat_entity_vectors (result
);
4941 val
= Ffont_xlfd_name (result
, Qt
);
4942 if (! FONT_SPEC_P (result
))
4943 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4944 build_string (":"), val
);
4947 else if (CONSP (result
))
4950 result
= Fcopy_sequence (result
);
4951 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4955 val
= Ffont_xlfd_name (val
, Qt
);
4956 XSETCAR (tail
, val
);
4959 else if (VECTORP (result
))
4961 result
= Fcopy_sequence (result
);
4962 for (i
= 0; i
< ASIZE (result
); i
++)
4964 val
= AREF (result
, i
);
4966 val
= Ffont_xlfd_name (val
, Qt
);
4967 ASET (result
, i
, val
);
4970 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4973 /* Record a font-related logging data to be added to Vfont_log when
4974 font_add_log is called next time. ACTION, ARG, RESULT are the same
4978 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4980 if (EQ (Vfont_log
, Qt
))
4982 ASET (Vfont_log_deferred
, 0, build_string (action
));
4983 ASET (Vfont_log_deferred
, 1, arg
);
4984 ASET (Vfont_log_deferred
, 2, result
);
4990 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4991 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4992 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4993 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4994 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4995 /* Note that the other elements in sort_shift_bits are not used. */
4997 staticpro (&font_charset_alist
);
4998 font_charset_alist
= Qnil
;
5000 DEFSYM (Qopentype
, "opentype");
5002 DEFSYM (Qascii_0
, "ascii-0");
5003 DEFSYM (Qiso8859_1
, "iso8859-1");
5004 DEFSYM (Qiso10646_1
, "iso10646-1");
5005 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5006 DEFSYM (Qunicode_sip
, "unicode-sip");
5010 DEFSYM (QCotf
, ":otf");
5011 DEFSYM (QClang
, ":lang");
5012 DEFSYM (QCscript
, ":script");
5013 DEFSYM (QCantialias
, ":antialias");
5015 DEFSYM (QCfoundry
, ":foundry");
5016 DEFSYM (QCadstyle
, ":adstyle");
5017 DEFSYM (QCregistry
, ":registry");
5018 DEFSYM (QCspacing
, ":spacing");
5019 DEFSYM (QCdpi
, ":dpi");
5020 DEFSYM (QCscalable
, ":scalable");
5021 DEFSYM (QCavgwidth
, ":avgwidth");
5022 DEFSYM (QCfont_entity
, ":font-entity");
5023 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5033 DEFSYM (QCuser_spec
, "user-spec");
5035 staticpro (&null_vector
);
5036 null_vector
= Fmake_vector (make_number (0), Qnil
);
5038 staticpro (&scratch_font_spec
);
5039 scratch_font_spec
= Ffont_spec (0, NULL
);
5040 staticpro (&scratch_font_prefer
);
5041 scratch_font_prefer
= Ffont_spec (0, NULL
);
5043 staticpro (&Vfont_log_deferred
);
5044 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5048 staticpro (&otf_list
);
5050 #endif /* HAVE_LIBOTF */
5054 defsubr (&Sfont_spec
);
5055 defsubr (&Sfont_get
);
5056 #ifdef HAVE_WINDOW_SYSTEM
5057 defsubr (&Sfont_face_attributes
);
5059 defsubr (&Sfont_put
);
5060 defsubr (&Slist_fonts
);
5061 defsubr (&Sfont_family_list
);
5062 defsubr (&Sfind_font
);
5063 defsubr (&Sfont_xlfd_name
);
5064 defsubr (&Sclear_font_cache
);
5065 defsubr (&Sfont_shape_gstring
);
5066 defsubr (&Sfont_variation_glyphs
);
5068 defsubr (&Sfont_drive_otf
);
5069 defsubr (&Sfont_otf_alternates
);
5073 defsubr (&Sopen_font
);
5074 defsubr (&Sclose_font
);
5075 defsubr (&Squery_font
);
5076 defsubr (&Sfont_get_glyphs
);
5077 defsubr (&Sfont_match_p
);
5078 defsubr (&Sfont_at
);
5080 defsubr (&Sdraw_string
);
5082 #endif /* FONT_DEBUG */
5083 #ifdef HAVE_WINDOW_SYSTEM
5084 defsubr (&Sfont_info
);
5087 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5089 Alist of fontname patterns vs the corresponding encoding and repertory info.
5090 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5091 where ENCODING is a charset or a char-table,
5092 and REPERTORY is a charset, a char-table, or nil.
5094 If ENCODING and REPERTORY are the same, the element can have the form
5095 \(REGEXP . ENCODING).
5097 ENCODING is for converting a character to a glyph code of the font.
5098 If ENCODING is a charset, encoding a character by the charset gives
5099 the corresponding glyph code. If ENCODING is a char-table, looking up
5100 the table by a character gives the corresponding glyph code.
5102 REPERTORY specifies a repertory of characters supported by the font.
5103 If REPERTORY is a charset, all characters beloging to the charset are
5104 supported. If REPERTORY is a char-table, all characters who have a
5105 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5106 gets the repertory information by an opened font and ENCODING. */);
5107 Vfont_encoding_alist
= Qnil
;
5109 /* FIXME: These 3 vars are not quite what they appear: setq on them
5110 won't have any effect other than disconnect them from the style
5111 table used by the font display code. So we make them read-only,
5112 to avoid this confusing situation. */
5114 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5115 doc
: /* Vector of valid font weight values.
5116 Each element has the form:
5117 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5118 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5119 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5120 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5122 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5123 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5124 See `font-weight-table' for the format of the vector. */);
5125 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5126 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5128 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5129 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5130 See `font-weight-table' for the format of the vector. */);
5131 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5132 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5134 staticpro (&font_style_table
);
5135 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5136 ASET (font_style_table
, 0, Vfont_weight_table
);
5137 ASET (font_style_table
, 1, Vfont_slant_table
);
5138 ASET (font_style_table
, 2, Vfont_width_table
);
5140 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5141 *Logging list of font related actions and results.
5142 The value t means to suppress the logging.
5143 The initial value is set to nil if the environment variable
5144 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5147 #ifdef HAVE_WINDOW_SYSTEM
5148 #ifdef HAVE_FREETYPE
5150 #ifdef HAVE_X_WINDOWS
5155 #endif /* HAVE_XFT */
5156 #endif /* HAVE_X_WINDOWS */
5157 #else /* not HAVE_FREETYPE */
5158 #ifdef HAVE_X_WINDOWS
5160 #endif /* HAVE_X_WINDOWS */
5161 #endif /* not HAVE_FREETYPE */
5164 #endif /* HAVE_BDFFONT */
5167 #endif /* WINDOWSNT */
5170 #endif /* HAVE_NS */
5171 #endif /* HAVE_WINDOW_SYSTEM */
5177 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;