1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2012 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/>. */
30 #include "character.h"
34 #include "dispextern.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 /* Creators of font-related Lisp object. */
168 font_make_spec (void)
170 Lisp_Object font_spec
;
171 struct font_spec
*spec
172 = ((struct font_spec
*)
173 allocate_pseudovector (VECSIZE (struct font_spec
),
174 FONT_SPEC_MAX
, PVEC_FONT
));
175 XSETFONT (font_spec
, spec
);
180 font_make_entity (void)
182 Lisp_Object font_entity
;
183 struct font_entity
*entity
184 = ((struct font_entity
*)
185 allocate_pseudovector (VECSIZE (struct font_entity
),
186 FONT_ENTITY_MAX
, PVEC_FONT
));
187 XSETFONT (font_entity
, entity
);
191 /* Create a font-object whose structure size is SIZE. If ENTITY is
192 not nil, copy properties from ENTITY to the font-object. If
193 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
195 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
197 Lisp_Object font_object
;
199 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
202 XSETFONT (font_object
, font
);
206 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
207 font
->props
[i
] = AREF (entity
, i
);
208 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
209 font
->props
[FONT_EXTRA_INDEX
]
210 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
213 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
219 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
220 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
221 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
223 static unsigned font_encode_char (Lisp_Object
, int);
225 /* Number of registered font drivers. */
226 static int num_font_drivers
;
229 /* Return a Lispy value of a font property value at STR and LEN bytes.
230 If STR is "*", return nil.
231 If FORCE_SYMBOL is zero and all characters in STR are digits,
232 return an integer. Otherwise, return a symbol interned from
236 font_intern_prop (const char *str
, ptrdiff_t len
, int force_symbol
)
241 ptrdiff_t nbytes
, nchars
;
243 if (len
== 1 && *str
== '*')
245 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
247 for (i
= 1; i
< len
; i
++)
248 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
255 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
258 return make_number (n
);
259 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
263 xsignal1 (Qoverflow_error
, make_string (str
, len
));
267 /* The following code is copied from the function intern (in
268 lread.c), and modified to suit our purpose. */
270 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
271 obarray
= check_obarray (obarray
);
272 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
273 if (len
== nchars
|| len
!= nbytes
)
274 /* CONTENTS contains no multibyte sequences or contains an invalid
275 multibyte sequence. We'll make a unibyte string. */
276 tem
= oblookup (obarray
, str
, len
, len
);
278 tem
= oblookup (obarray
, str
, nchars
, len
);
281 if (len
== nchars
|| len
!= nbytes
)
282 tem
= make_unibyte_string (str
, len
);
284 tem
= make_multibyte_string (str
, nchars
, len
);
285 return Fintern (tem
, obarray
);
288 /* Return a pixel size of font-spec SPEC on frame F. */
291 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
293 #ifdef HAVE_WINDOW_SYSTEM
294 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
303 font_assert (FLOATP (size
));
304 point_size
= XFLOAT_DATA (size
);
305 val
= AREF (spec
, FONT_DPI_INDEX
);
310 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
318 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
319 font vector. If VAL is not valid (i.e. not registered in
320 font_style_table), return -1 if NOERROR is zero, and return a
321 proper index if NOERROR is nonzero. In that case, register VAL in
322 font_style_table if VAL is a symbol, and return the closest index if
323 VAL is an integer. */
326 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
328 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
331 CHECK_VECTOR (table
);
338 Lisp_Object args
[2], elt
;
340 /* At first try exact match. */
341 for (i
= 0; i
< len
; i
++)
343 CHECK_VECTOR (AREF (table
, i
));
344 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
345 if (EQ (val
, AREF (AREF (table
, i
), j
)))
347 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
348 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
349 | (i
<< 4) | (j
- 1));
352 /* Try also with case-folding match. */
353 s
= SSDATA (SYMBOL_NAME (val
));
354 for (i
= 0; i
< len
; i
++)
355 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
357 elt
= AREF (AREF (table
, i
), j
);
358 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
360 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
361 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
362 | (i
<< 4) | (j
- 1));
369 elt
= Fmake_vector (make_number (2), make_number (100));
372 args
[1] = Fmake_vector (make_number (1), elt
);
373 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
374 return (100 << 8) | (i
<< 4);
379 EMACS_INT numeric
= XINT (val
);
381 for (i
= 0, last_n
= -1; i
< len
; i
++)
385 CHECK_VECTOR (AREF (table
, i
));
386 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
387 n
= XINT (AREF (AREF (table
, i
), 0));
389 return (n
<< 8) | (i
<< 4);
394 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
395 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
401 return ((last_n
<< 8) | ((i
- 1) << 4));
406 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
408 Lisp_Object val
= AREF (font
, prop
);
409 Lisp_Object table
, elt
;
414 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
415 CHECK_VECTOR (table
);
416 i
= XINT (val
) & 0xFF;
417 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
418 elt
= AREF (table
, ((i
>> 4) & 0xF));
420 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
421 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
426 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
427 FONTNAME. ENCODING is a charset symbol that specifies the encoding
428 of the font. REPERTORY is a charset symbol or nil. */
431 find_font_encoding (Lisp_Object fontname
)
433 Lisp_Object tail
, elt
;
435 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
439 && STRINGP (XCAR (elt
))
440 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
441 && (SYMBOLP (XCDR (elt
))
442 ? CHARSETP (XCDR (elt
))
443 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
449 /* Return encoding charset and repertory charset for REGISTRY in
450 ENCODING and REPERTORY correspondingly. If correct information for
451 REGISTRY is available, return 0. Otherwise return -1. */
454 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
457 int encoding_id
, repertory_id
;
459 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
465 encoding_id
= XINT (XCAR (val
));
466 repertory_id
= XINT (XCDR (val
));
470 val
= find_font_encoding (SYMBOL_NAME (registry
));
471 if (SYMBOLP (val
) && CHARSETP (val
))
473 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
475 else if (CONSP (val
))
477 if (! CHARSETP (XCAR (val
)))
479 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
480 if (NILP (XCDR (val
)))
484 if (! CHARSETP (XCDR (val
)))
486 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
491 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
493 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
497 *encoding
= CHARSET_FROM_ID (encoding_id
);
499 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
504 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
509 /* Font property value validators. See the comment of
510 font_property_table for the meaning of the arguments. */
512 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
513 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
514 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
515 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
516 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
517 static int get_font_prop_index (Lisp_Object
);
520 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
523 val
= Fintern (val
, Qnil
);
526 else if (EQ (prop
, QCregistry
))
527 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
533 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
535 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
536 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
540 EMACS_INT n
= XINT (val
);
541 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
543 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
547 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
550 if ((n
& 0xF) + 1 >= ASIZE (elt
))
554 CHECK_NUMBER (AREF (elt
, 0));
555 if (XINT (AREF (elt
, 0)) != (n
>> 8))
560 else if (SYMBOLP (val
))
562 int n
= font_style_to_value (prop
, val
, 0);
564 val
= n
>= 0 ? make_number (n
) : Qerror
;
572 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
574 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
579 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
581 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
583 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
585 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
587 if (spacing
== 'c' || spacing
== 'C')
588 return make_number (FONT_SPACING_CHARCELL
);
589 if (spacing
== 'm' || spacing
== 'M')
590 return make_number (FONT_SPACING_MONO
);
591 if (spacing
== 'p' || spacing
== 'P')
592 return make_number (FONT_SPACING_PROPORTIONAL
);
593 if (spacing
== 'd' || spacing
== 'D')
594 return make_number (FONT_SPACING_DUAL
);
600 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
602 Lisp_Object tail
, tmp
;
605 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
606 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
607 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
610 if (! SYMBOLP (XCAR (val
)))
615 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
617 for (i
= 0; i
< 2; i
++)
624 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
625 if (! SYMBOLP (XCAR (tmp
)))
633 /* Structure of known font property keys and validator of the
637 /* Pointer to the key symbol. */
639 /* Function to validate PROP's value VAL, or NULL if any value is
640 ok. The value is VAL or its regularized value if VAL is valid,
641 and Qerror if not. */
642 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
643 } font_property_table
[] =
644 { { &QCtype
, font_prop_validate_symbol
},
645 { &QCfoundry
, font_prop_validate_symbol
},
646 { &QCfamily
, font_prop_validate_symbol
},
647 { &QCadstyle
, font_prop_validate_symbol
},
648 { &QCregistry
, font_prop_validate_symbol
},
649 { &QCweight
, font_prop_validate_style
},
650 { &QCslant
, font_prop_validate_style
},
651 { &QCwidth
, font_prop_validate_style
},
652 { &QCsize
, font_prop_validate_non_neg
},
653 { &QCdpi
, font_prop_validate_non_neg
},
654 { &QCspacing
, font_prop_validate_spacing
},
655 { &QCavgwidth
, font_prop_validate_non_neg
},
656 /* The order of the above entries must match with enum
657 font_property_index. */
658 { &QClang
, font_prop_validate_symbol
},
659 { &QCscript
, font_prop_validate_symbol
},
660 { &QCotf
, font_prop_validate_otf
}
663 /* Size (number of elements) of the above table. */
664 #define FONT_PROPERTY_TABLE_SIZE \
665 ((sizeof font_property_table) / (sizeof *font_property_table))
667 /* Return an index number of font property KEY or -1 if KEY is not an
668 already known property. */
671 get_font_prop_index (Lisp_Object key
)
675 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
676 if (EQ (key
, *font_property_table
[i
].key
))
681 /* Validate the font property. The property key is specified by the
682 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
683 signal an error. The value is VAL or the regularized one. */
686 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
688 Lisp_Object validated
;
693 prop
= *font_property_table
[idx
].key
;
696 idx
= get_font_prop_index (prop
);
700 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
701 if (EQ (validated
, Qerror
))
702 signal_error ("invalid font property", Fcons (prop
, val
));
707 /* Store VAL as a value of extra font property PROP in FONT while
708 keeping the sorting order. Don't check the validity of VAL. */
711 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
713 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
714 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
718 Lisp_Object prev
= Qnil
;
721 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
722 prev
= extra
, extra
= XCDR (extra
);
725 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
727 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
733 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
738 /* Font name parser and unparser */
740 static int parse_matrix (const char *);
741 static int font_expand_wildcards (Lisp_Object
*, int);
742 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
744 /* An enumerator for each field of an XLFD font name. */
745 enum xlfd_field_index
764 /* An enumerator for mask bit corresponding to each XLFD field. */
767 XLFD_FOUNDRY_MASK
= 0x0001,
768 XLFD_FAMILY_MASK
= 0x0002,
769 XLFD_WEIGHT_MASK
= 0x0004,
770 XLFD_SLANT_MASK
= 0x0008,
771 XLFD_SWIDTH_MASK
= 0x0010,
772 XLFD_ADSTYLE_MASK
= 0x0020,
773 XLFD_PIXEL_MASK
= 0x0040,
774 XLFD_POINT_MASK
= 0x0080,
775 XLFD_RESX_MASK
= 0x0100,
776 XLFD_RESY_MASK
= 0x0200,
777 XLFD_SPACING_MASK
= 0x0400,
778 XLFD_AVGWIDTH_MASK
= 0x0800,
779 XLFD_REGISTRY_MASK
= 0x1000,
780 XLFD_ENCODING_MASK
= 0x2000
784 /* Parse P pointing to the pixel/point size field of the form
785 `[A B C D]' which specifies a transformation matrix:
791 by which all glyphs of the font are transformed. The spec says
792 that scalar value N for the pixel/point size is equivalent to:
793 A = N * resx/resy, B = C = 0, D = N.
795 Return the scalar value N if the form is valid. Otherwise return
799 parse_matrix (const char *p
)
805 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
808 matrix
[i
] = - strtod (p
+ 1, &end
);
810 matrix
[i
] = strtod (p
, &end
);
813 return (i
== 4 ? (int) matrix
[3] : -1);
816 /* Expand a wildcard field in FIELD (the first N fields are filled) to
817 multiple fields to fill in all 14 XLFD fields while restricting a
818 field position by its contents. */
821 font_expand_wildcards (Lisp_Object
*field
, int n
)
824 Lisp_Object tmp
[XLFD_LAST_INDEX
];
825 /* Array of information about where this element can go. Nth
826 element is for Nth element of FIELD. */
828 /* Minimum possible field. */
830 /* Maximum possible field. */
832 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
834 } range
[XLFD_LAST_INDEX
];
836 int range_from
, range_to
;
839 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
840 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
841 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
842 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
843 | XLFD_AVGWIDTH_MASK)
844 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
846 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
847 field. The value is shifted to left one bit by one in the
849 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
850 range_mask
= (range_mask
<< 1) | 1;
852 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
853 position-based restriction for FIELD[I]. */
854 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
855 i
++, range_from
++, range_to
++, range_mask
<<= 1)
857 Lisp_Object val
= field
[i
];
863 range
[i
].from
= range_from
;
864 range
[i
].to
= range_to
;
865 range
[i
].mask
= range_mask
;
869 /* The triplet FROM, TO, and MASK is a value-based
870 restriction for FIELD[I]. */
876 EMACS_INT numeric
= XINT (val
);
879 from
= to
= XLFD_ENCODING_INDEX
,
880 mask
= XLFD_ENCODING_MASK
;
881 else if (numeric
== 0)
882 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
883 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
884 else if (numeric
<= 48)
885 from
= to
= XLFD_PIXEL_INDEX
,
886 mask
= XLFD_PIXEL_MASK
;
888 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
889 mask
= XLFD_LARGENUM_MASK
;
891 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
892 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
893 mask
= XLFD_NULL_MASK
;
895 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
898 Lisp_Object name
= SYMBOL_NAME (val
);
900 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
901 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
902 mask
= XLFD_REGENC_MASK
;
904 from
= to
= XLFD_ENCODING_INDEX
,
905 mask
= XLFD_ENCODING_MASK
;
907 else if (range_from
<= XLFD_WEIGHT_INDEX
908 && range_to
>= XLFD_WEIGHT_INDEX
909 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
910 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
911 else if (range_from
<= XLFD_SLANT_INDEX
912 && range_to
>= XLFD_SLANT_INDEX
913 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
914 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
915 else if (range_from
<= XLFD_SWIDTH_INDEX
916 && range_to
>= XLFD_SWIDTH_INDEX
917 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
918 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
921 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
922 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
924 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
925 mask
= XLFD_SYMBOL_MASK
;
928 /* Merge position-based and value-based restrictions. */
930 while (from
< range_from
)
931 mask
&= ~(1 << from
++);
932 while (from
< 14 && ! (mask
& (1 << from
)))
934 while (to
> range_to
)
935 mask
&= ~(1 << to
--);
936 while (to
>= 0 && ! (mask
& (1 << to
)))
940 range
[i
].from
= from
;
942 range
[i
].mask
= mask
;
944 if (from
> range_from
|| to
< range_to
)
946 /* The range is narrowed by value-based restrictions.
947 Reflect it to the other fields. */
949 /* Following fields should be after FROM. */
951 /* Preceding fields should be before TO. */
952 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
954 /* Check FROM for non-wildcard field. */
955 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
957 while (range
[j
].from
< from
)
958 range
[j
].mask
&= ~(1 << range
[j
].from
++);
959 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
961 range
[j
].from
= from
;
964 from
= range
[j
].from
;
965 if (range
[j
].to
> to
)
967 while (range
[j
].to
> to
)
968 range
[j
].mask
&= ~(1 << range
[j
].to
--);
969 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
982 /* Decide all fields from restrictions in RANGE. */
983 for (i
= j
= 0; i
< n
; i
++)
985 if (j
< range
[i
].from
)
987 if (i
== 0 || ! NILP (tmp
[i
- 1]))
988 /* None of TMP[X] corresponds to Jth field. */
990 for (; j
< range
[i
].from
; j
++)
995 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
997 for (; j
< XLFD_LAST_INDEX
; j
++)
999 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1000 field
[XLFD_ENCODING_INDEX
]
1001 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1006 /* Parse NAME (null terminated) as XLFD and store information in FONT
1007 (font-spec or font-entity). Size property of FONT is set as
1009 specified XLFD fields FONT property
1010 --------------------- -------------
1011 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1012 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1013 POINT_SIZE POINT_SIZE/10 (Lisp float)
1015 If NAME is successfully parsed, return 0. Otherwise return -1.
1017 FONT is usually a font-spec, but when this function is called from
1018 X font backend driver, it is a font-entity. In that case, NAME is
1019 a fully specified XLFD. */
1022 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1025 char *f
[XLFD_LAST_INDEX
+ 1];
1029 if (len
> 255 || !len
)
1030 /* Maximum XLFD name length is 255. */
1032 /* Accept "*-.." as a fully specified XLFD. */
1033 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1034 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1037 for (p
= name
+ i
; *p
; p
++)
1041 if (i
== XLFD_LAST_INDEX
)
1046 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1047 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1049 if (i
== XLFD_LAST_INDEX
)
1051 /* Fully specified XLFD. */
1054 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1055 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1056 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1057 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1059 val
= INTERN_FIELD_SYM (i
);
1062 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1064 ASET (font
, j
, make_number (n
));
1067 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1068 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1069 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1071 ASET (font
, FONT_REGISTRY_INDEX
,
1072 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1073 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1075 p
= f
[XLFD_PIXEL_INDEX
];
1076 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1077 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1080 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1082 ASET (font
, FONT_SIZE_INDEX
, val
);
1083 else if (FONT_ENTITY_P (font
))
1087 double point_size
= -1;
1089 font_assert (FONT_SPEC_P (font
));
1090 p
= f
[XLFD_POINT_INDEX
];
1092 point_size
= parse_matrix (p
);
1093 else if (isdigit (*p
))
1094 point_size
= atoi (p
), point_size
/= 10;
1095 if (point_size
>= 0)
1096 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1100 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1101 if (! NILP (val
) && ! INTEGERP (val
))
1103 ASET (font
, FONT_DPI_INDEX
, val
);
1104 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1107 val
= font_prop_validate_spacing (QCspacing
, val
);
1108 if (! INTEGERP (val
))
1110 ASET (font
, FONT_SPACING_INDEX
, val
);
1112 p
= f
[XLFD_AVGWIDTH_INDEX
];
1115 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1116 if (! NILP (val
) && ! INTEGERP (val
))
1118 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1122 int wild_card_found
= 0;
1123 Lisp_Object prop
[XLFD_LAST_INDEX
];
1125 if (FONT_ENTITY_P (font
))
1127 for (j
= 0; j
< i
; j
++)
1131 if (f
[j
][1] && f
[j
][1] != '-')
1134 wild_card_found
= 1;
1137 prop
[j
] = INTERN_FIELD (j
);
1139 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1141 if (! wild_card_found
)
1143 if (font_expand_wildcards (prop
, i
) < 0)
1146 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1147 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1148 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1149 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1150 if (! NILP (prop
[i
]))
1152 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1154 ASET (font
, j
, make_number (n
));
1156 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1157 val
= prop
[XLFD_REGISTRY_INDEX
];
1160 val
= prop
[XLFD_ENCODING_INDEX
];
1162 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1164 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1165 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1167 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1168 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1170 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1172 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1173 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1174 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1176 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1178 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1181 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1182 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1183 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1185 val
= font_prop_validate_spacing (QCspacing
,
1186 prop
[XLFD_SPACING_INDEX
]);
1187 if (! INTEGERP (val
))
1189 ASET (font
, FONT_SPACING_INDEX
, val
);
1191 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1192 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1198 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1199 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1200 0, use PIXEL_SIZE instead. */
1203 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1206 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1210 font_assert (FONTP (font
));
1212 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1215 if (i
== FONT_ADSTYLE_INDEX
)
1216 j
= XLFD_ADSTYLE_INDEX
;
1217 else if (i
== FONT_REGISTRY_INDEX
)
1218 j
= XLFD_REGISTRY_INDEX
;
1219 val
= AREF (font
, i
);
1222 if (j
== XLFD_REGISTRY_INDEX
)
1230 val
= SYMBOL_NAME (val
);
1231 if (j
== XLFD_REGISTRY_INDEX
1232 && ! strchr (SSDATA (val
), '-'))
1234 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1235 ptrdiff_t alloc
= SBYTES (val
) + 4;
1236 if (nbytes
<= alloc
)
1238 f
[j
] = p
= alloca (alloc
);
1239 sprintf (p
, "%s%s-*", SDATA (val
),
1240 "*" + (SDATA (val
)[SBYTES (val
) - 1] == '*'));
1243 f
[j
] = SSDATA (val
);
1247 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1250 val
= font_style_symbolic (font
, i
, 0);
1255 val
= SYMBOL_NAME (val
);
1256 f
[j
] = SSDATA (val
);
1260 val
= AREF (font
, FONT_SIZE_INDEX
);
1261 font_assert (NUMBERP (val
) || NILP (val
));
1264 EMACS_INT v
= XINT (val
);
1269 f
[XLFD_PIXEL_INDEX
] = p
=
1270 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1271 sprintf (p
, "%"pI
"d-*", v
);
1274 f
[XLFD_PIXEL_INDEX
] = "*-*";
1276 else if (FLOATP (val
))
1278 double v
= XFLOAT_DATA (val
) * 10;
1279 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1280 sprintf (p
, "*-%.0f", v
);
1283 f
[XLFD_PIXEL_INDEX
] = "*-*";
1285 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1287 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1288 f
[XLFD_RESX_INDEX
] = p
=
1289 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1290 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1293 f
[XLFD_RESX_INDEX
] = "*-*";
1294 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1296 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1298 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1299 : spacing
<= FONT_SPACING_DUAL
? "d"
1300 : spacing
<= FONT_SPACING_MONO
? "m"
1304 f
[XLFD_SPACING_INDEX
] = "*";
1305 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1307 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1308 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1311 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1312 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1313 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1314 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1315 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1316 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1317 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1318 f
[XLFD_REGISTRY_INDEX
]);
1319 return len
< nbytes
? len
: -1;
1322 /* Parse NAME (null terminated) and store information in FONT
1323 (font-spec or font-entity). NAME is supplied in either the
1324 Fontconfig or GTK font name format. If NAME is successfully
1325 parsed, return 0. Otherwise return -1.
1327 The fontconfig format is
1329 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1333 FAMILY [PROPS...] [SIZE]
1335 This function tries to guess which format it is. */
1338 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1341 char *size_beg
= NULL
, *size_end
= NULL
;
1342 char *props_beg
= NULL
, *family_end
= NULL
;
1347 for (p
= name
; *p
; p
++)
1349 if (*p
== '\\' && p
[1])
1353 props_beg
= family_end
= p
;
1358 int decimal
= 0, size_found
= 1;
1359 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1362 if (*q
!= '.' || decimal
)
1381 Lisp_Object extra_props
= Qnil
;
1383 /* A fontconfig name with size and/or property data. */
1384 if (family_end
> name
)
1387 family
= font_intern_prop (name
, family_end
- name
, 1);
1388 ASET (font
, FONT_FAMILY_INDEX
, family
);
1392 double point_size
= strtod (size_beg
, &size_end
);
1393 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1394 if (*size_end
== ':' && size_end
[1])
1395 props_beg
= size_end
;
1399 /* Now parse ":KEY=VAL" patterns. */
1402 for (p
= props_beg
; *p
; p
= q
)
1404 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1407 /* Must be an enumerated value. */
1411 val
= font_intern_prop (p
, q
- p
, 1);
1413 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1414 && memcmp (p, STR, strlen (STR)) == 0)
1416 if (PROP_MATCH ("light")
1417 || PROP_MATCH ("medium")
1418 || PROP_MATCH ("demibold")
1419 || PROP_MATCH ("bold")
1420 || PROP_MATCH ("black"))
1421 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1422 else if (PROP_MATCH ("roman")
1423 || PROP_MATCH ("italic")
1424 || PROP_MATCH ("oblique"))
1425 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1426 else if (PROP_MATCH ("charcell"))
1427 ASET (font
, FONT_SPACING_INDEX
,
1428 make_number (FONT_SPACING_CHARCELL
));
1429 else if (PROP_MATCH ("mono"))
1430 ASET (font
, FONT_SPACING_INDEX
,
1431 make_number (FONT_SPACING_MONO
));
1432 else if (PROP_MATCH ("proportional"))
1433 ASET (font
, FONT_SPACING_INDEX
,
1434 make_number (FONT_SPACING_PROPORTIONAL
));
1443 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1444 prop
= FONT_SIZE_INDEX
;
1447 key
= font_intern_prop (p
, q
- p
, 1);
1448 prop
= get_font_prop_index (key
);
1452 for (q
= p
; *q
&& *q
!= ':'; q
++);
1453 val
= font_intern_prop (p
, q
- p
, 0);
1455 if (prop
>= FONT_FOUNDRY_INDEX
1456 && prop
< FONT_EXTRA_INDEX
)
1457 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1460 extra_props
= nconc2 (extra_props
,
1461 Fcons (Fcons (key
, val
), Qnil
));
1468 if (! NILP (extra_props
))
1470 struct font_driver_list
*driver_list
= font_driver_list
;
1471 for ( ; driver_list
; driver_list
= driver_list
->next
)
1472 if (driver_list
->driver
->filter_properties
)
1473 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1479 /* Either a fontconfig-style name with no size and property
1480 data, or a GTK-style name. */
1481 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1482 Lisp_Object width
= Qnil
, size
= Qnil
;
1486 /* Scan backwards from the end, looking for a size. */
1487 for (p
= name
+ len
- 1; p
>= name
; p
--)
1491 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1492 /* Found a font size. */
1493 size
= make_float (strtod (p
+ 1, NULL
));
1497 /* Now P points to the termination of the string, sans size.
1498 Scan backwards, looking for font properties. */
1499 for (; p
> name
; p
= q
)
1501 for (q
= p
- 1; q
>= name
; q
--)
1503 if (q
> name
&& *(q
-1) == '\\')
1504 --q
; /* Skip quoting backslashes. */
1510 word_len
= p
- word_start
;
1512 #define PROP_MATCH(STR) \
1513 (word_len == strlen (STR) \
1514 && memcmp (word_start, STR, strlen (STR)) == 0)
1515 #define PROP_SAVE(VAR, STR) \
1516 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1518 if (PROP_MATCH ("Ultra-Light"))
1519 PROP_SAVE (weight
, "ultra-light");
1520 else if (PROP_MATCH ("Light"))
1521 PROP_SAVE (weight
, "light");
1522 else if (PROP_MATCH ("Book"))
1523 PROP_SAVE (weight
, "book");
1524 else if (PROP_MATCH ("Medium"))
1525 PROP_SAVE (weight
, "medium");
1526 else if (PROP_MATCH ("Semi-Bold"))
1527 PROP_SAVE (weight
, "semi-bold");
1528 else if (PROP_MATCH ("Bold"))
1529 PROP_SAVE (weight
, "bold");
1530 else if (PROP_MATCH ("Italic"))
1531 PROP_SAVE (slant
, "italic");
1532 else if (PROP_MATCH ("Oblique"))
1533 PROP_SAVE (slant
, "oblique");
1534 else if (PROP_MATCH ("Semi-Condensed"))
1535 PROP_SAVE (width
, "semi-condensed");
1536 else if (PROP_MATCH ("Condensed"))
1537 PROP_SAVE (width
, "condensed");
1538 /* An unknown word must be part of the font name. */
1549 ASET (font
, FONT_FAMILY_INDEX
,
1550 font_intern_prop (name
, family_end
- name
, 1));
1552 ASET (font
, FONT_SIZE_INDEX
, size
);
1554 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1556 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1558 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1564 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1565 NAME (NBYTES length), and return the name length. If
1566 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1569 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1571 Lisp_Object family
, foundry
;
1577 Lisp_Object styles
[3];
1578 const char *style_names
[3] = { "weight", "slant", "width" };
1580 family
= AREF (font
, FONT_FAMILY_INDEX
);
1581 if (! NILP (family
))
1583 if (SYMBOLP (family
))
1584 family
= SYMBOL_NAME (family
);
1589 val
= AREF (font
, FONT_SIZE_INDEX
);
1592 if (XINT (val
) != 0)
1593 pixel_size
= XINT (val
);
1601 point_size
= (int) XFLOAT_DATA (val
);
1604 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1605 if (! NILP (foundry
))
1607 if (SYMBOLP (foundry
))
1608 foundry
= SYMBOL_NAME (foundry
);
1613 for (i
= 0; i
< 3; i
++)
1614 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1617 lim
= name
+ nbytes
;
1618 if (! NILP (family
))
1620 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1621 if (! (0 <= len
&& len
< lim
- p
))
1627 int len
= snprintf (p
, lim
- p
, "-%d" + (p
== name
), point_size
);
1628 if (! (0 <= len
&& len
< lim
- p
))
1632 else if (pixel_size
> 0)
1634 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1635 if (! (0 <= len
&& len
< lim
- p
))
1639 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1641 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1642 SSDATA (SYMBOL_NAME (AREF (font
,
1643 FONT_FOUNDRY_INDEX
))));
1644 if (! (0 <= len
&& len
< lim
- p
))
1648 for (i
= 0; i
< 3; i
++)
1649 if (! NILP (styles
[i
]))
1651 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1652 SSDATA (SYMBOL_NAME (styles
[i
])));
1653 if (! (0 <= len
&& len
< lim
- p
))
1658 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1660 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1661 XINT (AREF (font
, FONT_DPI_INDEX
)));
1662 if (! (0 <= len
&& len
< lim
- p
))
1667 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1669 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1670 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1671 if (! (0 <= len
&& len
< lim
- p
))
1676 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1678 int len
= snprintf (p
, lim
- p
,
1679 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1681 : ":scalable=false"));
1682 if (! (0 <= len
&& len
< lim
- p
))
1690 /* Parse NAME (null terminated) and store information in FONT
1691 (font-spec or font-entity). If NAME is successfully parsed, return
1692 0. Otherwise return -1. */
1695 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1697 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1698 return font_parse_xlfd (name
, namelen
, font
);
1699 return font_parse_fcname (name
, namelen
, font
);
1703 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1704 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1708 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1714 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1716 CHECK_STRING (family
);
1717 len
= SBYTES (family
);
1718 p0
= SSDATA (family
);
1719 p1
= strchr (p0
, '-');
1722 if ((*p0
!= '*' && p1
- p0
> 0)
1723 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1724 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1727 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1730 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1732 if (! NILP (registry
))
1734 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1735 CHECK_STRING (registry
);
1736 len
= SBYTES (registry
);
1737 p0
= SSDATA (registry
);
1738 p1
= strchr (p0
, '-');
1741 if (SDATA (registry
)[len
- 1] == '*')
1742 registry
= concat2 (registry
, build_string ("-*"));
1744 registry
= concat2 (registry
, build_string ("*-*"));
1746 registry
= Fdowncase (registry
);
1747 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1752 /* This part (through the next ^L) is still experimental and not
1753 tested much. We may drastically change codes. */
1759 #define LGSTRING_HEADER_SIZE 6
1760 #define LGSTRING_GLYPH_SIZE 8
1763 check_gstring (Lisp_Object gstring
)
1769 CHECK_VECTOR (gstring
);
1770 val
= AREF (gstring
, 0);
1772 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1774 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1775 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1776 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1777 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1778 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1779 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1780 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1781 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1782 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1783 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1784 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1786 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1788 val
= LGSTRING_GLYPH (gstring
, i
);
1790 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1792 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1794 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1795 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1796 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1797 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1798 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1799 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1800 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1801 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1803 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1805 if (ASIZE (val
) < 3)
1807 for (j
= 0; j
< 3; j
++)
1808 CHECK_NUMBER (AREF (val
, j
));
1813 error ("Invalid glyph-string format");
1818 check_otf_features (Lisp_Object otf_features
)
1822 CHECK_CONS (otf_features
);
1823 CHECK_SYMBOL (XCAR (otf_features
));
1824 otf_features
= XCDR (otf_features
);
1825 CHECK_CONS (otf_features
);
1826 CHECK_SYMBOL (XCAR (otf_features
));
1827 otf_features
= XCDR (otf_features
);
1828 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1830 CHECK_SYMBOL (Fcar (val
));
1831 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1832 error ("Invalid OTF GSUB feature: %s",
1833 SDATA (SYMBOL_NAME (XCAR (val
))));
1835 otf_features
= XCDR (otf_features
);
1836 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1838 CHECK_SYMBOL (Fcar (val
));
1839 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1840 error ("Invalid OTF GPOS feature: %s",
1841 SDATA (SYMBOL_NAME (XCAR (val
))));
1848 Lisp_Object otf_list
;
1851 otf_tag_symbol (OTF_Tag tag
)
1855 OTF_tag_name (tag
, name
);
1856 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1860 otf_open (Lisp_Object file
)
1862 Lisp_Object val
= Fassoc (file
, otf_list
);
1866 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1869 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1870 val
= make_save_value (otf
, 0);
1871 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1877 /* Return a list describing which scripts/languages FONT supports by
1878 which GSUB/GPOS features of OpenType tables. See the comment of
1879 (struct font_driver).otf_capability. */
1882 font_otf_capability (struct font
*font
)
1885 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1888 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1891 for (i
= 0; i
< 2; i
++)
1893 OTF_GSUB_GPOS
*gsub_gpos
;
1894 Lisp_Object script_list
= Qnil
;
1897 if (OTF_get_features (otf
, i
== 0) < 0)
1899 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1900 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1902 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1903 Lisp_Object langsys_list
= Qnil
;
1904 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1907 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1909 OTF_LangSys
*langsys
;
1910 Lisp_Object feature_list
= Qnil
;
1911 Lisp_Object langsys_tag
;
1914 if (k
== script
->LangSysCount
)
1916 langsys
= &script
->DefaultLangSys
;
1921 langsys
= script
->LangSys
+ k
;
1923 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1925 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1927 OTF_Feature
*feature
1928 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1929 Lisp_Object feature_tag
1930 = otf_tag_symbol (feature
->FeatureTag
);
1932 feature_list
= Fcons (feature_tag
, feature_list
);
1934 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1937 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1942 XSETCAR (capability
, script_list
);
1944 XSETCDR (capability
, script_list
);
1950 /* Parse OTF features in SPEC and write a proper features spec string
1951 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1952 assured that the sufficient memory has already allocated for
1956 generate_otf_features (Lisp_Object spec
, char *features
)
1964 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1970 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1975 else if (! asterisk
)
1977 val
= SYMBOL_NAME (val
);
1978 p
+= esprintf (p
, "%s", SDATA (val
));
1982 val
= SYMBOL_NAME (val
);
1983 p
+= esprintf (p
, "~%s", SDATA (val
));
1987 error ("OTF spec too long");
1991 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1993 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1995 return Fcons (make_number (len
),
1996 make_unibyte_string (device_table
->DeltaValue
, len
));
2000 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2002 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2004 if (value_format
& OTF_XPlacement
)
2005 ASET (val
, 0, make_number (value_record
->XPlacement
));
2006 if (value_format
& OTF_YPlacement
)
2007 ASET (val
, 1, make_number (value_record
->YPlacement
));
2008 if (value_format
& OTF_XAdvance
)
2009 ASET (val
, 2, make_number (value_record
->XAdvance
));
2010 if (value_format
& OTF_YAdvance
)
2011 ASET (val
, 3, make_number (value_record
->YAdvance
));
2012 if (value_format
& OTF_XPlaDevice
)
2013 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2014 if (value_format
& OTF_YPlaDevice
)
2015 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2016 if (value_format
& OTF_XAdvDevice
)
2017 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2018 if (value_format
& OTF_YAdvDevice
)
2019 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2024 font_otf_Anchor (OTF_Anchor
*anchor
)
2028 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2029 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2030 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2031 if (anchor
->AnchorFormat
== 2)
2032 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2035 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2036 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2040 #endif /* HAVE_LIBOTF */
2046 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2047 static int font_compare (const void *, const void *);
2048 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2052 font_rescale_ratio (Lisp_Object font_entity
)
2054 Lisp_Object tail
, elt
;
2055 Lisp_Object name
= Qnil
;
2057 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2060 if (FLOATP (XCDR (elt
)))
2062 if (STRINGP (XCAR (elt
)))
2065 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2066 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2067 return XFLOAT_DATA (XCDR (elt
));
2069 else if (FONT_SPEC_P (XCAR (elt
)))
2071 if (font_match_p (XCAR (elt
), font_entity
))
2072 return XFLOAT_DATA (XCDR (elt
));
2079 /* We sort fonts by scoring each of them against a specified
2080 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2081 the value is, the closer the font is to the font-spec.
2083 The lowest 2 bits of the score are used for driver type. The font
2084 available by the most preferred font driver is 0.
2086 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2087 WEIGHT, SLANT, WIDTH, and SIZE. */
2089 /* How many bits to shift to store the difference value of each font
2090 property in a score. Note that floats for FONT_TYPE_INDEX and
2091 FONT_REGISTRY_INDEX are not used. */
2092 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2094 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2095 The return value indicates how different ENTITY is compared with
2099 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2104 /* Score three style numeric fields. Maximum difference is 127. */
2105 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2106 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2108 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2109 - (XINT (spec_prop
[i
]) >> 8));
2112 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2115 /* Score the size. Maximum difference is 127. */
2116 i
= FONT_SIZE_INDEX
;
2117 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2118 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2120 /* We use the higher 6-bit for the actual size difference. The
2121 lowest bit is set if the DPI is different. */
2123 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2125 if (CONSP (Vface_font_rescale_alist
))
2126 pixel_size
*= font_rescale_ratio (entity
);
2127 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2131 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2132 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2134 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2135 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2137 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2144 /* Concatenate all elements of LIST into one vector. LIST is a list
2145 of font-entity vectors. */
2148 font_vconcat_entity_vectors (Lisp_Object list
)
2150 int nargs
= XINT (Flength (list
));
2151 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2154 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2155 args
[i
] = XCAR (list
);
2156 return Fvconcat (nargs
, args
);
2160 /* The structure for elements being sorted by qsort. */
2161 struct font_sort_data
2164 int font_driver_preference
;
2169 /* The comparison function for qsort. */
2172 font_compare (const void *d1
, const void *d2
)
2174 const struct font_sort_data
*data1
= d1
;
2175 const struct font_sort_data
*data2
= d2
;
2177 if (data1
->score
< data2
->score
)
2179 else if (data1
->score
> data2
->score
)
2181 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2185 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2186 If PREFER specifies a point-size, calculate the corresponding
2187 pixel-size from QCdpi property of PREFER or from the Y-resolution
2188 of FRAME before sorting.
2190 If BEST-ONLY is nonzero, return the best matching entity (that
2191 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2192 if BEST-ONLY is negative). Otherwise, return the sorted result as
2193 a single vector of font-entities.
2195 This function does no optimization for the case that the total
2196 number of elements is 1. The caller should avoid calling this in
2200 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2202 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2204 struct font_sort_data
*data
;
2205 unsigned best_score
;
2206 Lisp_Object best_entity
;
2207 struct frame
*f
= XFRAME (frame
);
2208 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2211 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2212 prefer_prop
[i
] = AREF (prefer
, i
);
2213 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2214 prefer_prop
[FONT_SIZE_INDEX
]
2215 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2217 if (NILP (XCDR (list
)))
2219 /* What we have to take care of is this single vector. */
2221 maxlen
= ASIZE (vec
);
2225 /* We don't have to perform sort, so there's no need of creating
2226 a single vector. But, we must find the length of the longest
2229 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2230 if (maxlen
< ASIZE (XCAR (tail
)))
2231 maxlen
= ASIZE (XCAR (tail
));
2235 /* We have to create a single vector to sort it. */
2236 vec
= font_vconcat_entity_vectors (list
);
2237 maxlen
= ASIZE (vec
);
2240 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2241 best_score
= 0xFFFFFFFF;
2244 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2246 int font_driver_preference
= 0;
2247 Lisp_Object current_font_driver
;
2253 /* We are sure that the length of VEC > 0. */
2254 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2255 /* Score the elements. */
2256 for (i
= 0; i
< len
; i
++)
2258 data
[i
].entity
= AREF (vec
, i
);
2260 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2262 ? font_score (data
[i
].entity
, prefer_prop
)
2264 if (best_only
&& best_score
> data
[i
].score
)
2266 best_score
= data
[i
].score
;
2267 best_entity
= data
[i
].entity
;
2268 if (best_score
== 0)
2271 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2273 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2274 font_driver_preference
++;
2276 data
[i
].font_driver_preference
= font_driver_preference
;
2279 /* Sort if necessary. */
2282 qsort (data
, len
, sizeof *data
, font_compare
);
2283 for (i
= 0; i
< len
; i
++)
2284 ASET (vec
, i
, data
[i
].entity
);
2293 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2298 /* API of Font Service Layer. */
2300 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2301 sort_shift_bits. Finternal_set_font_selection_order calls this
2302 function with font_sort_order after setting up it. */
2305 font_update_sort_order (int *order
)
2309 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2311 int xlfd_idx
= order
[i
];
2313 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2314 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2315 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2316 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2317 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2318 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2320 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2325 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2330 table
= assq_no_quit (script
, table
);
2333 table
= XCDR (table
);
2334 if (! NILP (langsys
))
2336 table
= assq_no_quit (langsys
, table
);
2342 val
= assq_no_quit (Qnil
, table
);
2344 table
= XCAR (table
);
2348 table
= XCDR (table
);
2349 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2351 if (NILP (XCAR (features
)))
2356 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2362 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2365 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2367 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2369 script
= XCAR (spec
);
2373 langsys
= XCAR (spec
);
2384 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2385 XCAR (otf_capability
)))
2387 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2388 XCDR (otf_capability
)))
2395 /* Check if FONT (font-entity or font-object) matches with the font
2396 specification SPEC. */
2399 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2401 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2402 Lisp_Object extra
, font_extra
;
2405 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2406 if (! NILP (AREF (spec
, i
))
2407 && ! NILP (AREF (font
, i
))
2408 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2410 props
= XFONT_SPEC (spec
)->props
;
2411 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2413 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2414 prop
[i
] = AREF (spec
, i
);
2415 prop
[FONT_SIZE_INDEX
]
2416 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2420 if (font_score (font
, props
) > 0)
2422 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2423 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2424 for (; CONSP (extra
); extra
= XCDR (extra
))
2426 Lisp_Object key
= XCAR (XCAR (extra
));
2427 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2429 if (EQ (key
, QClang
))
2431 val2
= assq_no_quit (key
, font_extra
);
2440 if (NILP (Fmemq (val
, val2
)))
2445 ? NILP (Fmemq (val
, XCDR (val2
)))
2449 else if (EQ (key
, QCscript
))
2451 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2457 /* All characters in the list must be supported. */
2458 for (; CONSP (val2
); val2
= XCDR (val2
))
2460 if (! CHARACTERP (XCAR (val2
)))
2462 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2463 == FONT_INVALID_CODE
)
2467 else if (VECTORP (val2
))
2469 /* At most one character in the vector must be supported. */
2470 for (i
= 0; i
< ASIZE (val2
); i
++)
2472 if (! CHARACTERP (AREF (val2
, i
)))
2474 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2475 != FONT_INVALID_CODE
)
2478 if (i
== ASIZE (val2
))
2483 else if (EQ (key
, QCotf
))
2487 if (! FONT_OBJECT_P (font
))
2489 fontp
= XFONT_OBJECT (font
);
2490 if (! fontp
->driver
->otf_capability
)
2492 val2
= fontp
->driver
->otf_capability (fontp
);
2493 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2504 Each font backend has the callback function get_cache, and it
2505 returns a cons cell of which cdr part can be freely used for
2506 caching fonts. The cons cell may be shared by multiple frames
2507 and/or multiple font drivers. So, we arrange the cdr part as this:
2509 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2511 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2512 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2513 cons (FONT-SPEC FONT-ENTITY ...). */
2515 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2516 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2517 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2518 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2519 struct font_driver
*);
2522 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2524 Lisp_Object cache
, val
;
2526 cache
= driver
->get_cache (f
);
2528 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2532 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2533 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2537 val
= XCDR (XCAR (val
));
2538 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2544 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2546 Lisp_Object cache
, val
, tmp
;
2549 cache
= driver
->get_cache (f
);
2551 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2552 cache
= val
, val
= XCDR (val
);
2553 font_assert (! NILP (val
));
2554 tmp
= XCDR (XCAR (val
));
2555 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2556 if (XINT (XCAR (tmp
)) == 0)
2558 font_clear_cache (f
, XCAR (val
), driver
);
2559 XSETCDR (cache
, XCDR (val
));
2565 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2567 Lisp_Object val
= driver
->get_cache (f
);
2568 Lisp_Object type
= driver
->type
;
2570 font_assert (CONSP (val
));
2571 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2572 font_assert (CONSP (val
));
2573 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2574 val
= XCDR (XCAR (val
));
2578 static int num_fonts
;
2581 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2583 Lisp_Object tail
, elt
;
2584 Lisp_Object tail2
, entity
;
2586 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2587 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2590 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2591 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2593 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2595 entity
= XCAR (tail2
);
2597 if (FONT_ENTITY_P (entity
)
2598 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2600 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2602 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2604 Lisp_Object val
= XCAR (objlist
);
2605 struct font
*font
= XFONT_OBJECT (val
);
2607 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2609 font_assert (font
&& driver
== font
->driver
);
2610 driver
->close (f
, font
);
2614 if (driver
->free_entity
)
2615 driver
->free_entity (entity
);
2620 XSETCDR (cache
, Qnil
);
2624 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2626 /* Check each font-entity in VEC, and return a list of font-entities
2627 that satisfy these conditions:
2628 (1) matches with SPEC and SIZE if SPEC is not nil, and
2629 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2633 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2635 Lisp_Object entity
, val
;
2636 enum font_property_index prop
;
2639 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2641 entity
= AREF (vec
, i
);
2642 if (! NILP (Vface_ignored_fonts
))
2645 Lisp_Object tail
, regexp
;
2647 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2649 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2651 regexp
= XCAR (tail
);
2652 if (STRINGP (regexp
)
2653 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2662 val
= Fcons (entity
, val
);
2665 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2666 if (INTEGERP (AREF (spec
, prop
))
2667 && ((XINT (AREF (spec
, prop
)) >> 8)
2668 != (XINT (AREF (entity
, prop
)) >> 8)))
2669 prop
= FONT_SPEC_MAX
;
2670 if (prop
< FONT_SPEC_MAX
2672 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2674 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2677 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2678 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2679 prop
= FONT_SPEC_MAX
;
2681 if (prop
< FONT_SPEC_MAX
2682 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2683 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2684 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2685 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2686 prop
= FONT_SPEC_MAX
;
2687 if (prop
< FONT_SPEC_MAX
2688 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2689 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2690 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2691 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2692 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2693 prop
= FONT_SPEC_MAX
;
2694 if (prop
< FONT_SPEC_MAX
)
2695 val
= Fcons (entity
, val
);
2697 return (Fvconcat (1, &val
));
2701 /* Return a list of vectors of font-entities matching with SPEC on
2702 FRAME. Each elements in the list is a vector of entities from the
2703 same font-driver. */
2706 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2708 FRAME_PTR f
= XFRAME (frame
);
2709 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2710 Lisp_Object ftype
, val
;
2711 Lisp_Object list
= Qnil
;
2713 int need_filtering
= 0;
2716 font_assert (FONT_SPEC_P (spec
));
2718 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2719 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2720 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2721 size
= font_pixel_size (f
, spec
);
2725 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2726 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2727 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2728 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2729 if (i
!= FONT_SPACING_INDEX
)
2731 ASET (scratch_font_spec
, i
, Qnil
);
2732 if (! NILP (AREF (spec
, i
)))
2735 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2736 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2738 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2740 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2742 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2744 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2745 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2752 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2756 val
= Fvconcat (1, &val
);
2757 copy
= copy_font_spec (scratch_font_spec
);
2758 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2759 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2763 || ! NILP (Vface_ignored_fonts
)))
2764 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2765 if (ASIZE (val
) > 0)
2766 list
= Fcons (val
, list
);
2769 list
= Fnreverse (list
);
2770 FONT_ADD_LOG ("list", spec
, list
);
2775 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2776 nil, is an array of face's attributes, which specifies preferred
2777 font-related attributes. */
2780 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2782 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2783 Lisp_Object ftype
, size
, entity
;
2785 Lisp_Object work
= copy_font_spec (spec
);
2787 XSETFRAME (frame
, f
);
2788 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2789 size
= AREF (spec
, FONT_SIZE_INDEX
);
2792 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2793 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2794 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2795 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2798 for (; driver_list
; driver_list
= driver_list
->next
)
2800 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2802 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2805 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2806 entity
= assoc_no_quit (work
, XCDR (cache
));
2808 entity
= XCDR (entity
);
2811 entity
= driver_list
->driver
->match (frame
, work
);
2812 copy
= copy_font_spec (work
);
2813 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2814 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2816 if (! NILP (entity
))
2819 FONT_ADD_LOG ("match", work
, entity
);
2824 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2825 opened font object. */
2828 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2830 struct font_driver_list
*driver_list
;
2831 Lisp_Object objlist
, size
, val
, font_object
;
2833 int min_width
, height
;
2834 int scaled_pixel_size
= pixel_size
;
2836 font_assert (FONT_ENTITY_P (entity
));
2837 size
= AREF (entity
, FONT_SIZE_INDEX
);
2838 if (XINT (size
) != 0)
2839 scaled_pixel_size
= pixel_size
= XINT (size
);
2840 else if (CONSP (Vface_font_rescale_alist
))
2841 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2843 val
= AREF (entity
, FONT_TYPE_INDEX
);
2844 for (driver_list
= f
->font_driver_list
;
2845 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2846 driver_list
= driver_list
->next
);
2850 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2851 objlist
= XCDR (objlist
))
2853 Lisp_Object fn
= XCAR (objlist
);
2854 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2855 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2857 if (driver_list
->driver
->cached_font_ok
== NULL
2858 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2863 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2864 if (!NILP (font_object
))
2865 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2866 FONT_ADD_LOG ("open", entity
, font_object
);
2867 if (NILP (font_object
))
2869 ASET (entity
, FONT_OBJLIST_INDEX
,
2870 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2873 font
= XFONT_OBJECT (font_object
);
2874 min_width
= (font
->min_width
? font
->min_width
2875 : font
->average_width
? font
->average_width
2876 : font
->space_width
? font
->space_width
2878 height
= (font
->height
? font
->height
: 1);
2879 #ifdef HAVE_WINDOW_SYSTEM
2880 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2881 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2883 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2884 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2885 fonts_changed_p
= 1;
2889 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2890 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2891 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2892 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2900 /* Close FONT_OBJECT that is opened on frame F. */
2903 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2905 struct font
*font
= XFONT_OBJECT (font_object
);
2907 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2908 /* Already closed. */
2910 FONT_ADD_LOG ("close", font_object
, Qnil
);
2911 font
->driver
->close (f
, font
);
2912 #ifdef HAVE_WINDOW_SYSTEM
2913 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2914 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2920 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2921 FONT is a font-entity and it must be opened to check. */
2924 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2928 if (FONT_ENTITY_P (font
))
2930 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2931 struct font_driver_list
*driver_list
;
2933 for (driver_list
= f
->font_driver_list
;
2934 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2935 driver_list
= driver_list
->next
);
2938 if (! driver_list
->driver
->has_char
)
2940 return driver_list
->driver
->has_char (font
, c
);
2943 font_assert (FONT_OBJECT_P (font
));
2944 fontp
= XFONT_OBJECT (font
);
2945 if (fontp
->driver
->has_char
)
2947 int result
= fontp
->driver
->has_char (font
, c
);
2952 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2956 /* Return the glyph ID of FONT_OBJECT for character C. */
2959 font_encode_char (Lisp_Object font_object
, int c
)
2963 font_assert (FONT_OBJECT_P (font_object
));
2964 font
= XFONT_OBJECT (font_object
);
2965 return font
->driver
->encode_char (font
, c
);
2969 /* Return the name of FONT_OBJECT. */
2972 font_get_name (Lisp_Object font_object
)
2974 font_assert (FONT_OBJECT_P (font_object
));
2975 return AREF (font_object
, FONT_NAME_INDEX
);
2979 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2980 could not be parsed by font_parse_name, return Qnil. */
2983 font_spec_from_name (Lisp_Object font_name
)
2985 Lisp_Object spec
= Ffont_spec (0, NULL
);
2987 CHECK_STRING (font_name
);
2988 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2990 font_put_extra (spec
, QCname
, font_name
);
2991 font_put_extra (spec
, QCuser_spec
, font_name
);
2997 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2999 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3004 if (! NILP (Ffont_get (font
, QCname
)))
3006 font
= copy_font_spec (font
);
3007 font_put_extra (font
, QCname
, Qnil
);
3010 if (NILP (AREF (font
, prop
))
3011 && prop
!= FONT_FAMILY_INDEX
3012 && prop
!= FONT_FOUNDRY_INDEX
3013 && prop
!= FONT_WIDTH_INDEX
3014 && prop
!= FONT_SIZE_INDEX
)
3016 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3017 font
= copy_font_spec (font
);
3018 ASET (font
, prop
, Qnil
);
3019 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3021 if (prop
== FONT_FAMILY_INDEX
)
3023 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3024 /* If we are setting the font family, we must also clear
3025 FONT_WIDTH_INDEX to avoid rejecting families that lack
3026 support for some widths. */
3027 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3029 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3030 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3031 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3032 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3033 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3034 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3036 else if (prop
== FONT_SIZE_INDEX
)
3038 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3039 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3040 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3042 else if (prop
== FONT_WIDTH_INDEX
)
3043 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3044 attrs
[LFACE_FONT_INDEX
] = font
;
3047 /* Select a font from ENTITIES (list of font-entity vectors) that
3048 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3051 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3053 Lisp_Object font_entity
;
3056 FRAME_PTR f
= XFRAME (frame
);
3058 if (NILP (XCDR (entities
))
3059 && ASIZE (XCAR (entities
)) == 1)
3061 font_entity
= AREF (XCAR (entities
), 0);
3063 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3068 /* Sort fonts by properties specified in ATTRS. */
3069 prefer
= scratch_font_prefer
;
3071 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3072 ASET (prefer
, i
, Qnil
);
3073 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3075 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3077 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3078 ASET (prefer
, i
, AREF (face_font
, i
));
3080 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3081 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3082 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3083 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3084 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3085 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3086 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3088 return font_sort_entities (entities
, prefer
, frame
, c
);
3091 /* Return a font-entity that satisfies SPEC and is the best match for
3092 face's font related attributes in ATTRS. C, if not negative, is a
3093 character that the entity must support. */
3096 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3099 Lisp_Object frame
, entities
, val
;
3100 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3105 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3106 if (NILP (registry
[0]))
3108 registry
[0] = DEFAULT_ENCODING
;
3109 registry
[1] = Qascii_0
;
3110 registry
[2] = null_vector
;
3113 registry
[1] = null_vector
;
3115 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3117 struct charset
*encoding
, *repertory
;
3119 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3120 &encoding
, &repertory
) < 0)
3123 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3125 else if (c
> encoding
->max_char
)
3129 work
= copy_font_spec (spec
);
3130 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3131 XSETFRAME (frame
, f
);
3132 pixel_size
= font_pixel_size (f
, spec
);
3133 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3135 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3137 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3139 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3140 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3141 if (! NILP (foundry
[0]))
3142 foundry
[1] = null_vector
;
3143 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3145 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3146 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3148 foundry
[2] = null_vector
;
3151 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3153 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3154 if (! NILP (adstyle
[0]))
3155 adstyle
[1] = null_vector
;
3156 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3158 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3160 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3162 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3164 adstyle
[2] = null_vector
;
3167 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3170 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3173 val
= AREF (work
, FONT_FAMILY_INDEX
);
3174 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3176 val
= attrs
[LFACE_FAMILY_INDEX
];
3177 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3181 family
= alloca ((sizeof family
[0]) * 2);
3183 family
[1] = null_vector
; /* terminator. */
3188 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3190 if (! NILP (alters
))
3192 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3193 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3194 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3195 family
[i
] = XCAR (alters
);
3196 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3198 family
[i
] = null_vector
;
3202 family
= alloca ((sizeof family
[0]) * 3);
3205 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3207 family
[i
] = null_vector
;
3211 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3213 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3214 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3216 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3217 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3219 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3220 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3222 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3223 entities
= font_list_entities (frame
, work
);
3224 if (! NILP (entities
))
3226 val
= font_select_entity (frame
, entities
,
3227 attrs
, pixel_size
, c
);
3242 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3246 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3247 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3248 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3249 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3250 size
= font_pixel_size (f
, spec
);
3254 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3255 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3258 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3259 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3260 if (INTEGERP (height
))
3263 abort (); /* We should never end up here. */
3267 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3271 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3272 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3276 return font_open_entity (f
, entity
, size
);
3280 /* Find a font that satisfies SPEC and is the best match for
3281 face's attributes in ATTRS on FRAME, and return the opened
3285 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3287 Lisp_Object entity
, name
;
3289 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3292 /* No font is listed for SPEC, but each font-backend may have
3293 different criteria about "font matching". So, try it. */
3294 entity
= font_matching_entity (f
, attrs
, spec
);
3298 /* Don't lose the original name that was put in initially. We need
3299 it to re-apply the font when font parameters (like hinting or dpi) have
3301 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3304 name
= Ffont_get (spec
, QCuser_spec
);
3305 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3311 /* Make FACE on frame F ready to use the font opened for FACE. */
3314 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3316 if (face
->font
->driver
->prepare_face
)
3317 face
->font
->driver
->prepare_face (f
, face
);
3321 /* Make FACE on frame F stop using the font opened for FACE. */
3324 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3326 if (face
->font
->driver
->done_face
)
3327 face
->font
->driver
->done_face (f
, face
);
3332 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3333 font is found, return Qnil. */
3336 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3338 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3340 /* We set up the default font-related attributes of a face to prefer
3342 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3343 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3344 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3346 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3348 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3350 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3352 return font_load_for_lface (f
, attrs
, spec
);
3356 /* Open a font that matches NAME on frame F. If no proper font is
3357 found, return Qnil. */
3360 font_open_by_name (FRAME_PTR f
, const char *name
, ptrdiff_t len
)
3362 Lisp_Object args
[2];
3363 Lisp_Object spec
, ret
;
3366 args
[1] = make_unibyte_string (name
, len
);
3367 spec
= Ffont_spec (2, args
);
3368 ret
= font_open_by_spec (f
, spec
);
3369 /* Do not lose name originally put in. */
3371 font_put_extra (ret
, QCuser_spec
, args
[1]);
3377 /* Register font-driver DRIVER. This function is used in two ways.
3379 The first is with frame F non-NULL. In this case, make DRIVER
3380 available (but not yet activated) on F. All frame creators
3381 (e.g. Fx_create_frame) must call this function at least once with
3382 an available font-driver.
3384 The second is with frame F NULL. In this case, DRIVER is globally
3385 registered in the variable `font_driver_list'. All font-driver
3386 implementations must call this function in its syms_of_XXXX
3387 (e.g. syms_of_xfont). */
3390 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3392 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3393 struct font_driver_list
*prev
, *list
;
3395 if (f
&& ! driver
->draw
)
3396 error ("Unusable font driver for a frame: %s",
3397 SDATA (SYMBOL_NAME (driver
->type
)));
3399 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3400 if (EQ (list
->driver
->type
, driver
->type
))
3401 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3403 list
= xmalloc (sizeof *list
);
3405 list
->driver
= driver
;
3410 f
->font_driver_list
= list
;
3412 font_driver_list
= list
;
3418 free_font_driver_list (FRAME_PTR f
)
3420 struct font_driver_list
*list
, *next
;
3422 for (list
= f
->font_driver_list
; list
; list
= next
)
3427 f
->font_driver_list
= NULL
;
3431 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3432 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3433 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3435 A caller must free all realized faces if any in advance. The
3436 return value is a list of font backends actually made used on
3440 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3442 Lisp_Object active_drivers
= Qnil
;
3443 struct font_driver_list
*list
;
3445 /* At first, turn off non-requested drivers, and turn on requested
3447 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3449 struct font_driver
*driver
= list
->driver
;
3450 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3455 if (driver
->end_for_frame
)
3456 driver
->end_for_frame (f
);
3457 font_finish_cache (f
, driver
);
3462 if (! driver
->start_for_frame
3463 || driver
->start_for_frame (f
) == 0)
3465 font_prepare_cache (f
, driver
);
3472 if (NILP (new_drivers
))
3475 if (! EQ (new_drivers
, Qt
))
3477 /* Re-order the driver list according to new_drivers. */
3478 struct font_driver_list
**list_table
, **next
;
3482 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3483 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3485 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3486 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3489 list_table
[i
++] = list
;
3491 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3493 list_table
[i
++] = list
;
3494 list_table
[i
] = NULL
;
3496 next
= &f
->font_driver_list
;
3497 for (i
= 0; list_table
[i
]; i
++)
3499 *next
= list_table
[i
];
3500 next
= &(*next
)->next
;
3504 if (! f
->font_driver_list
->on
)
3505 { /* None of the drivers is enabled: enable them all.
3506 Happens if you set the list of drivers to (xft x) in your .emacs
3507 and then use it under w32 or ns. */
3508 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3510 struct font_driver
*driver
= list
->driver
;
3511 eassert (! list
->on
);
3512 if (! driver
->start_for_frame
3513 || driver
->start_for_frame (f
) == 0)
3515 font_prepare_cache (f
, driver
);
3522 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3524 active_drivers
= nconc2 (active_drivers
,
3525 Fcons (list
->driver
->type
, Qnil
));
3526 return active_drivers
;
3530 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3532 struct font_data_list
*list
, *prev
;
3534 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3535 prev
= list
, list
= list
->next
)
3536 if (list
->driver
== driver
)
3543 prev
->next
= list
->next
;
3545 f
->font_data_list
= list
->next
;
3553 list
= xmalloc (sizeof *list
);
3554 list
->driver
= driver
;
3555 list
->next
= f
->font_data_list
;
3556 f
->font_data_list
= list
;
3564 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3566 struct font_data_list
*list
;
3568 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3569 if (list
->driver
== driver
)
3577 /* Sets attributes on a font. Any properties that appear in ALIST and
3578 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3579 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3580 arrays of strings. This function is intended for use by the font
3581 drivers to implement their specific font_filter_properties. */
3583 font_filter_properties (Lisp_Object font
,
3585 const char *const boolean_properties
[],
3586 const char *const non_boolean_properties
[])
3591 /* Set boolean values to Qt or Qnil */
3592 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3593 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3595 Lisp_Object key
= XCAR (XCAR (it
));
3596 Lisp_Object val
= XCDR (XCAR (it
));
3597 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3599 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3601 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3602 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3605 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3606 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3607 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3608 || strcmp ("Off", str
) == 0)
3613 Ffont_put (font
, key
, val
);
3617 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3618 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3620 Lisp_Object key
= XCAR (XCAR (it
));
3621 Lisp_Object val
= XCDR (XCAR (it
));
3622 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3623 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3624 Ffont_put (font
, key
, val
);
3629 /* Return the font used to draw character C by FACE at buffer position
3630 POS in window W. If STRING is non-nil, it is a string containing C
3631 at index POS. If C is negative, get C from the current buffer or
3635 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3640 Lisp_Object font_object
;
3642 multibyte
= (NILP (string
)
3643 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3644 : STRING_MULTIBYTE (string
));
3651 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3653 c
= FETCH_CHAR (pos_byte
);
3656 c
= FETCH_BYTE (pos
);
3662 multibyte
= STRING_MULTIBYTE (string
);
3665 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3667 str
= SDATA (string
) + pos_byte
;
3668 c
= STRING_CHAR (str
);
3671 c
= SDATA (string
)[pos
];
3675 f
= XFRAME (w
->frame
);
3676 if (! FRAME_WINDOW_P (f
))
3683 if (STRINGP (string
))
3684 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3685 DEFAULT_FACE_ID
, 0);
3687 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3689 face
= FACE_FROM_ID (f
, face_id
);
3693 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3694 face
= FACE_FROM_ID (f
, face_id
);
3699 XSETFONT (font_object
, face
->font
);
3704 #ifdef HAVE_WINDOW_SYSTEM
3706 /* Check how many characters after POS (at most to *LIMIT) can be
3707 displayed by the same font in the window W. FACE, if non-NULL, is
3708 the face selected for the character at POS. If STRING is not nil,
3709 it is the string to check instead of the current buffer. In that
3710 case, FACE must be not NULL.
3712 The return value is the font-object for the character at POS.
3713 *LIMIT is set to the position where that font can't be used.
3715 It is assured that the current buffer (or STRING) is multibyte. */
3718 font_range (ptrdiff_t pos
, ptrdiff_t *limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3720 ptrdiff_t pos_byte
, ignore
;
3722 Lisp_Object font_object
= Qnil
;
3726 pos_byte
= CHAR_TO_BYTE (pos
);
3731 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3733 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3739 pos_byte
= string_char_to_byte (string
, pos
);
3742 while (pos
< *limit
)
3744 Lisp_Object category
;
3747 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3749 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3750 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3751 if (INTEGERP (category
)
3752 && (XINT (category
) == UNICODE_CATEGORY_Cf
3753 || CHAR_VARIATION_SELECTOR_P (c
)))
3755 if (NILP (font_object
))
3757 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3758 if (NILP (font_object
))
3762 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3772 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3773 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3774 Return nil otherwise.
3775 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3776 which kind of font it is. It must be one of `font-spec', `font-entity',
3778 (Lisp_Object object
, Lisp_Object extra_type
)
3780 if (NILP (extra_type
))
3781 return (FONTP (object
) ? Qt
: Qnil
);
3782 if (EQ (extra_type
, Qfont_spec
))
3783 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3784 if (EQ (extra_type
, Qfont_entity
))
3785 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3786 if (EQ (extra_type
, Qfont_object
))
3787 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3788 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3791 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3792 doc
: /* Return a newly created font-spec with arguments as properties.
3794 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3795 valid font property name listed below:
3797 `:family', `:weight', `:slant', `:width'
3799 They are the same as face attributes of the same name. See
3800 `set-face-attribute'.
3804 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3808 VALUE must be a string or a symbol specifying the additional
3809 typographic style information of a font, e.g. ``sans''.
3813 VALUE must be a string or a symbol specifying the charset registry and
3814 encoding of a font, e.g. ``iso8859-1''.
3818 VALUE must be a non-negative integer or a floating point number
3819 specifying the font size. It specifies the font size in pixels (if
3820 VALUE is an integer), or in points (if VALUE is a float).
3824 VALUE must be a string of XLFD-style or fontconfig-style font name.
3828 VALUE must be a symbol representing a script that the font must
3829 support. It may be a symbol representing a subgroup of a script
3830 listed in the variable `script-representative-chars'.
3834 VALUE must be a symbol of two-letter ISO-639 language names,
3839 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3840 required OpenType features.
3842 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3843 LANGSYS-TAG: OpenType language system tag symbol,
3844 or nil for the default language system.
3845 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3846 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3848 GSUB and GPOS may contain `nil' element. In such a case, the font
3849 must not have any of the remaining elements.
3851 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3852 be an OpenType font whose GPOS table of `thai' script's default
3853 language system must contain `mark' feature.
3855 usage: (font-spec ARGS...) */)
3856 (ptrdiff_t nargs
, Lisp_Object
*args
)
3858 Lisp_Object spec
= font_make_spec ();
3861 for (i
= 0; i
< nargs
; i
+= 2)
3863 Lisp_Object key
= args
[i
], val
;
3867 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3870 if (EQ (key
, QCname
))
3873 font_parse_name (SSDATA (val
), SBYTES (val
), spec
);
3874 font_put_extra (spec
, key
, val
);
3878 int idx
= get_font_prop_index (key
);
3882 val
= font_prop_validate (idx
, Qnil
, val
);
3883 if (idx
< FONT_EXTRA_INDEX
)
3884 ASET (spec
, idx
, val
);
3886 font_put_extra (spec
, key
, val
);
3889 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3895 /* Return a copy of FONT as a font-spec. */
3897 copy_font_spec (Lisp_Object font
)
3899 Lisp_Object new_spec
, tail
, prev
, extra
;
3903 new_spec
= font_make_spec ();
3904 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3905 ASET (new_spec
, i
, AREF (font
, i
));
3906 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3907 /* We must remove :font-entity property. */
3908 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3909 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3912 extra
= XCDR (extra
);
3914 XSETCDR (prev
, XCDR (tail
));
3917 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3921 /* Merge font-specs FROM and TO, and return a new font-spec.
3922 Every specified property in FROM overrides the corresponding
3925 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3927 Lisp_Object extra
, tail
;
3932 to
= copy_font_spec (to
);
3933 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3934 ASET (to
, i
, AREF (from
, i
));
3935 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3936 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3937 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3939 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3942 XSETCDR (slot
, XCDR (XCAR (tail
)));
3944 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3946 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3950 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3951 doc
: /* Return the value of FONT's property KEY.
3952 FONT is a font-spec, a font-entity, or a font-object.
3953 KEY is any symbol, but these are reserved for specific meanings:
3954 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3955 :size, :name, :script, :otf
3956 See the documentation of `font-spec' for their meanings.
3957 In addition, if FONT is a font-entity or a font-object, values of
3958 :script and :otf are different from those of a font-spec as below:
3960 The value of :script may be a list of scripts that are supported by the font.
3962 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3963 representing the OpenType features supported by the font by this form:
3964 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3965 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3967 (Lisp_Object font
, Lisp_Object key
)
3975 idx
= get_font_prop_index (key
);
3976 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3977 return font_style_symbolic (font
, idx
, 0);
3978 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3979 return AREF (font
, idx
);
3980 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3981 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3983 struct font
*fontp
= XFONT_OBJECT (font
);
3985 if (fontp
->driver
->otf_capability
)
3986 val
= fontp
->driver
->otf_capability (fontp
);
3988 val
= Fcons (Qnil
, Qnil
);
3995 #ifdef HAVE_WINDOW_SYSTEM
3997 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3998 doc
: /* Return a plist of face attributes generated by FONT.
3999 FONT is a font name, a font-spec, a font-entity, or a font-object.
4000 The return value is a list of the form
4002 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4004 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4005 compatible with `set-face-attribute'. Some of these key-attribute pairs
4006 may be omitted from the list if they are not specified by FONT.
4008 The optional argument FRAME specifies the frame that the face attributes
4009 are to be displayed on. If omitted, the selected frame is used. */)
4010 (Lisp_Object font
, Lisp_Object frame
)
4013 Lisp_Object plist
[10];
4018 frame
= selected_frame
;
4019 CHECK_LIVE_FRAME (frame
);
4024 int fontset
= fs_query_fontset (font
, 0);
4025 Lisp_Object name
= font
;
4027 font
= fontset_ascii (fontset
);
4028 font
= font_spec_from_name (name
);
4030 signal_error ("Invalid font name", name
);
4032 else if (! FONTP (font
))
4033 signal_error ("Invalid font object", font
);
4035 val
= AREF (font
, FONT_FAMILY_INDEX
);
4038 plist
[n
++] = QCfamily
;
4039 plist
[n
++] = SYMBOL_NAME (val
);
4042 val
= AREF (font
, FONT_SIZE_INDEX
);
4045 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4046 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4047 plist
[n
++] = QCheight
;
4048 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4050 else if (FLOATP (val
))
4052 plist
[n
++] = QCheight
;
4053 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4056 val
= FONT_WEIGHT_FOR_FACE (font
);
4059 plist
[n
++] = QCweight
;
4063 val
= FONT_SLANT_FOR_FACE (font
);
4066 plist
[n
++] = QCslant
;
4070 val
= FONT_WIDTH_FOR_FACE (font
);
4073 plist
[n
++] = QCwidth
;
4077 return Flist (n
, plist
);
4082 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4083 doc
: /* Set one property of FONT: give property KEY value VAL.
4084 FONT is a font-spec, a font-entity, or a font-object.
4086 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4087 accepted by the function `font-spec' (which see), VAL must be what
4088 allowed in `font-spec'.
4090 If FONT is a font-entity or a font-object, KEY must not be the one
4091 accepted by `font-spec'. */)
4092 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4096 idx
= get_font_prop_index (prop
);
4097 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4099 CHECK_FONT_SPEC (font
);
4100 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4104 if (EQ (prop
, QCname
)
4105 || EQ (prop
, QCscript
)
4106 || EQ (prop
, QClang
)
4107 || EQ (prop
, QCotf
))
4108 CHECK_FONT_SPEC (font
);
4111 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4116 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4117 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4118 Optional 2nd argument FRAME specifies the target frame.
4119 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4120 Optional 4th argument PREFER, if non-nil, is a font-spec to
4121 control the order of the returned list. Fonts are sorted by
4122 how close they are to PREFER. */)
4123 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4125 Lisp_Object vec
, list
;
4129 frame
= selected_frame
;
4130 CHECK_LIVE_FRAME (frame
);
4131 CHECK_FONT_SPEC (font_spec
);
4139 if (! NILP (prefer
))
4140 CHECK_FONT_SPEC (prefer
);
4142 list
= font_list_entities (frame
, font_spec
);
4145 if (NILP (XCDR (list
))
4146 && ASIZE (XCAR (list
)) == 1)
4147 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4149 if (! NILP (prefer
))
4150 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4152 vec
= font_vconcat_entity_vectors (list
);
4153 if (n
== 0 || n
>= ASIZE (vec
))
4155 Lisp_Object args
[2];
4159 list
= Fappend (2, args
);
4163 for (list
= Qnil
, n
--; n
>= 0; n
--)
4164 list
= Fcons (AREF (vec
, n
), list
);
4169 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4170 doc
: /* List available font families on the current frame.
4171 Optional argument FRAME, if non-nil, specifies the target frame. */)
4175 struct font_driver_list
*driver_list
;
4179 frame
= selected_frame
;
4180 CHECK_LIVE_FRAME (frame
);
4183 for (driver_list
= f
->font_driver_list
; driver_list
;
4184 driver_list
= driver_list
->next
)
4185 if (driver_list
->driver
->list_family
)
4187 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4188 Lisp_Object tail
= list
;
4190 for (; CONSP (val
); val
= XCDR (val
))
4191 if (NILP (Fmemq (XCAR (val
), tail
))
4192 && SYMBOLP (XCAR (val
)))
4193 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4198 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4199 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4200 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4201 (Lisp_Object font_spec
, Lisp_Object frame
)
4203 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4210 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4211 doc
: /* Return XLFD name of FONT.
4212 FONT is a font-spec, font-entity, or font-object.
4213 If the name is too long for XLFD (maximum 255 chars), return nil.
4214 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4215 the consecutive wildcards are folded into one. */)
4216 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4219 int namelen
, pixel_size
= 0;
4223 if (FONT_OBJECT_P (font
))
4225 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4227 if (STRINGP (font_name
)
4228 && SDATA (font_name
)[0] == '-')
4230 if (NILP (fold_wildcards
))
4232 strcpy (name
, SSDATA (font_name
));
4233 namelen
= SBYTES (font_name
);
4236 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4238 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4242 if (! NILP (fold_wildcards
))
4244 char *p0
= name
, *p1
;
4246 while ((p1
= strstr (p0
, "-*-*")))
4248 strcpy (p1
, p1
+ 2);
4254 return make_string (name
, namelen
);
4257 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4258 doc
: /* Clear font cache. */)
4261 Lisp_Object list
, frame
;
4263 FOR_EACH_FRAME (list
, frame
)
4265 FRAME_PTR f
= XFRAME (frame
);
4266 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4268 for (; driver_list
; driver_list
= driver_list
->next
)
4269 if (driver_list
->on
)
4271 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4272 Lisp_Object val
, tmp
;
4276 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4278 font_assert (! NILP (val
));
4279 tmp
= XCDR (XCAR (val
));
4280 if (XINT (XCAR (tmp
)) == 0)
4282 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4283 XSETCDR (cache
, XCDR (val
));
4293 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4295 struct font
*font
= XFONT_OBJECT (font_object
);
4296 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4297 struct font_metrics metrics
;
4299 LGLYPH_SET_CODE (glyph
, code
);
4300 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4301 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4302 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4303 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4304 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4305 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4309 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4310 doc
: /* Shape the glyph-string GSTRING.
4311 Shaping means substituting glyphs and/or adjusting positions of glyphs
4312 to get the correct visual image of character sequences set in the
4313 header of the glyph-string.
4315 If the shaping was successful, the value is GSTRING itself or a newly
4316 created glyph-string. Otherwise, the value is nil. */)
4317 (Lisp_Object gstring
)
4320 Lisp_Object font_object
, n
, glyph
;
4321 ptrdiff_t i
, j
, from
, to
;
4323 if (! composition_gstring_p (gstring
))
4324 signal_error ("Invalid glyph-string: ", gstring
);
4325 if (! NILP (LGSTRING_ID (gstring
)))
4327 font_object
= LGSTRING_FONT (gstring
);
4328 CHECK_FONT_OBJECT (font_object
);
4329 font
= XFONT_OBJECT (font_object
);
4330 if (! font
->driver
->shape
)
4333 /* Try at most three times with larger gstring each time. */
4334 for (i
= 0; i
< 3; i
++)
4336 n
= font
->driver
->shape (gstring
);
4339 gstring
= larger_vector (gstring
,
4340 LGSTRING_GLYPH_LEN (gstring
), -1);
4342 if (i
== 3 || XINT (n
) == 0)
4344 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4345 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4347 glyph
= LGSTRING_GLYPH (gstring
, 0);
4348 from
= LGLYPH_FROM (glyph
);
4349 to
= LGLYPH_TO (glyph
);
4350 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4352 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4356 if (NILP (LGLYPH_ADJUSTMENT (this)))
4361 glyph
= LGSTRING_GLYPH (gstring
, j
);
4362 LGLYPH_SET_FROM (glyph
, from
);
4363 LGLYPH_SET_TO (glyph
, to
);
4365 from
= LGLYPH_FROM (this);
4366 to
= LGLYPH_TO (this);
4371 if (from
> LGLYPH_FROM (this))
4372 from
= LGLYPH_FROM (this);
4373 if (to
< LGLYPH_TO (this))
4374 to
= LGLYPH_TO (this);
4380 glyph
= LGSTRING_GLYPH (gstring
, j
);
4381 LGLYPH_SET_FROM (glyph
, from
);
4382 LGLYPH_SET_TO (glyph
, to
);
4384 return composition_gstring_put_cache (gstring
, XINT (n
));
4387 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4389 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4390 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4392 VARIATION-SELECTOR is a character code of variation selection
4393 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4394 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4395 (Lisp_Object font_object
, Lisp_Object character
)
4397 unsigned variations
[256];
4402 CHECK_FONT_OBJECT (font_object
);
4403 CHECK_CHARACTER (character
);
4404 font
= XFONT_OBJECT (font_object
);
4405 if (! font
->driver
->get_variation_glyphs
)
4407 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4411 for (i
= 0; i
< 255; i
++)
4414 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4415 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4416 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4423 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4424 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4425 OTF-FEATURES specifies which features to apply in this format:
4426 (SCRIPT LANGSYS GSUB GPOS)
4428 SCRIPT is a symbol specifying a script tag of OpenType,
4429 LANGSYS is a symbol specifying a langsys tag of OpenType,
4430 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4432 If LANGYS is nil, the default langsys is selected.
4434 The features are applied in the order they appear in the list. The
4435 symbol `*' means to apply all available features not present in this
4436 list, and the remaining features are ignored. For instance, (vatu
4437 pstf * haln) is to apply vatu and pstf in this order, then to apply
4438 all available features other than vatu, pstf, and haln.
4440 The features are applied to the glyphs in the range FROM and TO of
4441 the glyph-string GSTRING-IN.
4443 If some feature is actually applicable, the resulting glyphs are
4444 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4445 this case, the value is the number of produced glyphs.
4447 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4450 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4451 produced in GSTRING-OUT, and the value is nil.
4453 See the documentation of `composition-get-gstring' for the format of
4455 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4457 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4462 check_otf_features (otf_features
);
4463 CHECK_FONT_OBJECT (font_object
);
4464 font
= XFONT_OBJECT (font_object
);
4465 if (! font
->driver
->otf_drive
)
4466 error ("Font backend %s can't drive OpenType GSUB table",
4467 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4468 CHECK_CONS (otf_features
);
4469 CHECK_SYMBOL (XCAR (otf_features
));
4470 val
= XCDR (otf_features
);
4471 CHECK_SYMBOL (XCAR (val
));
4472 val
= XCDR (otf_features
);
4475 len
= check_gstring (gstring_in
);
4476 CHECK_VECTOR (gstring_out
);
4477 CHECK_NATNUM (from
);
4479 CHECK_NATNUM (index
);
4481 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4482 args_out_of_range_3 (from
, to
, make_number (len
));
4483 if (XINT (index
) >= ASIZE (gstring_out
))
4484 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4485 num
= font
->driver
->otf_drive (font
, otf_features
,
4486 gstring_in
, XINT (from
), XINT (to
),
4487 gstring_out
, XINT (index
), 0);
4490 return make_number (num
);
4493 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4495 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4496 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4498 (SCRIPT LANGSYS FEATURE ...)
4499 See the documentation of `font-drive-otf' for more detail.
4501 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4502 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4503 character code corresponding to the glyph or nil if there's no
4504 corresponding character. */)
4505 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4508 Lisp_Object gstring_in
, gstring_out
, g
;
4509 Lisp_Object alternates
;
4512 CHECK_FONT_GET_OBJECT (font_object
, font
);
4513 if (! font
->driver
->otf_drive
)
4514 error ("Font backend %s can't drive OpenType GSUB table",
4515 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4516 CHECK_CHARACTER (character
);
4517 CHECK_CONS (otf_features
);
4519 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4520 g
= LGSTRING_GLYPH (gstring_in
, 0);
4521 LGLYPH_SET_CHAR (g
, XINT (character
));
4522 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4523 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4524 gstring_out
, 0, 1)) < 0)
4525 gstring_out
= Ffont_make_gstring (font_object
,
4526 make_number (ASIZE (gstring_out
) * 2));
4528 for (i
= 0; i
< num
; i
++)
4530 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4531 int c
= LGLYPH_CHAR (g
);
4532 unsigned code
= LGLYPH_CODE (g
);
4534 alternates
= Fcons (Fcons (make_number (code
),
4535 c
> 0 ? make_number (c
) : Qnil
),
4538 return Fnreverse (alternates
);
4544 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4545 doc
: /* Open FONT-ENTITY. */)
4546 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4550 CHECK_FONT_ENTITY (font_entity
);
4552 frame
= selected_frame
;
4553 CHECK_LIVE_FRAME (frame
);
4556 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4559 CHECK_NUMBER_OR_FLOAT (size
);
4561 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4563 isize
= XINT (size
);
4564 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4565 args_out_of_range (font_entity
, size
);
4569 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4572 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4573 doc
: /* Close FONT-OBJECT. */)
4574 (Lisp_Object font_object
, Lisp_Object frame
)
4576 CHECK_FONT_OBJECT (font_object
);
4578 frame
= selected_frame
;
4579 CHECK_LIVE_FRAME (frame
);
4580 font_close_object (XFRAME (frame
), font_object
);
4584 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4585 doc
: /* Return information about FONT-OBJECT.
4586 The value is a vector:
4587 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4590 NAME is the font name, a string (or nil if the font backend doesn't
4593 FILENAME is the font file name, a string (or nil if the font backend
4594 doesn't provide a file name).
4596 PIXEL-SIZE is a pixel size by which the font is opened.
4598 SIZE is a maximum advance width of the font in pixels.
4600 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4603 CAPABILITY is a list whose first element is a symbol representing the
4604 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4605 remaining elements describe the details of the font capability.
4607 If the font is OpenType font, the form of the list is
4608 \(opentype GSUB GPOS)
4609 where GSUB shows which "GSUB" features the font supports, and GPOS
4610 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4611 lists of the format:
4612 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4614 If the font is not OpenType font, currently the length of the form is
4617 SCRIPT is a symbol representing OpenType script tag.
4619 LANGSYS is a symbol representing OpenType langsys tag, or nil
4620 representing the default langsys.
4622 FEATURE is a symbol representing OpenType feature tag.
4624 If the font is not OpenType font, CAPABILITY is nil. */)
4625 (Lisp_Object font_object
)
4630 CHECK_FONT_GET_OBJECT (font_object
, font
);
4632 val
= Fmake_vector (make_number (9), Qnil
);
4633 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4634 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4635 ASET (val
, 2, make_number (font
->pixel_size
));
4636 ASET (val
, 3, make_number (font
->max_width
));
4637 ASET (val
, 4, make_number (font
->ascent
));
4638 ASET (val
, 5, make_number (font
->descent
));
4639 ASET (val
, 6, make_number (font
->space_width
));
4640 ASET (val
, 7, make_number (font
->average_width
));
4641 if (font
->driver
->otf_capability
)
4642 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4646 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4648 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4649 FROM and TO are positions (integers or markers) specifying a region
4650 of the current buffer.
4651 If the optional fourth arg OBJECT is not nil, it is a string or a
4652 vector containing the target characters.
4654 Each element is a vector containing information of a glyph in this format:
4655 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4657 FROM is an index numbers of a character the glyph corresponds to.
4658 TO is the same as FROM.
4659 C is the character of the glyph.
4660 CODE is the glyph-code of C in FONT-OBJECT.
4661 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4662 ADJUSTMENT is always nil.
4663 If FONT-OBJECT doesn't have a glyph for a character,
4664 the corresponding element is nil. */)
4665 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4670 Lisp_Object
*chars
, vec
;
4673 CHECK_FONT_GET_OBJECT (font_object
, font
);
4676 ptrdiff_t charpos
, bytepos
;
4678 validate_region (&from
, &to
);
4681 len
= XFASTINT (to
) - XFASTINT (from
);
4682 SAFE_ALLOCA_LISP (chars
, len
);
4683 charpos
= XFASTINT (from
);
4684 bytepos
= CHAR_TO_BYTE (charpos
);
4685 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4688 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4689 chars
[i
] = make_number (c
);
4692 else if (STRINGP (object
))
4694 const unsigned char *p
;
4696 CHECK_NUMBER (from
);
4698 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4699 || XINT (to
) > SCHARS (object
))
4700 args_out_of_range_3 (object
, from
, to
);
4703 len
= XFASTINT (to
) - XFASTINT (from
);
4704 SAFE_ALLOCA_LISP (chars
, len
);
4706 if (STRING_MULTIBYTE (object
))
4707 for (i
= 0; i
< len
; i
++)
4709 int c
= STRING_CHAR_ADVANCE (p
);
4710 chars
[i
] = make_number (c
);
4713 for (i
= 0; i
< len
; i
++)
4714 chars
[i
] = make_number (p
[i
]);
4718 CHECK_VECTOR (object
);
4719 CHECK_NUMBER (from
);
4721 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4722 || XINT (to
) > ASIZE (object
))
4723 args_out_of_range_3 (object
, from
, to
);
4726 len
= XFASTINT (to
) - XFASTINT (from
);
4727 for (i
= 0; i
< len
; i
++)
4729 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4730 CHECK_CHARACTER (elt
);
4732 chars
= &(AREF (object
, XFASTINT (from
)));
4735 vec
= Fmake_vector (make_number (len
), Qnil
);
4736 for (i
= 0; i
< len
; i
++)
4739 int c
= XFASTINT (chars
[i
]);
4741 struct font_metrics metrics
;
4743 code
= font
->driver
->encode_char (font
, c
);
4744 if (code
== FONT_INVALID_CODE
)
4746 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4747 LGLYPH_SET_FROM (g
, i
);
4748 LGLYPH_SET_TO (g
, i
);
4749 LGLYPH_SET_CHAR (g
, c
);
4750 LGLYPH_SET_CODE (g
, code
);
4751 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4752 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4753 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4754 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4755 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4756 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4759 if (! VECTORP (object
))
4764 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4765 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4766 FONT is a font-spec, font-entity, or font-object. */)
4767 (Lisp_Object spec
, Lisp_Object font
)
4769 CHECK_FONT_SPEC (spec
);
4772 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4775 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4776 doc
: /* Return a font-object for displaying a character at POSITION.
4777 Optional second arg WINDOW, if non-nil, is a window displaying
4778 the current buffer. It defaults to the currently selected window. */)
4779 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4786 CHECK_NUMBER_COERCE_MARKER (position
);
4787 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4788 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4789 pos
= XINT (position
);
4793 CHECK_NUMBER (position
);
4794 CHECK_STRING (string
);
4795 if (! (0 < XINT (position
) && XINT (position
) < SCHARS (string
)))
4796 args_out_of_range (string
, position
);
4797 pos
= XINT (position
);
4800 window
= selected_window
;
4801 CHECK_LIVE_WINDOW (window
);
4802 w
= XWINDOW (window
);
4804 return font_at (-1, pos
, NULL
, w
, string
);
4808 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4809 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4810 The value is a number of glyphs drawn.
4811 Type C-l to recover what previously shown. */)
4812 (Lisp_Object font_object
, Lisp_Object string
)
4814 Lisp_Object frame
= selected_frame
;
4815 FRAME_PTR f
= XFRAME (frame
);
4821 CHECK_FONT_GET_OBJECT (font_object
, font
);
4822 CHECK_STRING (string
);
4823 len
= SCHARS (string
);
4824 code
= alloca (sizeof (unsigned) * len
);
4825 for (i
= 0; i
< len
; i
++)
4827 Lisp_Object ch
= Faref (string
, make_number (i
));
4831 code
[i
] = font
->driver
->encode_char (font
, c
);
4832 if (code
[i
] == FONT_INVALID_CODE
)
4835 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4837 if (font
->driver
->prepare_face
)
4838 font
->driver
->prepare_face (f
, face
);
4839 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4840 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4841 if (font
->driver
->done_face
)
4842 font
->driver
->done_face (f
, face
);
4844 return make_number (len
);
4848 #endif /* FONT_DEBUG */
4850 #ifdef HAVE_WINDOW_SYSTEM
4852 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4853 doc
: /* Return information about a font named NAME on frame FRAME.
4854 If FRAME is omitted or nil, use the selected frame.
4855 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4856 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4858 OPENED-NAME is the name used for opening the font,
4859 FULL-NAME is the full name of the font,
4860 SIZE is the pixelsize of the font,
4861 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4862 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4863 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4864 how to compose characters.
4865 If the named font is not yet loaded, return nil. */)
4866 (Lisp_Object name
, Lisp_Object frame
)
4871 Lisp_Object font_object
;
4873 (*check_window_system_func
) ();
4876 CHECK_STRING (name
);
4878 frame
= selected_frame
;
4879 CHECK_LIVE_FRAME (frame
);
4884 int fontset
= fs_query_fontset (name
, 0);
4887 name
= fontset_ascii (fontset
);
4888 font_object
= font_open_by_name (f
, SSDATA (name
), SBYTES (name
));
4890 else if (FONT_OBJECT_P (name
))
4892 else if (FONT_ENTITY_P (name
))
4893 font_object
= font_open_entity (f
, name
, 0);
4896 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4897 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4899 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4901 if (NILP (font_object
))
4903 font
= XFONT_OBJECT (font_object
);
4905 info
= Fmake_vector (make_number (7), Qnil
);
4906 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4907 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4908 ASET (info
, 2, make_number (font
->pixel_size
));
4909 ASET (info
, 3, make_number (font
->height
));
4910 ASET (info
, 4, make_number (font
->baseline_offset
));
4911 ASET (info
, 5, make_number (font
->relative_compose
));
4912 ASET (info
, 6, make_number (font
->default_ascent
));
4915 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4916 close it now. Perhaps, we should manage font-objects
4917 by `reference-count'. */
4918 font_close_object (f
, font_object
);
4925 #define BUILD_STYLE_TABLE(TBL) \
4926 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4929 build_style_table (const struct table_entry
*entry
, int nelement
)
4932 Lisp_Object table
, elt
;
4934 table
= Fmake_vector (make_number (nelement
), Qnil
);
4935 for (i
= 0; i
< nelement
; i
++)
4937 for (j
= 0; entry
[i
].names
[j
]; j
++);
4938 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4939 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4940 for (j
= 0; entry
[i
].names
[j
]; j
++)
4941 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4942 ASET (table
, i
, elt
);
4947 /* The deferred font-log data of the form [ACTION ARG RESULT].
4948 If ACTION is not nil, that is added to the log when font_add_log is
4949 called next time. At that time, ACTION is set back to nil. */
4950 static Lisp_Object Vfont_log_deferred
;
4952 /* Prepend the font-related logging data in Vfont_log if it is not
4953 `t'. ACTION describes a kind of font-related action (e.g. listing,
4954 opening), ARG is the argument for the action, and RESULT is the
4955 result of the action. */
4957 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4962 if (EQ (Vfont_log
, Qt
))
4964 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4966 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4968 ASET (Vfont_log_deferred
, 0, Qnil
);
4969 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4970 AREF (Vfont_log_deferred
, 2));
4975 Lisp_Object tail
, elt
;
4976 Lisp_Object equalstr
= build_string ("=");
4978 val
= Ffont_xlfd_name (arg
, Qt
);
4979 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4983 if (EQ (XCAR (elt
), QCscript
)
4984 && SYMBOLP (XCDR (elt
)))
4985 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4986 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4987 else if (EQ (XCAR (elt
), QClang
)
4988 && SYMBOLP (XCDR (elt
)))
4989 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4990 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4991 else if (EQ (XCAR (elt
), QCotf
)
4992 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4993 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4995 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5001 && VECTORP (XCAR (result
))
5002 && ASIZE (XCAR (result
)) > 0
5003 && FONTP (AREF (XCAR (result
), 0)))
5004 result
= font_vconcat_entity_vectors (result
);
5007 val
= Ffont_xlfd_name (result
, Qt
);
5008 if (! FONT_SPEC_P (result
))
5009 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5010 build_string (":"), val
);
5013 else if (CONSP (result
))
5016 result
= Fcopy_sequence (result
);
5017 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5021 val
= Ffont_xlfd_name (val
, Qt
);
5022 XSETCAR (tail
, val
);
5025 else if (VECTORP (result
))
5027 result
= Fcopy_sequence (result
);
5028 for (i
= 0; i
< ASIZE (result
); i
++)
5030 val
= AREF (result
, i
);
5032 val
= Ffont_xlfd_name (val
, Qt
);
5033 ASET (result
, i
, val
);
5036 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5039 /* Record a font-related logging data to be added to Vfont_log when
5040 font_add_log is called next time. ACTION, ARG, RESULT are the same
5044 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5046 if (EQ (Vfont_log
, Qt
))
5048 ASET (Vfont_log_deferred
, 0, build_string (action
));
5049 ASET (Vfont_log_deferred
, 1, arg
);
5050 ASET (Vfont_log_deferred
, 2, result
);
5056 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5057 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5058 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5059 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5060 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5061 /* Note that the other elements in sort_shift_bits are not used. */
5063 staticpro (&font_charset_alist
);
5064 font_charset_alist
= Qnil
;
5066 DEFSYM (Qopentype
, "opentype");
5068 DEFSYM (Qascii_0
, "ascii-0");
5069 DEFSYM (Qiso8859_1
, "iso8859-1");
5070 DEFSYM (Qiso10646_1
, "iso10646-1");
5071 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5072 DEFSYM (Qunicode_sip
, "unicode-sip");
5076 DEFSYM (QCotf
, ":otf");
5077 DEFSYM (QClang
, ":lang");
5078 DEFSYM (QCscript
, ":script");
5079 DEFSYM (QCantialias
, ":antialias");
5081 DEFSYM (QCfoundry
, ":foundry");
5082 DEFSYM (QCadstyle
, ":adstyle");
5083 DEFSYM (QCregistry
, ":registry");
5084 DEFSYM (QCspacing
, ":spacing");
5085 DEFSYM (QCdpi
, ":dpi");
5086 DEFSYM (QCscalable
, ":scalable");
5087 DEFSYM (QCavgwidth
, ":avgwidth");
5088 DEFSYM (QCfont_entity
, ":font-entity");
5089 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5099 DEFSYM (QCuser_spec
, "user-spec");
5101 staticpro (&null_vector
);
5102 null_vector
= Fmake_vector (make_number (0), Qnil
);
5104 staticpro (&scratch_font_spec
);
5105 scratch_font_spec
= Ffont_spec (0, NULL
);
5106 staticpro (&scratch_font_prefer
);
5107 scratch_font_prefer
= Ffont_spec (0, NULL
);
5109 staticpro (&Vfont_log_deferred
);
5110 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5114 staticpro (&otf_list
);
5116 #endif /* HAVE_LIBOTF */
5120 defsubr (&Sfont_spec
);
5121 defsubr (&Sfont_get
);
5122 #ifdef HAVE_WINDOW_SYSTEM
5123 defsubr (&Sfont_face_attributes
);
5125 defsubr (&Sfont_put
);
5126 defsubr (&Slist_fonts
);
5127 defsubr (&Sfont_family_list
);
5128 defsubr (&Sfind_font
);
5129 defsubr (&Sfont_xlfd_name
);
5130 defsubr (&Sclear_font_cache
);
5131 defsubr (&Sfont_shape_gstring
);
5132 defsubr (&Sfont_variation_glyphs
);
5134 defsubr (&Sfont_drive_otf
);
5135 defsubr (&Sfont_otf_alternates
);
5139 defsubr (&Sopen_font
);
5140 defsubr (&Sclose_font
);
5141 defsubr (&Squery_font
);
5142 defsubr (&Sfont_get_glyphs
);
5143 defsubr (&Sfont_match_p
);
5144 defsubr (&Sfont_at
);
5146 defsubr (&Sdraw_string
);
5148 #endif /* FONT_DEBUG */
5149 #ifdef HAVE_WINDOW_SYSTEM
5150 defsubr (&Sfont_info
);
5153 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5155 Alist of fontname patterns vs the corresponding encoding and repertory info.
5156 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5157 where ENCODING is a charset or a char-table,
5158 and REPERTORY is a charset, a char-table, or nil.
5160 If ENCODING and REPERTORY are the same, the element can have the form
5161 \(REGEXP . ENCODING).
5163 ENCODING is for converting a character to a glyph code of the font.
5164 If ENCODING is a charset, encoding a character by the charset gives
5165 the corresponding glyph code. If ENCODING is a char-table, looking up
5166 the table by a character gives the corresponding glyph code.
5168 REPERTORY specifies a repertory of characters supported by the font.
5169 If REPERTORY is a charset, all characters belonging to the charset are
5170 supported. If REPERTORY is a char-table, all characters who have a
5171 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5172 gets the repertory information by an opened font and ENCODING. */);
5173 Vfont_encoding_alist
= Qnil
;
5175 /* FIXME: These 3 vars are not quite what they appear: setq on them
5176 won't have any effect other than disconnect them from the style
5177 table used by the font display code. So we make them read-only,
5178 to avoid this confusing situation. */
5180 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5181 doc
: /* Vector of valid font weight values.
5182 Each element has the form:
5183 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5184 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5185 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5186 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5188 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5189 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5190 See `font-weight-table' for the format of the vector. */);
5191 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5192 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5194 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5195 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5196 See `font-weight-table' for the format of the vector. */);
5197 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5198 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5200 staticpro (&font_style_table
);
5201 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5202 ASET (font_style_table
, 0, Vfont_weight_table
);
5203 ASET (font_style_table
, 1, Vfont_slant_table
);
5204 ASET (font_style_table
, 2, Vfont_width_table
);
5206 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5207 *Logging list of font related actions and results.
5208 The value t means to suppress the logging.
5209 The initial value is set to nil if the environment variable
5210 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5213 #ifdef HAVE_WINDOW_SYSTEM
5214 #ifdef HAVE_FREETYPE
5216 #ifdef HAVE_X_WINDOWS
5221 #endif /* HAVE_XFT */
5222 #endif /* HAVE_X_WINDOWS */
5223 #else /* not HAVE_FREETYPE */
5224 #ifdef HAVE_X_WINDOWS
5226 #endif /* HAVE_X_WINDOWS */
5227 #endif /* not HAVE_FREETYPE */
5230 #endif /* HAVE_BDFFONT */
5233 #endif /* WINDOWSNT */
5236 #endif /* HAVE_NS */
5237 #endif /* HAVE_WINDOW_SYSTEM */
5243 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;