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
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1289 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1290 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1291 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1292 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1293 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1294 f
[XLFD_REGISTRY_INDEX
]);
1295 return len
< nbytes
? len
: -1;
1298 /* Parse NAME (null terminated) and store information in FONT
1299 (font-spec or font-entity). NAME is supplied in either the
1300 Fontconfig or GTK font name format. If NAME is successfully
1301 parsed, return 0. Otherwise return -1.
1303 The fontconfig format is
1305 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1309 FAMILY [PROPS...] [SIZE]
1311 This function tries to guess which format it is. */
1314 font_parse_fcname (char *name
, Lisp_Object font
)
1317 char *size_beg
= NULL
, *size_end
= NULL
;
1318 char *props_beg
= NULL
, *family_end
= NULL
;
1319 ptrdiff_t len
= strlen (name
);
1324 for (p
= name
; *p
; p
++)
1326 if (*p
== '\\' && p
[1])
1330 props_beg
= family_end
= p
;
1335 int decimal
= 0, size_found
= 1;
1336 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1339 if (*q
!= '.' || decimal
)
1358 Lisp_Object extra_props
= Qnil
;
1360 /* A fontconfig name with size and/or property data. */
1361 if (family_end
> name
)
1364 family
= font_intern_prop (name
, family_end
- name
, 1);
1365 ASET (font
, FONT_FAMILY_INDEX
, family
);
1369 double point_size
= strtod (size_beg
, &size_end
);
1370 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1371 if (*size_end
== ':' && size_end
[1])
1372 props_beg
= size_end
;
1376 /* Now parse ":KEY=VAL" patterns. */
1379 for (p
= props_beg
; *p
; p
= q
)
1381 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1384 /* Must be an enumerated value. */
1388 val
= font_intern_prop (p
, q
- p
, 1);
1390 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1391 && memcmp (p, STR, strlen (STR)) == 0)
1393 if (PROP_MATCH ("light")
1394 || PROP_MATCH ("medium")
1395 || PROP_MATCH ("demibold")
1396 || PROP_MATCH ("bold")
1397 || PROP_MATCH ("black"))
1398 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1399 else if (PROP_MATCH ("roman")
1400 || PROP_MATCH ("italic")
1401 || PROP_MATCH ("oblique"))
1402 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1403 else if (PROP_MATCH ("charcell"))
1404 ASET (font
, FONT_SPACING_INDEX
,
1405 make_number (FONT_SPACING_CHARCELL
));
1406 else if (PROP_MATCH ("mono"))
1407 ASET (font
, FONT_SPACING_INDEX
,
1408 make_number (FONT_SPACING_MONO
));
1409 else if (PROP_MATCH ("proportional"))
1410 ASET (font
, FONT_SPACING_INDEX
,
1411 make_number (FONT_SPACING_PROPORTIONAL
));
1420 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1421 prop
= FONT_SIZE_INDEX
;
1424 key
= font_intern_prop (p
, q
- p
, 1);
1425 prop
= get_font_prop_index (key
);
1429 for (q
= p
; *q
&& *q
!= ':'; q
++);
1430 val
= font_intern_prop (p
, q
- p
, 0);
1432 if (prop
>= FONT_FOUNDRY_INDEX
1433 && prop
< FONT_EXTRA_INDEX
)
1434 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1437 extra_props
= nconc2 (extra_props
,
1438 Fcons (Fcons (key
, val
), Qnil
));
1445 if (! NILP (extra_props
))
1447 struct font_driver_list
*driver_list
= font_driver_list
;
1448 for ( ; driver_list
; driver_list
= driver_list
->next
)
1449 if (driver_list
->driver
->filter_properties
)
1450 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1456 /* Either a fontconfig-style name with no size and property
1457 data, or a GTK-style name. */
1458 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1459 Lisp_Object width
= Qnil
, size
= Qnil
;
1463 /* Scan backwards from the end, looking for a size. */
1464 for (p
= name
+ len
- 1; p
>= name
; p
--)
1468 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1469 /* Found a font size. */
1470 size
= make_float (strtod (p
+ 1, NULL
));
1474 /* Now P points to the termination of the string, sans size.
1475 Scan backwards, looking for font properties. */
1476 for (; p
> name
; p
= q
)
1478 for (q
= p
- 1; q
>= name
; q
--)
1480 if (q
> name
&& *(q
-1) == '\\')
1481 --q
; /* Skip quoting backslashes. */
1487 word_len
= p
- word_start
;
1489 #define PROP_MATCH(STR) \
1490 (word_len == strlen (STR) \
1491 && memcmp (word_start, STR, strlen (STR)) == 0)
1492 #define PROP_SAVE(VAR, STR) \
1493 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1495 if (PROP_MATCH ("Ultra-Light"))
1496 PROP_SAVE (weight
, "ultra-light");
1497 else if (PROP_MATCH ("Light"))
1498 PROP_SAVE (weight
, "light");
1499 else if (PROP_MATCH ("Book"))
1500 PROP_SAVE (weight
, "book");
1501 else if (PROP_MATCH ("Medium"))
1502 PROP_SAVE (weight
, "medium");
1503 else if (PROP_MATCH ("Semi-Bold"))
1504 PROP_SAVE (weight
, "semi-bold");
1505 else if (PROP_MATCH ("Bold"))
1506 PROP_SAVE (weight
, "bold");
1507 else if (PROP_MATCH ("Italic"))
1508 PROP_SAVE (slant
, "italic");
1509 else if (PROP_MATCH ("Oblique"))
1510 PROP_SAVE (slant
, "oblique");
1511 else if (PROP_MATCH ("Semi-Condensed"))
1512 PROP_SAVE (width
, "semi-condensed");
1513 else if (PROP_MATCH ("Condensed"))
1514 PROP_SAVE (width
, "condensed");
1515 /* An unknown word must be part of the font name. */
1526 ASET (font
, FONT_FAMILY_INDEX
,
1527 font_intern_prop (name
, family_end
- name
, 1));
1529 ASET (font
, FONT_SIZE_INDEX
, size
);
1531 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1533 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1535 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1541 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1542 NAME (NBYTES length), and return the name length. If
1543 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1546 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1548 Lisp_Object family
, foundry
;
1554 Lisp_Object styles
[3];
1555 const char *style_names
[3] = { "weight", "slant", "width" };
1557 family
= AREF (font
, FONT_FAMILY_INDEX
);
1558 if (! NILP (family
))
1560 if (SYMBOLP (family
))
1561 family
= SYMBOL_NAME (family
);
1566 val
= AREF (font
, FONT_SIZE_INDEX
);
1569 if (XINT (val
) != 0)
1570 pixel_size
= XINT (val
);
1578 point_size
= (int) XFLOAT_DATA (val
);
1581 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1582 if (! NILP (foundry
))
1584 if (SYMBOLP (foundry
))
1585 foundry
= SYMBOL_NAME (foundry
);
1590 for (i
= 0; i
< 3; i
++)
1591 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1594 lim
= name
+ nbytes
;
1595 # define APPEND_SNPRINTF(args) \
1597 int len = snprintf args; \
1598 if (! (0 <= len && len < lim - p)) \
1602 if (! NILP (family
))
1603 APPEND_SNPRINTF ((p
, lim
- p
, "%s", SSDATA (family
)));
1605 APPEND_SNPRINTF ((p
, lim
- p
, "-%d" + (p
== name
), point_size
));
1606 else if (pixel_size
> 0)
1607 APPEND_SNPRINTF ((p
, lim
- p
, ":pixelsize=%d", pixel_size
));
1608 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1609 APPEND_SNPRINTF ((p
, lim
- p
, ":foundry=%s",
1610 SSDATA (SYMBOL_NAME (AREF (font
,
1611 FONT_FOUNDRY_INDEX
)))));
1612 for (i
= 0; i
< 3; i
++)
1613 if (! NILP (styles
[i
]))
1614 APPEND_SNPRINTF ((p
, lim
- p
, ":%s=%s", style_names
[i
],
1615 SSDATA (SYMBOL_NAME (styles
[i
]))));
1616 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1617 APPEND_SNPRINTF ((p
, lim
- p
, ":dpi=%"pI
"d",
1618 XINT (AREF (font
, FONT_DPI_INDEX
))));
1619 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1620 APPEND_SNPRINTF ((p
, lim
- p
, ":spacing=%"pI
"d",
1621 XINT (AREF (font
, FONT_SPACING_INDEX
))));
1622 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1623 APPEND_SNPRINTF ((p
, lim
- p
,
1624 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1626 : ":scalable=false")));
1630 /* Parse NAME (null terminated) and store information in FONT
1631 (font-spec or font-entity). If NAME is successfully parsed, return
1632 0. Otherwise return -1. */
1635 font_parse_name (char *name
, Lisp_Object font
)
1637 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1638 return font_parse_xlfd (name
, font
);
1639 return font_parse_fcname (name
, font
);
1643 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1644 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1648 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1654 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1656 CHECK_STRING (family
);
1657 len
= SBYTES (family
);
1658 p0
= SSDATA (family
);
1659 p1
= strchr (p0
, '-');
1662 if ((*p0
!= '*' && p1
- p0
> 0)
1663 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1664 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1667 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1670 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1672 if (! NILP (registry
))
1674 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1675 CHECK_STRING (registry
);
1676 len
= SBYTES (registry
);
1677 p0
= SSDATA (registry
);
1678 p1
= strchr (p0
, '-');
1681 if (SDATA (registry
)[len
- 1] == '*')
1682 registry
= concat2 (registry
, build_string ("-*"));
1684 registry
= concat2 (registry
, build_string ("*-*"));
1686 registry
= Fdowncase (registry
);
1687 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1692 /* This part (through the next ^L) is still experimental and not
1693 tested much. We may drastically change codes. */
1699 #define LGSTRING_HEADER_SIZE 6
1700 #define LGSTRING_GLYPH_SIZE 8
1703 check_gstring (Lisp_Object gstring
)
1708 CHECK_VECTOR (gstring
);
1709 val
= AREF (gstring
, 0);
1711 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1713 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1714 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1715 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1716 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1717 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1718 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1719 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1720 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1721 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1722 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1723 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1725 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1727 val
= LGSTRING_GLYPH (gstring
, i
);
1729 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1731 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1733 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1734 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1735 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1736 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1737 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1738 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1739 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1740 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1742 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1744 if (ASIZE (val
) < 3)
1746 for (j
= 0; j
< 3; j
++)
1747 CHECK_NUMBER (AREF (val
, j
));
1752 error ("Invalid glyph-string format");
1757 check_otf_features (Lisp_Object otf_features
)
1761 CHECK_CONS (otf_features
);
1762 CHECK_SYMBOL (XCAR (otf_features
));
1763 otf_features
= XCDR (otf_features
);
1764 CHECK_CONS (otf_features
);
1765 CHECK_SYMBOL (XCAR (otf_features
));
1766 otf_features
= XCDR (otf_features
);
1767 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1769 CHECK_SYMBOL (Fcar (val
));
1770 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1771 error ("Invalid OTF GSUB feature: %s",
1772 SDATA (SYMBOL_NAME (XCAR (val
))));
1774 otf_features
= XCDR (otf_features
);
1775 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1777 CHECK_SYMBOL (Fcar (val
));
1778 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1779 error ("Invalid OTF GPOS feature: %s",
1780 SDATA (SYMBOL_NAME (XCAR (val
))));
1787 Lisp_Object otf_list
;
1790 otf_tag_symbol (OTF_Tag tag
)
1794 OTF_tag_name (tag
, name
);
1795 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1799 otf_open (Lisp_Object file
)
1801 Lisp_Object val
= Fassoc (file
, otf_list
);
1805 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1808 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1809 val
= make_save_value (otf
, 0);
1810 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1816 /* Return a list describing which scripts/languages FONT supports by
1817 which GSUB/GPOS features of OpenType tables. See the comment of
1818 (struct font_driver).otf_capability. */
1821 font_otf_capability (struct font
*font
)
1824 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1827 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1830 for (i
= 0; i
< 2; i
++)
1832 OTF_GSUB_GPOS
*gsub_gpos
;
1833 Lisp_Object script_list
= Qnil
;
1836 if (OTF_get_features (otf
, i
== 0) < 0)
1838 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1839 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1841 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1842 Lisp_Object langsys_list
= Qnil
;
1843 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1846 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1848 OTF_LangSys
*langsys
;
1849 Lisp_Object feature_list
= Qnil
;
1850 Lisp_Object langsys_tag
;
1853 if (k
== script
->LangSysCount
)
1855 langsys
= &script
->DefaultLangSys
;
1860 langsys
= script
->LangSys
+ k
;
1862 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1864 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1866 OTF_Feature
*feature
1867 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1868 Lisp_Object feature_tag
1869 = otf_tag_symbol (feature
->FeatureTag
);
1871 feature_list
= Fcons (feature_tag
, feature_list
);
1873 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1876 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1881 XSETCAR (capability
, script_list
);
1883 XSETCDR (capability
, script_list
);
1889 /* Parse OTF features in SPEC and write a proper features spec string
1890 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1891 assured that the sufficient memory has already allocated for
1895 generate_otf_features (Lisp_Object spec
, char *features
)
1903 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1909 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1914 else if (! asterisk
)
1916 val
= SYMBOL_NAME (val
);
1917 p
+= esprintf (p
, "%s", SDATA (val
));
1921 val
= SYMBOL_NAME (val
);
1922 p
+= esprintf (p
, "~%s", SDATA (val
));
1926 error ("OTF spec too long");
1930 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1932 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1934 return Fcons (make_number (len
),
1935 make_unibyte_string (device_table
->DeltaValue
, len
));
1939 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
1941 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1943 if (value_format
& OTF_XPlacement
)
1944 ASET (val
, 0, make_number (value_record
->XPlacement
));
1945 if (value_format
& OTF_YPlacement
)
1946 ASET (val
, 1, make_number (value_record
->YPlacement
));
1947 if (value_format
& OTF_XAdvance
)
1948 ASET (val
, 2, make_number (value_record
->XAdvance
));
1949 if (value_format
& OTF_YAdvance
)
1950 ASET (val
, 3, make_number (value_record
->YAdvance
));
1951 if (value_format
& OTF_XPlaDevice
)
1952 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1953 if (value_format
& OTF_YPlaDevice
)
1954 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1955 if (value_format
& OTF_XAdvDevice
)
1956 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1957 if (value_format
& OTF_YAdvDevice
)
1958 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1963 font_otf_Anchor (OTF_Anchor
*anchor
)
1967 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1968 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1969 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1970 if (anchor
->AnchorFormat
== 2)
1971 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1974 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1975 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1979 #endif /* HAVE_LIBOTF */
1985 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
1986 static int font_compare (const void *, const void *);
1987 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
1991 font_rescale_ratio (Lisp_Object font_entity
)
1993 Lisp_Object tail
, elt
;
1994 Lisp_Object name
= Qnil
;
1996 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
1999 if (FLOATP (XCDR (elt
)))
2001 if (STRINGP (XCAR (elt
)))
2004 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2005 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2006 return XFLOAT_DATA (XCDR (elt
));
2008 else if (FONT_SPEC_P (XCAR (elt
)))
2010 if (font_match_p (XCAR (elt
), font_entity
))
2011 return XFLOAT_DATA (XCDR (elt
));
2018 /* We sort fonts by scoring each of them against a specified
2019 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2020 the value is, the closer the font is to the font-spec.
2022 The lowest 2 bits of the score are used for driver type. The font
2023 available by the most preferred font driver is 0.
2025 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2026 WEIGHT, SLANT, WIDTH, and SIZE. */
2028 /* How many bits to shift to store the difference value of each font
2029 property in a score. Note that floats for FONT_TYPE_INDEX and
2030 FONT_REGISTRY_INDEX are not used. */
2031 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2033 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2034 The return value indicates how different ENTITY is compared with
2038 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2043 /* Score three style numeric fields. Maximum difference is 127. */
2044 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2045 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2047 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2048 - (XINT (spec_prop
[i
]) >> 8));
2051 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2054 /* Score the size. Maximum difference is 127. */
2055 i
= FONT_SIZE_INDEX
;
2056 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2057 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2059 /* We use the higher 6-bit for the actual size difference. The
2060 lowest bit is set if the DPI is different. */
2062 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2064 if (CONSP (Vface_font_rescale_alist
))
2065 pixel_size
*= font_rescale_ratio (entity
);
2066 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2070 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2071 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2073 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2074 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2076 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2083 /* Concatenate all elements of LIST into one vector. LIST is a list
2084 of font-entity vectors. */
2087 font_vconcat_entity_vectors (Lisp_Object list
)
2089 int nargs
= XINT (Flength (list
));
2090 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2093 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2094 args
[i
] = XCAR (list
);
2095 return Fvconcat (nargs
, args
);
2099 /* The structure for elements being sorted by qsort. */
2100 struct font_sort_data
2103 int font_driver_preference
;
2108 /* The comparison function for qsort. */
2111 font_compare (const void *d1
, const void *d2
)
2113 const struct font_sort_data
*data1
= d1
;
2114 const struct font_sort_data
*data2
= d2
;
2116 if (data1
->score
< data2
->score
)
2118 else if (data1
->score
> data2
->score
)
2120 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2124 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2125 If PREFER specifies a point-size, calculate the corresponding
2126 pixel-size from QCdpi property of PREFER or from the Y-resolution
2127 of FRAME before sorting.
2129 If BEST-ONLY is nonzero, return the best matching entity (that
2130 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2131 if BEST-ONLY is negative). Otherwise, return the sorted result as
2132 a single vector of font-entities.
2134 This function does no optimization for the case that the total
2135 number of elements is 1. The caller should avoid calling this in
2139 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2141 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2143 struct font_sort_data
*data
;
2144 unsigned best_score
;
2145 Lisp_Object best_entity
;
2146 struct frame
*f
= XFRAME (frame
);
2147 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2150 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2151 prefer_prop
[i
] = AREF (prefer
, i
);
2152 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2153 prefer_prop
[FONT_SIZE_INDEX
]
2154 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2156 if (NILP (XCDR (list
)))
2158 /* What we have to take care of is this single vector. */
2160 maxlen
= ASIZE (vec
);
2164 /* We don't have to perform sort, so there's no need of creating
2165 a single vector. But, we must find the length of the longest
2168 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2169 if (maxlen
< ASIZE (XCAR (tail
)))
2170 maxlen
= ASIZE (XCAR (tail
));
2174 /* We have to create a single vector to sort it. */
2175 vec
= font_vconcat_entity_vectors (list
);
2176 maxlen
= ASIZE (vec
);
2179 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2180 best_score
= 0xFFFFFFFF;
2183 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2185 int font_driver_preference
= 0;
2186 Lisp_Object current_font_driver
;
2192 /* We are sure that the length of VEC > 0. */
2193 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2194 /* Score the elements. */
2195 for (i
= 0; i
< len
; i
++)
2197 data
[i
].entity
= AREF (vec
, i
);
2199 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2201 ? font_score (data
[i
].entity
, prefer_prop
)
2203 if (best_only
&& best_score
> data
[i
].score
)
2205 best_score
= data
[i
].score
;
2206 best_entity
= data
[i
].entity
;
2207 if (best_score
== 0)
2210 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2212 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2213 font_driver_preference
++;
2215 data
[i
].font_driver_preference
= font_driver_preference
;
2218 /* Sort if necessary. */
2221 qsort (data
, len
, sizeof *data
, font_compare
);
2222 for (i
= 0; i
< len
; i
++)
2223 ASET (vec
, i
, data
[i
].entity
);
2232 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2237 /* API of Font Service Layer. */
2239 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2240 sort_shift_bits. Finternal_set_font_selection_order calls this
2241 function with font_sort_order after setting up it. */
2244 font_update_sort_order (int *order
)
2248 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2250 int xlfd_idx
= order
[i
];
2252 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2253 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2254 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2255 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2256 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2257 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2259 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2264 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2269 table
= assq_no_quit (script
, table
);
2272 table
= XCDR (table
);
2273 if (! NILP (langsys
))
2275 table
= assq_no_quit (langsys
, table
);
2281 val
= assq_no_quit (Qnil
, table
);
2283 table
= XCAR (table
);
2287 table
= XCDR (table
);
2288 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2290 if (NILP (XCAR (features
)))
2295 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2301 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2304 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2306 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2308 script
= XCAR (spec
);
2312 langsys
= XCAR (spec
);
2323 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2324 XCAR (otf_capability
)))
2326 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2327 XCDR (otf_capability
)))
2334 /* Check if FONT (font-entity or font-object) matches with the font
2335 specification SPEC. */
2338 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2340 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2341 Lisp_Object extra
, font_extra
;
2344 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2345 if (! NILP (AREF (spec
, i
))
2346 && ! NILP (AREF (font
, i
))
2347 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2349 props
= XFONT_SPEC (spec
)->props
;
2350 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2352 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2353 prop
[i
] = AREF (spec
, i
);
2354 prop
[FONT_SIZE_INDEX
]
2355 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2359 if (font_score (font
, props
) > 0)
2361 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2362 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2363 for (; CONSP (extra
); extra
= XCDR (extra
))
2365 Lisp_Object key
= XCAR (XCAR (extra
));
2366 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2368 if (EQ (key
, QClang
))
2370 val2
= assq_no_quit (key
, font_extra
);
2379 if (NILP (Fmemq (val
, val2
)))
2384 ? NILP (Fmemq (val
, XCDR (val2
)))
2388 else if (EQ (key
, QCscript
))
2390 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2396 /* All characters in the list must be supported. */
2397 for (; CONSP (val2
); val2
= XCDR (val2
))
2399 if (! NATNUMP (XCAR (val2
)))
2401 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2402 == FONT_INVALID_CODE
)
2406 else if (VECTORP (val2
))
2408 /* At most one character in the vector must be supported. */
2409 for (i
= 0; i
< ASIZE (val2
); i
++)
2411 if (! NATNUMP (AREF (val2
, i
)))
2413 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2414 != FONT_INVALID_CODE
)
2417 if (i
== ASIZE (val2
))
2422 else if (EQ (key
, QCotf
))
2426 if (! FONT_OBJECT_P (font
))
2428 fontp
= XFONT_OBJECT (font
);
2429 if (! fontp
->driver
->otf_capability
)
2431 val2
= fontp
->driver
->otf_capability (fontp
);
2432 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2443 Each font backend has the callback function get_cache, and it
2444 returns a cons cell of which cdr part can be freely used for
2445 caching fonts. The cons cell may be shared by multiple frames
2446 and/or multiple font drivers. So, we arrange the cdr part as this:
2448 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2450 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2451 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2452 cons (FONT-SPEC FONT-ENTITY ...). */
2454 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2455 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2456 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2457 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2458 struct font_driver
*);
2461 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2463 Lisp_Object cache
, val
;
2465 cache
= driver
->get_cache (f
);
2467 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2471 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2472 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2476 val
= XCDR (XCAR (val
));
2477 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2483 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2485 Lisp_Object cache
, val
, tmp
;
2488 cache
= driver
->get_cache (f
);
2490 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2491 cache
= val
, val
= XCDR (val
);
2492 font_assert (! NILP (val
));
2493 tmp
= XCDR (XCAR (val
));
2494 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2495 if (XINT (XCAR (tmp
)) == 0)
2497 font_clear_cache (f
, XCAR (val
), driver
);
2498 XSETCDR (cache
, XCDR (val
));
2504 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2506 Lisp_Object val
= driver
->get_cache (f
);
2507 Lisp_Object type
= driver
->type
;
2509 font_assert (CONSP (val
));
2510 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2511 font_assert (CONSP (val
));
2512 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2513 val
= XCDR (XCAR (val
));
2517 static int num_fonts
;
2520 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2522 Lisp_Object tail
, elt
;
2523 Lisp_Object tail2
, entity
;
2525 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2526 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2529 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2530 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2532 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2534 entity
= XCAR (tail2
);
2536 if (FONT_ENTITY_P (entity
)
2537 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2539 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2541 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2543 Lisp_Object val
= XCAR (objlist
);
2544 struct font
*font
= XFONT_OBJECT (val
);
2546 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2548 font_assert (font
&& driver
== font
->driver
);
2549 driver
->close (f
, font
);
2553 if (driver
->free_entity
)
2554 driver
->free_entity (entity
);
2559 XSETCDR (cache
, Qnil
);
2563 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2565 /* Check each font-entity in VEC, and return a list of font-entities
2566 that satisfy these conditions:
2567 (1) matches with SPEC and SIZE if SPEC is not nil, and
2568 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2572 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2574 Lisp_Object entity
, val
;
2575 enum font_property_index prop
;
2578 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2580 entity
= AREF (vec
, i
);
2581 if (! NILP (Vface_ignored_fonts
))
2584 Lisp_Object tail
, regexp
;
2586 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2588 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2590 regexp
= XCAR (tail
);
2591 if (STRINGP (regexp
)
2592 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2601 val
= Fcons (entity
, val
);
2604 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2605 if (INTEGERP (AREF (spec
, prop
))
2606 && ((XINT (AREF (spec
, prop
)) >> 8)
2607 != (XINT (AREF (entity
, prop
)) >> 8)))
2608 prop
= FONT_SPEC_MAX
;
2609 if (prop
< FONT_SPEC_MAX
2611 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2613 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2616 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2617 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2618 prop
= FONT_SPEC_MAX
;
2620 if (prop
< FONT_SPEC_MAX
2621 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2622 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2623 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2624 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2625 prop
= FONT_SPEC_MAX
;
2626 if (prop
< FONT_SPEC_MAX
2627 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2628 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2629 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2630 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2631 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2632 prop
= FONT_SPEC_MAX
;
2633 if (prop
< FONT_SPEC_MAX
)
2634 val
= Fcons (entity
, val
);
2636 return (Fvconcat (1, &val
));
2640 /* Return a list of vectors of font-entities matching with SPEC on
2641 FRAME. Each elements in the list is a vector of entities from the
2642 same font-driver. */
2645 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2647 FRAME_PTR f
= XFRAME (frame
);
2648 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2649 Lisp_Object ftype
, val
;
2650 Lisp_Object list
= Qnil
;
2652 int need_filtering
= 0;
2655 font_assert (FONT_SPEC_P (spec
));
2657 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2658 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2659 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2660 size
= font_pixel_size (f
, spec
);
2664 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2665 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2666 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2667 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2668 if (i
!= FONT_SPACING_INDEX
)
2670 ASET (scratch_font_spec
, i
, Qnil
);
2671 if (! NILP (AREF (spec
, i
)))
2674 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2675 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2677 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2679 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2681 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2683 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2684 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2691 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2695 val
= Fvconcat (1, &val
);
2696 copy
= copy_font_spec (scratch_font_spec
);
2697 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2698 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2702 || ! NILP (Vface_ignored_fonts
)))
2703 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2704 if (ASIZE (val
) > 0)
2705 list
= Fcons (val
, list
);
2708 list
= Fnreverse (list
);
2709 FONT_ADD_LOG ("list", spec
, list
);
2714 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2715 nil, is an array of face's attributes, which specifies preferred
2716 font-related attributes. */
2719 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2721 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2722 Lisp_Object ftype
, size
, entity
;
2724 Lisp_Object work
= copy_font_spec (spec
);
2726 XSETFRAME (frame
, f
);
2727 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2728 size
= AREF (spec
, FONT_SIZE_INDEX
);
2731 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2732 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2733 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2734 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2737 for (; driver_list
; driver_list
= driver_list
->next
)
2739 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2741 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2744 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2745 entity
= assoc_no_quit (work
, XCDR (cache
));
2747 entity
= XCDR (entity
);
2750 entity
= driver_list
->driver
->match (frame
, work
);
2751 copy
= copy_font_spec (work
);
2752 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2753 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2755 if (! NILP (entity
))
2758 FONT_ADD_LOG ("match", work
, entity
);
2763 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2764 opened font object. */
2767 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2769 struct font_driver_list
*driver_list
;
2770 Lisp_Object objlist
, size
, val
, font_object
;
2772 int min_width
, height
;
2773 int scaled_pixel_size
= pixel_size
;
2775 font_assert (FONT_ENTITY_P (entity
));
2776 size
= AREF (entity
, FONT_SIZE_INDEX
);
2777 if (XINT (size
) != 0)
2778 scaled_pixel_size
= pixel_size
= XINT (size
);
2779 else if (CONSP (Vface_font_rescale_alist
))
2780 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2782 val
= AREF (entity
, FONT_TYPE_INDEX
);
2783 for (driver_list
= f
->font_driver_list
;
2784 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2785 driver_list
= driver_list
->next
);
2789 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2790 objlist
= XCDR (objlist
))
2792 Lisp_Object fn
= XCAR (objlist
);
2793 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2794 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2796 if (driver_list
->driver
->cached_font_ok
== NULL
2797 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2802 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2803 if (!NILP (font_object
))
2804 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2805 FONT_ADD_LOG ("open", entity
, font_object
);
2806 if (NILP (font_object
))
2808 ASET (entity
, FONT_OBJLIST_INDEX
,
2809 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2812 font
= XFONT_OBJECT (font_object
);
2813 min_width
= (font
->min_width
? font
->min_width
2814 : font
->average_width
? font
->average_width
2815 : font
->space_width
? font
->space_width
2817 height
= (font
->height
? font
->height
: 1);
2818 #ifdef HAVE_WINDOW_SYSTEM
2819 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2820 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2822 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2823 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2824 fonts_changed_p
= 1;
2828 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2829 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2830 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2831 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2839 /* Close FONT_OBJECT that is opened on frame F. */
2842 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2844 struct font
*font
= XFONT_OBJECT (font_object
);
2846 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2847 /* Already closed. */
2849 FONT_ADD_LOG ("close", font_object
, Qnil
);
2850 font
->driver
->close (f
, font
);
2851 #ifdef HAVE_WINDOW_SYSTEM
2852 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2853 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2859 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2860 FONT is a font-entity and it must be opened to check. */
2863 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2867 if (FONT_ENTITY_P (font
))
2869 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2870 struct font_driver_list
*driver_list
;
2872 for (driver_list
= f
->font_driver_list
;
2873 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2874 driver_list
= driver_list
->next
);
2877 if (! driver_list
->driver
->has_char
)
2879 return driver_list
->driver
->has_char (font
, c
);
2882 font_assert (FONT_OBJECT_P (font
));
2883 fontp
= XFONT_OBJECT (font
);
2884 if (fontp
->driver
->has_char
)
2886 int result
= fontp
->driver
->has_char (font
, c
);
2891 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2895 /* Return the glyph ID of FONT_OBJECT for character C. */
2898 font_encode_char (Lisp_Object font_object
, int c
)
2902 font_assert (FONT_OBJECT_P (font_object
));
2903 font
= XFONT_OBJECT (font_object
);
2904 return font
->driver
->encode_char (font
, c
);
2908 /* Return the name of FONT_OBJECT. */
2911 font_get_name (Lisp_Object font_object
)
2913 font_assert (FONT_OBJECT_P (font_object
));
2914 return AREF (font_object
, FONT_NAME_INDEX
);
2918 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2919 could not be parsed by font_parse_name, return Qnil. */
2922 font_spec_from_name (Lisp_Object font_name
)
2924 Lisp_Object spec
= Ffont_spec (0, NULL
);
2926 CHECK_STRING (font_name
);
2927 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2929 font_put_extra (spec
, QCname
, font_name
);
2930 font_put_extra (spec
, QCuser_spec
, font_name
);
2936 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2938 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2943 if (! NILP (Ffont_get (font
, QCname
)))
2945 font
= copy_font_spec (font
);
2946 font_put_extra (font
, QCname
, Qnil
);
2949 if (NILP (AREF (font
, prop
))
2950 && prop
!= FONT_FAMILY_INDEX
2951 && prop
!= FONT_FOUNDRY_INDEX
2952 && prop
!= FONT_WIDTH_INDEX
2953 && prop
!= FONT_SIZE_INDEX
)
2955 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
2956 font
= copy_font_spec (font
);
2957 ASET (font
, prop
, Qnil
);
2958 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2960 if (prop
== FONT_FAMILY_INDEX
)
2962 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2963 /* If we are setting the font family, we must also clear
2964 FONT_WIDTH_INDEX to avoid rejecting families that lack
2965 support for some widths. */
2966 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
2968 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2969 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2970 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2971 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2972 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2973 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2975 else if (prop
== FONT_SIZE_INDEX
)
2977 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2978 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2979 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2981 else if (prop
== FONT_WIDTH_INDEX
)
2982 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2983 attrs
[LFACE_FONT_INDEX
] = font
;
2986 /* Select a font from ENTITIES (list of font-entity vectors) that
2987 supports C and is the best match for ATTRS and PIXEL_SIZE. */
2990 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
2992 Lisp_Object font_entity
;
2995 FRAME_PTR f
= XFRAME (frame
);
2997 if (NILP (XCDR (entities
))
2998 && ASIZE (XCAR (entities
)) == 1)
3000 font_entity
= AREF (XCAR (entities
), 0);
3002 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3007 /* Sort fonts by properties specified in ATTRS. */
3008 prefer
= scratch_font_prefer
;
3010 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3011 ASET (prefer
, i
, Qnil
);
3012 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3014 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3016 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3017 ASET (prefer
, i
, AREF (face_font
, i
));
3019 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3020 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3021 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3022 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3023 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3024 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3025 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3027 return font_sort_entities (entities
, prefer
, frame
, c
);
3030 /* Return a font-entity that satisfies SPEC and is the best match for
3031 face's font related attributes in ATTRS. C, if not negative, is a
3032 character that the entity must support. */
3035 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3038 Lisp_Object frame
, entities
, val
;
3039 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3043 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3044 if (NILP (registry
[0]))
3046 registry
[0] = DEFAULT_ENCODING
;
3047 registry
[1] = Qascii_0
;
3048 registry
[2] = null_vector
;
3051 registry
[1] = null_vector
;
3053 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3055 struct charset
*encoding
, *repertory
;
3057 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3058 &encoding
, &repertory
) < 0)
3061 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3063 else if (c
> encoding
->max_char
)
3067 work
= copy_font_spec (spec
);
3068 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3069 XSETFRAME (frame
, f
);
3070 pixel_size
= font_pixel_size (f
, spec
);
3071 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3073 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3075 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3077 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3078 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3079 if (! NILP (foundry
[0]))
3080 foundry
[1] = null_vector
;
3081 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3083 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3084 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3086 foundry
[2] = null_vector
;
3089 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3091 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3092 if (! NILP (adstyle
[0]))
3093 adstyle
[1] = null_vector
;
3094 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3096 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3098 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3100 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3102 adstyle
[2] = null_vector
;
3105 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3108 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3111 val
= AREF (work
, FONT_FAMILY_INDEX
);
3112 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3114 val
= attrs
[LFACE_FAMILY_INDEX
];
3115 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3119 family
= alloca ((sizeof family
[0]) * 2);
3121 family
[1] = null_vector
; /* terminator. */
3126 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3127 /* Font family names are case-sensitive under NS. */
3135 if (! NILP (alters
))
3137 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3138 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3139 family
[i
] = XCAR (alters
);
3140 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3142 family
[i
] = null_vector
;
3146 family
= alloca ((sizeof family
[0]) * 3);
3149 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3151 family
[i
] = null_vector
;
3155 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3157 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3158 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3160 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3161 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3163 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3164 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3166 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3167 entities
= font_list_entities (frame
, work
);
3168 if (! NILP (entities
))
3170 val
= font_select_entity (frame
, entities
,
3171 attrs
, pixel_size
, c
);
3184 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3188 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3189 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3190 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3191 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3192 size
= font_pixel_size (f
, spec
);
3196 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3197 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3200 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3201 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3202 if (INTEGERP (height
))
3205 abort(); /* We should never end up here. */
3209 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3213 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3214 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3218 return font_open_entity (f
, entity
, size
);
3222 /* Find a font that satisfies SPEC and is the best match for
3223 face's attributes in ATTRS on FRAME, and return the opened
3227 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3229 Lisp_Object entity
, name
;
3231 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3234 /* No font is listed for SPEC, but each font-backend may have
3235 different criteria about "font matching". So, try it. */
3236 entity
= font_matching_entity (f
, attrs
, spec
);
3240 /* Don't lose the original name that was put in initially. We need
3241 it to re-apply the font when font parameters (like hinting or dpi) have
3243 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3246 name
= Ffont_get (spec
, QCuser_spec
);
3247 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3253 /* Make FACE on frame F ready to use the font opened for FACE. */
3256 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3258 if (face
->font
->driver
->prepare_face
)
3259 face
->font
->driver
->prepare_face (f
, face
);
3263 /* Make FACE on frame F stop using the font opened for FACE. */
3266 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3268 if (face
->font
->driver
->done_face
)
3269 face
->font
->driver
->done_face (f
, face
);
3274 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3275 font is found, return Qnil. */
3278 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3280 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3282 /* We set up the default font-related attributes of a face to prefer
3284 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3285 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3286 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3288 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3290 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3292 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3294 return font_load_for_lface (f
, attrs
, spec
);
3298 /* Open a font that matches NAME on frame F. If no proper font is
3299 found, return Qnil. */
3302 font_open_by_name (FRAME_PTR f
, const char *name
)
3304 Lisp_Object args
[2];
3305 Lisp_Object spec
, ret
;
3308 args
[1] = make_unibyte_string (name
, strlen (name
));
3309 spec
= Ffont_spec (2, args
);
3310 ret
= font_open_by_spec (f
, spec
);
3311 /* Do not lose name originally put in. */
3313 font_put_extra (ret
, QCuser_spec
, args
[1]);
3319 /* Register font-driver DRIVER. This function is used in two ways.
3321 The first is with frame F non-NULL. In this case, make DRIVER
3322 available (but not yet activated) on F. All frame creators
3323 (e.g. Fx_create_frame) must call this function at least once with
3324 an available font-driver.
3326 The second is with frame F NULL. In this case, DRIVER is globally
3327 registered in the variable `font_driver_list'. All font-driver
3328 implementations must call this function in its syms_of_XXXX
3329 (e.g. syms_of_xfont). */
3332 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3334 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3335 struct font_driver_list
*prev
, *list
;
3337 if (f
&& ! driver
->draw
)
3338 error ("Unusable font driver for a frame: %s",
3339 SDATA (SYMBOL_NAME (driver
->type
)));
3341 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3342 if (EQ (list
->driver
->type
, driver
->type
))
3343 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3345 list
= xmalloc (sizeof (struct font_driver_list
));
3347 list
->driver
= driver
;
3352 f
->font_driver_list
= list
;
3354 font_driver_list
= list
;
3360 free_font_driver_list (FRAME_PTR f
)
3362 struct font_driver_list
*list
, *next
;
3364 for (list
= f
->font_driver_list
; list
; list
= next
)
3369 f
->font_driver_list
= NULL
;
3373 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3374 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3375 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3377 A caller must free all realized faces if any in advance. The
3378 return value is a list of font backends actually made used on
3382 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3384 Lisp_Object active_drivers
= Qnil
;
3385 struct font_driver_list
*list
;
3387 /* At first, turn off non-requested drivers, and turn on requested
3389 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3391 struct font_driver
*driver
= list
->driver
;
3392 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3397 if (driver
->end_for_frame
)
3398 driver
->end_for_frame (f
);
3399 font_finish_cache (f
, driver
);
3404 if (! driver
->start_for_frame
3405 || driver
->start_for_frame (f
) == 0)
3407 font_prepare_cache (f
, driver
);
3414 if (NILP (new_drivers
))
3417 if (! EQ (new_drivers
, Qt
))
3419 /* Re-order the driver list according to new_drivers. */
3420 struct font_driver_list
**list_table
, **next
;
3424 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3425 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3427 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3428 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3431 list_table
[i
++] = list
;
3433 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3435 list_table
[i
++] = list
;
3436 list_table
[i
] = NULL
;
3438 next
= &f
->font_driver_list
;
3439 for (i
= 0; list_table
[i
]; i
++)
3441 *next
= list_table
[i
];
3442 next
= &(*next
)->next
;
3446 if (! f
->font_driver_list
->on
)
3447 { /* None of the drivers is enabled: enable them all.
3448 Happens if you set the list of drivers to (xft x) in your .emacs
3449 and then use it under w32 or ns. */
3450 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3452 struct font_driver
*driver
= list
->driver
;
3453 eassert (! list
->on
);
3454 if (! driver
->start_for_frame
3455 || driver
->start_for_frame (f
) == 0)
3457 font_prepare_cache (f
, driver
);
3464 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3466 active_drivers
= nconc2 (active_drivers
,
3467 Fcons (list
->driver
->type
, Qnil
));
3468 return active_drivers
;
3472 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3474 struct font_data_list
*list
, *prev
;
3476 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3477 prev
= list
, list
= list
->next
)
3478 if (list
->driver
== driver
)
3485 prev
->next
= list
->next
;
3487 f
->font_data_list
= list
->next
;
3495 list
= xmalloc (sizeof (struct font_data_list
));
3496 list
->driver
= driver
;
3497 list
->next
= f
->font_data_list
;
3498 f
->font_data_list
= list
;
3506 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3508 struct font_data_list
*list
;
3510 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3511 if (list
->driver
== driver
)
3519 /* Sets attributes on a font. Any properties that appear in ALIST and
3520 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3521 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3522 arrays of strings. This function is intended for use by the font
3523 drivers to implement their specific font_filter_properties. */
3525 font_filter_properties (Lisp_Object font
,
3527 const char *const boolean_properties
[],
3528 const char *const non_boolean_properties
[])
3533 /* Set boolean values to Qt or Qnil */
3534 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3535 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3537 Lisp_Object key
= XCAR (XCAR (it
));
3538 Lisp_Object val
= XCDR (XCAR (it
));
3539 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3541 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3543 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3544 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3547 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3548 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3549 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3550 || strcmp ("Off", str
) == 0)
3555 Ffont_put (font
, key
, val
);
3559 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3560 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3562 Lisp_Object key
= XCAR (XCAR (it
));
3563 Lisp_Object val
= XCDR (XCAR (it
));
3564 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3565 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3566 Ffont_put (font
, key
, val
);
3571 /* Return the font used to draw character C by FACE at buffer position
3572 POS in window W. If STRING is non-nil, it is a string containing C
3573 at index POS. If C is negative, get C from the current buffer or
3577 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3582 Lisp_Object font_object
;
3584 multibyte
= (NILP (string
)
3585 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3586 : STRING_MULTIBYTE (string
));
3593 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3595 c
= FETCH_CHAR (pos_byte
);
3598 c
= FETCH_BYTE (pos
);
3604 multibyte
= STRING_MULTIBYTE (string
);
3607 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3609 str
= SDATA (string
) + pos_byte
;
3610 c
= STRING_CHAR (str
);
3613 c
= SDATA (string
)[pos
];
3617 f
= XFRAME (w
->frame
);
3618 if (! FRAME_WINDOW_P (f
))
3625 if (STRINGP (string
))
3626 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3627 DEFAULT_FACE_ID
, 0);
3629 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3631 face
= FACE_FROM_ID (f
, face_id
);
3635 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3636 face
= FACE_FROM_ID (f
, face_id
);
3641 XSETFONT (font_object
, face
->font
);
3646 #ifdef HAVE_WINDOW_SYSTEM
3648 /* Check how many characters after POS (at most to *LIMIT) can be
3649 displayed by the same font in the window W. FACE, if non-NULL, is
3650 the face selected for the character at POS. If STRING is not nil,
3651 it is the string to check instead of the current buffer. In that
3652 case, FACE must be not NULL.
3654 The return value is the font-object for the character at POS.
3655 *LIMIT is set to the position where that font can't be used.
3657 It is assured that the current buffer (or STRING) is multibyte. */
3660 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3662 EMACS_INT pos_byte
, ignore
;
3664 Lisp_Object font_object
= Qnil
;
3668 pos_byte
= CHAR_TO_BYTE (pos
);
3673 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3675 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3681 pos_byte
= string_char_to_byte (string
, pos
);
3684 while (pos
< *limit
)
3686 Lisp_Object category
;
3689 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3691 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3692 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3693 if (INTEGERP (category
)
3694 && (XINT (category
) == UNICODE_CATEGORY_Cf
3695 || CHAR_VARIATION_SELECTOR_P (c
)))
3697 if (NILP (font_object
))
3699 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3700 if (NILP (font_object
))
3704 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3714 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3715 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3716 Return nil otherwise.
3717 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3718 which kind of font it is. It must be one of `font-spec', `font-entity',
3720 (Lisp_Object object
, Lisp_Object extra_type
)
3722 if (NILP (extra_type
))
3723 return (FONTP (object
) ? Qt
: Qnil
);
3724 if (EQ (extra_type
, Qfont_spec
))
3725 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3726 if (EQ (extra_type
, Qfont_entity
))
3727 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3728 if (EQ (extra_type
, Qfont_object
))
3729 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3730 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3733 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3734 doc
: /* Return a newly created font-spec with arguments as properties.
3736 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3737 valid font property name listed below:
3739 `:family', `:weight', `:slant', `:width'
3741 They are the same as face attributes of the same name. See
3742 `set-face-attribute'.
3746 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3750 VALUE must be a string or a symbol specifying the additional
3751 typographic style information of a font, e.g. ``sans''.
3755 VALUE must be a string or a symbol specifying the charset registry and
3756 encoding of a font, e.g. ``iso8859-1''.
3760 VALUE must be a non-negative integer or a floating point number
3761 specifying the font size. It specifies the font size in pixels (if
3762 VALUE is an integer), or in points (if VALUE is a float).
3766 VALUE must be a string of XLFD-style or fontconfig-style font name.
3770 VALUE must be a symbol representing a script that the font must
3771 support. It may be a symbol representing a subgroup of a script
3772 listed in the variable `script-representative-chars'.
3776 VALUE must be a symbol of two-letter ISO-639 language names,
3781 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3782 required OpenType features.
3784 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3785 LANGSYS-TAG: OpenType language system tag symbol,
3786 or nil for the default language system.
3787 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3788 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3790 GSUB and GPOS may contain `nil' element. In such a case, the font
3791 must not have any of the remaining elements.
3793 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3794 be an OpenType font whose GPOS table of `thai' script's default
3795 language system must contain `mark' feature.
3797 usage: (font-spec ARGS...) */)
3798 (ptrdiff_t nargs
, Lisp_Object
*args
)
3800 Lisp_Object spec
= font_make_spec ();
3803 for (i
= 0; i
< nargs
; i
+= 2)
3805 Lisp_Object key
= args
[i
], val
;
3809 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3812 if (EQ (key
, QCname
))
3815 font_parse_name (SSDATA (val
), spec
);
3816 font_put_extra (spec
, key
, val
);
3820 int idx
= get_font_prop_index (key
);
3824 val
= font_prop_validate (idx
, Qnil
, val
);
3825 if (idx
< FONT_EXTRA_INDEX
)
3826 ASET (spec
, idx
, val
);
3828 font_put_extra (spec
, key
, val
);
3831 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3837 /* Return a copy of FONT as a font-spec. */
3839 copy_font_spec (Lisp_Object font
)
3841 Lisp_Object new_spec
, tail
, prev
, extra
;
3845 new_spec
= font_make_spec ();
3846 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3847 ASET (new_spec
, i
, AREF (font
, i
));
3848 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3849 /* We must remove :font-entity property. */
3850 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3851 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3854 extra
= XCDR (extra
);
3856 XSETCDR (prev
, XCDR (tail
));
3859 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3863 /* Merge font-specs FROM and TO, and return a new font-spec.
3864 Every specified property in FROM overrides the corresponding
3867 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3869 Lisp_Object extra
, tail
;
3874 to
= copy_font_spec (to
);
3875 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3876 ASET (to
, i
, AREF (from
, i
));
3877 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3878 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3879 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3881 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3884 XSETCDR (slot
, XCDR (XCAR (tail
)));
3886 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3888 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3892 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3893 doc
: /* Return the value of FONT's property KEY.
3894 FONT is a font-spec, a font-entity, or a font-object.
3895 KEY is any symbol, but these are reserved for specific meanings:
3896 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3897 :size, :name, :script, :otf
3898 See the documentation of `font-spec' for their meanings.
3899 In addition, if FONT is a font-entity or a font-object, values of
3900 :script and :otf are different from those of a font-spec as below:
3902 The value of :script may be a list of scripts that are supported by the font.
3904 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3905 representing the OpenType features supported by the font by this form:
3906 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3907 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3909 (Lisp_Object font
, Lisp_Object key
)
3917 idx
= get_font_prop_index (key
);
3918 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3919 return font_style_symbolic (font
, idx
, 0);
3920 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3921 return AREF (font
, idx
);
3922 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3923 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3925 struct font
*fontp
= XFONT_OBJECT (font
);
3927 if (fontp
->driver
->otf_capability
)
3928 val
= fontp
->driver
->otf_capability (fontp
);
3930 val
= Fcons (Qnil
, Qnil
);
3937 #ifdef HAVE_WINDOW_SYSTEM
3939 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3940 doc
: /* Return a plist of face attributes generated by FONT.
3941 FONT is a font name, a font-spec, a font-entity, or a font-object.
3942 The return value is a list of the form
3944 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3946 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3947 compatible with `set-face-attribute'. Some of these key-attribute pairs
3948 may be omitted from the list if they are not specified by FONT.
3950 The optional argument FRAME specifies the frame that the face attributes
3951 are to be displayed on. If omitted, the selected frame is used. */)
3952 (Lisp_Object font
, Lisp_Object frame
)
3955 Lisp_Object plist
[10];
3960 frame
= selected_frame
;
3961 CHECK_LIVE_FRAME (frame
);
3966 int fontset
= fs_query_fontset (font
, 0);
3967 Lisp_Object name
= font
;
3969 font
= fontset_ascii (fontset
);
3970 font
= font_spec_from_name (name
);
3972 signal_error ("Invalid font name", name
);
3974 else if (! FONTP (font
))
3975 signal_error ("Invalid font object", font
);
3977 val
= AREF (font
, FONT_FAMILY_INDEX
);
3980 plist
[n
++] = QCfamily
;
3981 plist
[n
++] = SYMBOL_NAME (val
);
3984 val
= AREF (font
, FONT_SIZE_INDEX
);
3987 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3988 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3989 plist
[n
++] = QCheight
;
3990 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
3992 else if (FLOATP (val
))
3994 plist
[n
++] = QCheight
;
3995 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3998 val
= FONT_WEIGHT_FOR_FACE (font
);
4001 plist
[n
++] = QCweight
;
4005 val
= FONT_SLANT_FOR_FACE (font
);
4008 plist
[n
++] = QCslant
;
4012 val
= FONT_WIDTH_FOR_FACE (font
);
4015 plist
[n
++] = QCwidth
;
4019 return Flist (n
, plist
);
4024 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4025 doc
: /* Set one property of FONT: give property KEY value VAL.
4026 FONT is a font-spec, a font-entity, or a font-object.
4028 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4029 accepted by the function `font-spec' (which see), VAL must be what
4030 allowed in `font-spec'.
4032 If FONT is a font-entity or a font-object, KEY must not be the one
4033 accepted by `font-spec'. */)
4034 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4038 idx
= get_font_prop_index (prop
);
4039 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4041 CHECK_FONT_SPEC (font
);
4042 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4046 if (EQ (prop
, QCname
)
4047 || EQ (prop
, QCscript
)
4048 || EQ (prop
, QClang
)
4049 || EQ (prop
, QCotf
))
4050 CHECK_FONT_SPEC (font
);
4053 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4058 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4059 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4060 Optional 2nd argument FRAME specifies the target frame.
4061 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4062 Optional 4th argument PREFER, if non-nil, is a font-spec to
4063 control the order of the returned list. Fonts are sorted by
4064 how close they are to PREFER. */)
4065 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4067 Lisp_Object vec
, list
;
4071 frame
= selected_frame
;
4072 CHECK_LIVE_FRAME (frame
);
4073 CHECK_FONT_SPEC (font_spec
);
4081 if (! NILP (prefer
))
4082 CHECK_FONT_SPEC (prefer
);
4084 list
= font_list_entities (frame
, font_spec
);
4087 if (NILP (XCDR (list
))
4088 && ASIZE (XCAR (list
)) == 1)
4089 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4091 if (! NILP (prefer
))
4092 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4094 vec
= font_vconcat_entity_vectors (list
);
4095 if (n
== 0 || n
>= ASIZE (vec
))
4097 Lisp_Object args
[2];
4101 list
= Fappend (2, args
);
4105 for (list
= Qnil
, n
--; n
>= 0; n
--)
4106 list
= Fcons (AREF (vec
, n
), list
);
4111 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4112 doc
: /* List available font families on the current frame.
4113 Optional argument FRAME, if non-nil, specifies the target frame. */)
4117 struct font_driver_list
*driver_list
;
4121 frame
= selected_frame
;
4122 CHECK_LIVE_FRAME (frame
);
4125 for (driver_list
= f
->font_driver_list
; driver_list
;
4126 driver_list
= driver_list
->next
)
4127 if (driver_list
->driver
->list_family
)
4129 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4130 Lisp_Object tail
= list
;
4132 for (; CONSP (val
); val
= XCDR (val
))
4133 if (NILP (Fmemq (XCAR (val
), tail
))
4134 && SYMBOLP (XCAR (val
)))
4135 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4140 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4141 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4142 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4143 (Lisp_Object font_spec
, Lisp_Object frame
)
4145 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4152 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4153 doc
: /* Return XLFD name of FONT.
4154 FONT is a font-spec, font-entity, or font-object.
4155 If the name is too long for XLFD (maximum 255 chars), return nil.
4156 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4157 the consecutive wildcards are folded into one. */)
4158 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4165 if (FONT_OBJECT_P (font
))
4167 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4169 if (STRINGP (font_name
)
4170 && SDATA (font_name
)[0] == '-')
4172 if (NILP (fold_wildcards
))
4174 strcpy (name
, SSDATA (font_name
));
4177 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4179 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4182 if (! NILP (fold_wildcards
))
4184 char *p0
= name
, *p1
;
4186 while ((p1
= strstr (p0
, "-*-*")))
4188 strcpy (p1
, p1
+ 2);
4193 return build_string (name
);
4196 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4197 doc
: /* Clear font cache. */)
4200 Lisp_Object list
, frame
;
4202 FOR_EACH_FRAME (list
, frame
)
4204 FRAME_PTR f
= XFRAME (frame
);
4205 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4207 for (; driver_list
; driver_list
= driver_list
->next
)
4208 if (driver_list
->on
)
4210 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4211 Lisp_Object val
, tmp
;
4215 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4217 font_assert (! NILP (val
));
4218 tmp
= XCDR (XCAR (val
));
4219 if (XINT (XCAR (tmp
)) == 0)
4221 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4222 XSETCDR (cache
, XCDR (val
));
4232 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4234 struct font
*font
= XFONT_OBJECT (font_object
);
4236 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4237 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4238 struct font_metrics metrics
;
4240 LGLYPH_SET_CODE (glyph
, ecode
);
4242 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4243 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4244 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4245 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4246 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4247 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4251 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4252 doc
: /* Shape the glyph-string GSTRING.
4253 Shaping means substituting glyphs and/or adjusting positions of glyphs
4254 to get the correct visual image of character sequences set in the
4255 header of the glyph-string.
4257 If the shaping was successful, the value is GSTRING itself or a newly
4258 created glyph-string. Otherwise, the value is nil. */)
4259 (Lisp_Object gstring
)
4262 Lisp_Object font_object
, n
, glyph
;
4263 EMACS_INT i
, j
, from
, to
;
4265 if (! composition_gstring_p (gstring
))
4266 signal_error ("Invalid glyph-string: ", gstring
);
4267 if (! NILP (LGSTRING_ID (gstring
)))
4269 font_object
= LGSTRING_FONT (gstring
);
4270 CHECK_FONT_OBJECT (font_object
);
4271 font
= XFONT_OBJECT (font_object
);
4272 if (! font
->driver
->shape
)
4275 /* Try at most three times with larger gstring each time. */
4276 for (i
= 0; i
< 3; i
++)
4278 n
= font
->driver
->shape (gstring
);
4281 gstring
= larger_vector (gstring
,
4282 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4285 if (i
== 3 || XINT (n
) == 0)
4287 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4288 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4290 glyph
= LGSTRING_GLYPH (gstring
, 0);
4291 from
= LGLYPH_FROM (glyph
);
4292 to
= LGLYPH_TO (glyph
);
4293 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4295 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4299 if (NILP (LGLYPH_ADJUSTMENT (this)))
4304 glyph
= LGSTRING_GLYPH (gstring
, j
);
4305 LGLYPH_SET_FROM (glyph
, from
);
4306 LGLYPH_SET_TO (glyph
, to
);
4308 from
= LGLYPH_FROM (this);
4309 to
= LGLYPH_TO (this);
4314 if (from
> LGLYPH_FROM (this))
4315 from
= LGLYPH_FROM (this);
4316 if (to
< LGLYPH_TO (this))
4317 to
= LGLYPH_TO (this);
4323 glyph
= LGSTRING_GLYPH (gstring
, j
);
4324 LGLYPH_SET_FROM (glyph
, from
);
4325 LGLYPH_SET_TO (glyph
, to
);
4327 return composition_gstring_put_cache (gstring
, XINT (n
));
4330 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4332 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4333 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4335 VARIATION-SELECTOR is a character code of variation selection
4336 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4337 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4338 (Lisp_Object font_object
, Lisp_Object character
)
4340 unsigned variations
[256];
4345 CHECK_FONT_OBJECT (font_object
);
4346 CHECK_CHARACTER (character
);
4347 font
= XFONT_OBJECT (font_object
);
4348 if (! font
->driver
->get_variation_glyphs
)
4350 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4354 for (i
= 0; i
< 255; i
++)
4357 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4358 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4359 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4366 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4367 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4368 OTF-FEATURES specifies which features to apply in this format:
4369 (SCRIPT LANGSYS GSUB GPOS)
4371 SCRIPT is a symbol specifying a script tag of OpenType,
4372 LANGSYS is a symbol specifying a langsys tag of OpenType,
4373 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4375 If LANGYS is nil, the default langsys is selected.
4377 The features are applied in the order they appear in the list. The
4378 symbol `*' means to apply all available features not present in this
4379 list, and the remaining features are ignored. For instance, (vatu
4380 pstf * haln) is to apply vatu and pstf in this order, then to apply
4381 all available features other than vatu, pstf, and haln.
4383 The features are applied to the glyphs in the range FROM and TO of
4384 the glyph-string GSTRING-IN.
4386 If some feature is actually applicable, the resulting glyphs are
4387 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4388 this case, the value is the number of produced glyphs.
4390 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4393 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4394 produced in GSTRING-OUT, and the value is nil.
4396 See the documentation of `composition-get-gstring' for the format of
4398 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4400 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4405 check_otf_features (otf_features
);
4406 CHECK_FONT_OBJECT (font_object
);
4407 font
= XFONT_OBJECT (font_object
);
4408 if (! font
->driver
->otf_drive
)
4409 error ("Font backend %s can't drive OpenType GSUB table",
4410 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4411 CHECK_CONS (otf_features
);
4412 CHECK_SYMBOL (XCAR (otf_features
));
4413 val
= XCDR (otf_features
);
4414 CHECK_SYMBOL (XCAR (val
));
4415 val
= XCDR (otf_features
);
4418 len
= check_gstring (gstring_in
);
4419 CHECK_VECTOR (gstring_out
);
4420 CHECK_NATNUM (from
);
4422 CHECK_NATNUM (index
);
4424 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4425 args_out_of_range_3 (from
, to
, make_number (len
));
4426 if (XINT (index
) >= ASIZE (gstring_out
))
4427 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4428 num
= font
->driver
->otf_drive (font
, otf_features
,
4429 gstring_in
, XINT (from
), XINT (to
),
4430 gstring_out
, XINT (index
), 0);
4433 return make_number (num
);
4436 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4438 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4439 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4441 (SCRIPT LANGSYS FEATURE ...)
4442 See the documentation of `font-drive-otf' for more detail.
4444 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4445 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4446 character code corresponding to the glyph or nil if there's no
4447 corresponding character. */)
4448 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4451 Lisp_Object gstring_in
, gstring_out
, g
;
4452 Lisp_Object alternates
;
4455 CHECK_FONT_GET_OBJECT (font_object
, font
);
4456 if (! font
->driver
->otf_drive
)
4457 error ("Font backend %s can't drive OpenType GSUB table",
4458 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4459 CHECK_CHARACTER (character
);
4460 CHECK_CONS (otf_features
);
4462 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4463 g
= LGSTRING_GLYPH (gstring_in
, 0);
4464 LGLYPH_SET_CHAR (g
, XINT (character
));
4465 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4466 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4467 gstring_out
, 0, 1)) < 0)
4468 gstring_out
= Ffont_make_gstring (font_object
,
4469 make_number (ASIZE (gstring_out
) * 2));
4471 for (i
= 0; i
< num
; i
++)
4473 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4474 int c
= LGLYPH_CHAR (g
);
4475 unsigned code
= LGLYPH_CODE (g
);
4477 alternates
= Fcons (Fcons (make_number (code
),
4478 c
> 0 ? make_number (c
) : Qnil
),
4481 return Fnreverse (alternates
);
4487 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4488 doc
: /* Open FONT-ENTITY. */)
4489 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4493 CHECK_FONT_ENTITY (font_entity
);
4495 frame
= selected_frame
;
4496 CHECK_LIVE_FRAME (frame
);
4499 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4502 CHECK_NUMBER_OR_FLOAT (size
);
4504 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4506 isize
= XINT (size
);
4510 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4513 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4514 doc
: /* Close FONT-OBJECT. */)
4515 (Lisp_Object font_object
, Lisp_Object frame
)
4517 CHECK_FONT_OBJECT (font_object
);
4519 frame
= selected_frame
;
4520 CHECK_LIVE_FRAME (frame
);
4521 font_close_object (XFRAME (frame
), font_object
);
4525 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4526 doc
: /* Return information about FONT-OBJECT.
4527 The value is a vector:
4528 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4531 NAME is the font name, a string (or nil if the font backend doesn't
4534 FILENAME is the font file name, a string (or nil if the font backend
4535 doesn't provide a file name).
4537 PIXEL-SIZE is a pixel size by which the font is opened.
4539 SIZE is a maximum advance width of the font in pixels.
4541 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4544 CAPABILITY is a list whose first element is a symbol representing the
4545 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4546 remaining elements describe the details of the font capability.
4548 If the font is OpenType font, the form of the list is
4549 \(opentype GSUB GPOS)
4550 where GSUB shows which "GSUB" features the font supports, and GPOS
4551 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4552 lists of the format:
4553 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4555 If the font is not OpenType font, currently the length of the form is
4558 SCRIPT is a symbol representing OpenType script tag.
4560 LANGSYS is a symbol representing OpenType langsys tag, or nil
4561 representing the default langsys.
4563 FEATURE is a symbol representing OpenType feature tag.
4565 If the font is not OpenType font, CAPABILITY is nil. */)
4566 (Lisp_Object font_object
)
4571 CHECK_FONT_GET_OBJECT (font_object
, font
);
4573 val
= Fmake_vector (make_number (9), Qnil
);
4574 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4575 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4576 ASET (val
, 2, make_number (font
->pixel_size
));
4577 ASET (val
, 3, make_number (font
->max_width
));
4578 ASET (val
, 4, make_number (font
->ascent
));
4579 ASET (val
, 5, make_number (font
->descent
));
4580 ASET (val
, 6, make_number (font
->space_width
));
4581 ASET (val
, 7, make_number (font
->average_width
));
4582 if (font
->driver
->otf_capability
)
4583 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4587 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4589 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4590 FROM and TO are positions (integers or markers) specifying a region
4591 of the current buffer.
4592 If the optional fourth arg OBJECT is not nil, it is a string or a
4593 vector containing the target characters.
4595 Each element is a vector containing information of a glyph in this format:
4596 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4598 FROM is an index numbers of a character the glyph corresponds to.
4599 TO is the same as FROM.
4600 C is the character of the glyph.
4601 CODE is the glyph-code of C in FONT-OBJECT.
4602 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4603 ADJUSTMENT is always nil.
4604 If FONT-OBJECT doesn't have a glyph for a character,
4605 the corresponding element is nil. */)
4606 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4611 Lisp_Object
*chars
, vec
;
4614 CHECK_FONT_GET_OBJECT (font_object
, font
);
4617 EMACS_INT charpos
, bytepos
;
4619 validate_region (&from
, &to
);
4622 len
= XFASTINT (to
) - XFASTINT (from
);
4623 SAFE_ALLOCA_LISP (chars
, len
);
4624 charpos
= XFASTINT (from
);
4625 bytepos
= CHAR_TO_BYTE (charpos
);
4626 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4629 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4630 chars
[i
] = make_number (c
);
4633 else if (STRINGP (object
))
4635 const unsigned char *p
;
4637 CHECK_NUMBER (from
);
4639 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4640 || XINT (to
) > SCHARS (object
))
4641 args_out_of_range_3 (object
, from
, to
);
4644 len
= XFASTINT (to
) - XFASTINT (from
);
4645 SAFE_ALLOCA_LISP (chars
, len
);
4647 if (STRING_MULTIBYTE (object
))
4648 for (i
= 0; i
< len
; i
++)
4650 int c
= STRING_CHAR_ADVANCE (p
);
4651 chars
[i
] = make_number (c
);
4654 for (i
= 0; i
< len
; i
++)
4655 chars
[i
] = make_number (p
[i
]);
4659 CHECK_VECTOR (object
);
4660 CHECK_NUMBER (from
);
4662 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4663 || XINT (to
) > ASIZE (object
))
4664 args_out_of_range_3 (object
, from
, to
);
4667 len
= XFASTINT (to
) - XFASTINT (from
);
4668 for (i
= 0; i
< len
; i
++)
4670 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4671 CHECK_CHARACTER (elt
);
4673 chars
= &(AREF (object
, XFASTINT (from
)));
4676 vec
= Fmake_vector (make_number (len
), Qnil
);
4677 for (i
= 0; i
< len
; i
++)
4680 int c
= XFASTINT (chars
[i
]);
4682 struct font_metrics metrics
;
4684 code
= font
->driver
->encode_char (font
, c
);
4685 if (code
== FONT_INVALID_CODE
)
4687 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4688 LGLYPH_SET_FROM (g
, i
);
4689 LGLYPH_SET_TO (g
, i
);
4690 LGLYPH_SET_CHAR (g
, c
);
4691 LGLYPH_SET_CODE (g
, code
);
4692 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4693 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4694 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4695 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4696 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4697 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4700 if (! VECTORP (object
))
4705 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4706 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4707 FONT is a font-spec, font-entity, or font-object. */)
4708 (Lisp_Object spec
, Lisp_Object font
)
4710 CHECK_FONT_SPEC (spec
);
4713 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4716 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4717 doc
: /* Return a font-object for displaying a character at POSITION.
4718 Optional second arg WINDOW, if non-nil, is a window displaying
4719 the current buffer. It defaults to the currently selected window. */)
4720 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4727 CHECK_NUMBER_COERCE_MARKER (position
);
4728 pos
= XINT (position
);
4729 if (pos
< BEGV
|| pos
>= ZV
)
4730 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4734 CHECK_NUMBER (position
);
4735 CHECK_STRING (string
);
4736 pos
= XINT (position
);
4737 if (pos
< 0 || pos
>= SCHARS (string
))
4738 args_out_of_range (string
, position
);
4741 window
= selected_window
;
4742 CHECK_LIVE_WINDOW (window
);
4743 w
= XWINDOW (window
);
4745 return font_at (-1, pos
, NULL
, w
, string
);
4749 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4750 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4751 The value is a number of glyphs drawn.
4752 Type C-l to recover what previously shown. */)
4753 (Lisp_Object font_object
, Lisp_Object string
)
4755 Lisp_Object frame
= selected_frame
;
4756 FRAME_PTR f
= XFRAME (frame
);
4762 CHECK_FONT_GET_OBJECT (font_object
, font
);
4763 CHECK_STRING (string
);
4764 len
= SCHARS (string
);
4765 code
= alloca (sizeof (unsigned) * len
);
4766 for (i
= 0; i
< len
; i
++)
4768 Lisp_Object ch
= Faref (string
, make_number (i
));
4772 code
[i
] = font
->driver
->encode_char (font
, c
);
4773 if (code
[i
] == FONT_INVALID_CODE
)
4776 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4778 if (font
->driver
->prepare_face
)
4779 font
->driver
->prepare_face (f
, face
);
4780 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4781 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4782 if (font
->driver
->done_face
)
4783 font
->driver
->done_face (f
, face
);
4785 return make_number (len
);
4789 #endif /* FONT_DEBUG */
4791 #ifdef HAVE_WINDOW_SYSTEM
4793 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4794 doc
: /* Return information about a font named NAME on frame FRAME.
4795 If FRAME is omitted or nil, use the selected frame.
4796 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4797 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4799 OPENED-NAME is the name used for opening the font,
4800 FULL-NAME is the full name of the font,
4801 SIZE is the pixelsize of the font,
4802 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4803 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4804 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4805 how to compose characters.
4806 If the named font is not yet loaded, return nil. */)
4807 (Lisp_Object name
, Lisp_Object frame
)
4812 Lisp_Object font_object
;
4814 (*check_window_system_func
) ();
4817 CHECK_STRING (name
);
4819 frame
= selected_frame
;
4820 CHECK_LIVE_FRAME (frame
);
4825 int fontset
= fs_query_fontset (name
, 0);
4828 name
= fontset_ascii (fontset
);
4829 font_object
= font_open_by_name (f
, SSDATA (name
));
4831 else if (FONT_OBJECT_P (name
))
4833 else if (FONT_ENTITY_P (name
))
4834 font_object
= font_open_entity (f
, name
, 0);
4837 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4838 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4840 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4842 if (NILP (font_object
))
4844 font
= XFONT_OBJECT (font_object
);
4846 info
= Fmake_vector (make_number (7), Qnil
);
4847 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4848 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4849 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4850 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4851 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4852 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4853 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4856 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4857 close it now. Perhaps, we should manage font-objects
4858 by `reference-count'. */
4859 font_close_object (f
, font_object
);
4866 #define BUILD_STYLE_TABLE(TBL) \
4867 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4870 build_style_table (const struct table_entry
*entry
, int nelement
)
4873 Lisp_Object table
, elt
;
4875 table
= Fmake_vector (make_number (nelement
), Qnil
);
4876 for (i
= 0; i
< nelement
; i
++)
4878 for (j
= 0; entry
[i
].names
[j
]; j
++);
4879 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4880 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4881 for (j
= 0; entry
[i
].names
[j
]; j
++)
4882 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4883 ASET (table
, i
, elt
);
4888 /* The deferred font-log data of the form [ACTION ARG RESULT].
4889 If ACTION is not nil, that is added to the log when font_add_log is
4890 called next time. At that time, ACTION is set back to nil. */
4891 static Lisp_Object Vfont_log_deferred
;
4893 /* Prepend the font-related logging data in Vfont_log if it is not
4894 `t'. ACTION describes a kind of font-related action (e.g. listing,
4895 opening), ARG is the argument for the action, and RESULT is the
4896 result of the action. */
4898 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4903 if (EQ (Vfont_log
, Qt
))
4905 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4907 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4909 ASET (Vfont_log_deferred
, 0, Qnil
);
4910 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4911 AREF (Vfont_log_deferred
, 2));
4916 Lisp_Object tail
, elt
;
4917 Lisp_Object equalstr
= build_string ("=");
4919 val
= Ffont_xlfd_name (arg
, Qt
);
4920 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4924 if (EQ (XCAR (elt
), QCscript
)
4925 && SYMBOLP (XCDR (elt
)))
4926 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4927 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4928 else if (EQ (XCAR (elt
), QClang
)
4929 && SYMBOLP (XCDR (elt
)))
4930 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4931 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4932 else if (EQ (XCAR (elt
), QCotf
)
4933 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4934 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4936 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4942 && VECTORP (XCAR (result
))
4943 && ASIZE (XCAR (result
)) > 0
4944 && FONTP (AREF (XCAR (result
), 0)))
4945 result
= font_vconcat_entity_vectors (result
);
4948 val
= Ffont_xlfd_name (result
, Qt
);
4949 if (! FONT_SPEC_P (result
))
4950 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4951 build_string (":"), val
);
4954 else if (CONSP (result
))
4957 result
= Fcopy_sequence (result
);
4958 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4962 val
= Ffont_xlfd_name (val
, Qt
);
4963 XSETCAR (tail
, val
);
4966 else if (VECTORP (result
))
4968 result
= Fcopy_sequence (result
);
4969 for (i
= 0; i
< ASIZE (result
); i
++)
4971 val
= AREF (result
, i
);
4973 val
= Ffont_xlfd_name (val
, Qt
);
4974 ASET (result
, i
, val
);
4977 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4980 /* Record a font-related logging data to be added to Vfont_log when
4981 font_add_log is called next time. ACTION, ARG, RESULT are the same
4985 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4987 if (EQ (Vfont_log
, Qt
))
4989 ASET (Vfont_log_deferred
, 0, build_string (action
));
4990 ASET (Vfont_log_deferred
, 1, arg
);
4991 ASET (Vfont_log_deferred
, 2, result
);
4997 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4998 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4999 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5000 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5001 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5002 /* Note that the other elements in sort_shift_bits are not used. */
5004 staticpro (&font_charset_alist
);
5005 font_charset_alist
= Qnil
;
5007 DEFSYM (Qopentype
, "opentype");
5009 DEFSYM (Qascii_0
, "ascii-0");
5010 DEFSYM (Qiso8859_1
, "iso8859-1");
5011 DEFSYM (Qiso10646_1
, "iso10646-1");
5012 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5013 DEFSYM (Qunicode_sip
, "unicode-sip");
5017 DEFSYM (QCotf
, ":otf");
5018 DEFSYM (QClang
, ":lang");
5019 DEFSYM (QCscript
, ":script");
5020 DEFSYM (QCantialias
, ":antialias");
5022 DEFSYM (QCfoundry
, ":foundry");
5023 DEFSYM (QCadstyle
, ":adstyle");
5024 DEFSYM (QCregistry
, ":registry");
5025 DEFSYM (QCspacing
, ":spacing");
5026 DEFSYM (QCdpi
, ":dpi");
5027 DEFSYM (QCscalable
, ":scalable");
5028 DEFSYM (QCavgwidth
, ":avgwidth");
5029 DEFSYM (QCfont_entity
, ":font-entity");
5030 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5040 DEFSYM (QCuser_spec
, "user-spec");
5042 staticpro (&null_vector
);
5043 null_vector
= Fmake_vector (make_number (0), Qnil
);
5045 staticpro (&scratch_font_spec
);
5046 scratch_font_spec
= Ffont_spec (0, NULL
);
5047 staticpro (&scratch_font_prefer
);
5048 scratch_font_prefer
= Ffont_spec (0, NULL
);
5050 staticpro (&Vfont_log_deferred
);
5051 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5055 staticpro (&otf_list
);
5057 #endif /* HAVE_LIBOTF */
5061 defsubr (&Sfont_spec
);
5062 defsubr (&Sfont_get
);
5063 #ifdef HAVE_WINDOW_SYSTEM
5064 defsubr (&Sfont_face_attributes
);
5066 defsubr (&Sfont_put
);
5067 defsubr (&Slist_fonts
);
5068 defsubr (&Sfont_family_list
);
5069 defsubr (&Sfind_font
);
5070 defsubr (&Sfont_xlfd_name
);
5071 defsubr (&Sclear_font_cache
);
5072 defsubr (&Sfont_shape_gstring
);
5073 defsubr (&Sfont_variation_glyphs
);
5075 defsubr (&Sfont_drive_otf
);
5076 defsubr (&Sfont_otf_alternates
);
5080 defsubr (&Sopen_font
);
5081 defsubr (&Sclose_font
);
5082 defsubr (&Squery_font
);
5083 defsubr (&Sfont_get_glyphs
);
5084 defsubr (&Sfont_match_p
);
5085 defsubr (&Sfont_at
);
5087 defsubr (&Sdraw_string
);
5089 #endif /* FONT_DEBUG */
5090 #ifdef HAVE_WINDOW_SYSTEM
5091 defsubr (&Sfont_info
);
5094 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5096 Alist of fontname patterns vs the corresponding encoding and repertory info.
5097 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5098 where ENCODING is a charset or a char-table,
5099 and REPERTORY is a charset, a char-table, or nil.
5101 If ENCODING and REPERTORY are the same, the element can have the form
5102 \(REGEXP . ENCODING).
5104 ENCODING is for converting a character to a glyph code of the font.
5105 If ENCODING is a charset, encoding a character by the charset gives
5106 the corresponding glyph code. If ENCODING is a char-table, looking up
5107 the table by a character gives the corresponding glyph code.
5109 REPERTORY specifies a repertory of characters supported by the font.
5110 If REPERTORY is a charset, all characters beloging to the charset are
5111 supported. If REPERTORY is a char-table, all characters who have a
5112 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5113 gets the repertory information by an opened font and ENCODING. */);
5114 Vfont_encoding_alist
= Qnil
;
5116 /* FIXME: These 3 vars are not quite what they appear: setq on them
5117 won't have any effect other than disconnect them from the style
5118 table used by the font display code. So we make them read-only,
5119 to avoid this confusing situation. */
5121 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5122 doc
: /* Vector of valid font weight values.
5123 Each element has the form:
5124 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5125 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5126 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5127 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5129 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5130 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5131 See `font-weight-table' for the format of the vector. */);
5132 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5133 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5135 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5136 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5137 See `font-weight-table' for the format of the vector. */);
5138 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5139 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5141 staticpro (&font_style_table
);
5142 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5143 ASET (font_style_table
, 0, Vfont_weight_table
);
5144 ASET (font_style_table
, 1, Vfont_slant_table
);
5145 ASET (font_style_table
, 2, Vfont_width_table
);
5147 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5148 *Logging list of font related actions and results.
5149 The value t means to suppress the logging.
5150 The initial value is set to nil if the environment variable
5151 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5154 #ifdef HAVE_WINDOW_SYSTEM
5155 #ifdef HAVE_FREETYPE
5157 #ifdef HAVE_X_WINDOWS
5162 #endif /* HAVE_XFT */
5163 #endif /* HAVE_X_WINDOWS */
5164 #else /* not HAVE_FREETYPE */
5165 #ifdef HAVE_X_WINDOWS
5167 #endif /* HAVE_X_WINDOWS */
5168 #endif /* not HAVE_FREETYPE */
5171 #endif /* HAVE_BDFFONT */
5174 #endif /* WINDOWSNT */
5177 #endif /* HAVE_NS */
5178 #endif /* HAVE_WINDOW_SYSTEM */
5184 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;