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/>. */
31 #include "character.h"
35 #include "dispextern.h"
37 #include "composite.h"
41 #ifdef HAVE_WINDOW_SYSTEM
43 #endif /* HAVE_WINDOW_SYSTEM */
45 Lisp_Object Qopentype
;
47 /* Important character set strings. */
48 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
50 #define DEFAULT_ENCODING Qiso8859_1
52 /* Unicode category `Cf'. */
53 static Lisp_Object QCf
;
55 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
56 static Lisp_Object font_style_table
;
58 /* Structure used for tables mapping weight, slant, and width numeric
59 values and their names. */
64 /* The first one is a valid name as a face attribute.
65 The second one (if any) is a typical name in XLFD field. */
69 /* Table of weight numeric values and their names. This table must be
70 sorted by numeric values in ascending order. */
72 static const struct table_entry weight_table
[] =
75 { 20, { "ultra-light", "ultralight" }},
76 { 40, { "extra-light", "extralight" }},
78 { 75, { "semi-light", "semilight", "demilight", "book" }},
79 { 100, { "normal", "medium", "regular", "unspecified" }},
80 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
82 { 205, { "extra-bold", "extrabold" }},
83 { 210, { "ultra-bold", "ultrabold", "black" }}
86 /* Table of slant numeric values and their names. This table must be
87 sorted by numeric values in ascending order. */
89 static const struct table_entry slant_table
[] =
91 { 0, { "reverse-oblique", "ro" }},
92 { 10, { "reverse-italic", "ri" }},
93 { 100, { "normal", "r", "unspecified" }},
94 { 200, { "italic" ,"i", "ot" }},
95 { 210, { "oblique", "o" }}
98 /* Table of width numeric values and their names. This table must be
99 sorted by numeric values in ascending order. */
101 static const struct table_entry width_table
[] =
103 { 50, { "ultra-condensed", "ultracondensed" }},
104 { 63, { "extra-condensed", "extracondensed" }},
105 { 75, { "condensed", "compressed", "narrow" }},
106 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
107 { 100, { "normal", "medium", "regular", "unspecified" }},
108 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
109 { 125, { "expanded" }},
110 { 150, { "extra-expanded", "extraexpanded" }},
111 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
114 Lisp_Object QCfoundry
;
115 static Lisp_Object QCadstyle
, QCregistry
;
116 /* Symbols representing keys of font extra info. */
117 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
118 Lisp_Object QCantialias
, QCfont_entity
;
119 static Lisp_Object QCfc_unknown_spec
;
120 /* Symbols representing values of font spacing property. */
121 static Lisp_Object Qc
, Qm
, Qd
;
123 /* Special ADSTYLE properties to avoid fonts used for Latin
124 characters; used in xfont.c and ftfont.c. */
125 Lisp_Object Qja
, Qko
;
127 static Lisp_Object QCuser_spec
;
129 /* Alist of font registry symbols and the corresponding charset
130 information. The information is retrieved from
131 Vfont_encoding_alist on demand.
133 Eash element has the form:
134 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
138 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
139 encodes a character code to a glyph code of a font, and
140 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
141 character is supported by a font.
143 The latter form means that the information for REGISTRY couldn't be
145 static Lisp_Object font_charset_alist
;
147 /* List of all font drivers. Each font-backend (XXXfont.c) calls
148 register_font_driver in syms_of_XXXfont to register its font-driver
150 static struct font_driver_list
*font_driver_list
;
154 /* Creators of font-related Lisp object. */
157 font_make_spec (void)
159 Lisp_Object font_spec
;
160 struct font_spec
*spec
161 = ((struct font_spec
*)
162 allocate_pseudovector (VECSIZE (struct font_spec
),
163 FONT_SPEC_MAX
, PVEC_FONT
));
164 XSETFONT (font_spec
, spec
);
169 font_make_entity (void)
171 Lisp_Object font_entity
;
172 struct font_entity
*entity
173 = ((struct font_entity
*)
174 allocate_pseudovector (VECSIZE (struct font_entity
),
175 FONT_ENTITY_MAX
, PVEC_FONT
));
176 XSETFONT (font_entity
, entity
);
180 /* Create a font-object whose structure size is SIZE. If ENTITY is
181 not nil, copy properties from ENTITY to the font-object. If
182 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
184 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
186 Lisp_Object font_object
;
188 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
191 XSETFONT (font_object
, font
);
195 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
196 font
->props
[i
] = AREF (entity
, i
);
197 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
198 font
->props
[FONT_EXTRA_INDEX
]
199 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
202 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
208 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
209 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
210 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
212 static unsigned font_encode_char (Lisp_Object
, int);
214 /* Number of registered font drivers. */
215 static int num_font_drivers
;
218 /* Return a Lispy value of a font property value at STR and LEN bytes.
219 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
220 consist entirely of one or more digits, return a symbol interned
221 from STR. Otherwise, return an integer. */
224 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
229 ptrdiff_t nbytes
, nchars
;
231 if (len
== 1 && *str
== '*')
233 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
235 for (i
= 1; i
< len
; i
++)
236 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
243 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
246 return make_number (n
);
247 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
251 xsignal1 (Qoverflow_error
, make_string (str
, len
));
255 /* This code is similar to intern function from lread.c. */
256 obarray
= check_obarray (Vobarray
);
257 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
258 tem
= oblookup (obarray
, str
,
259 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
263 if (len
== nchars
|| len
!= nbytes
)
264 tem
= make_unibyte_string (str
, len
);
266 tem
= make_multibyte_string (str
, nchars
, len
);
267 return Fintern (tem
, obarray
);
270 /* Return a pixel size of font-spec SPEC on frame F. */
273 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
275 #ifdef HAVE_WINDOW_SYSTEM
276 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
285 eassert (FLOATP (size
));
286 point_size
= XFLOAT_DATA (size
);
287 val
= AREF (spec
, FONT_DPI_INDEX
);
292 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
300 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
301 font vector. If VAL is not valid (i.e. not registered in
302 font_style_table), return -1 if NOERROR is zero, and return a
303 proper index if NOERROR is nonzero. In that case, register VAL in
304 font_style_table if VAL is a symbol, and return the closest index if
305 VAL is an integer. */
308 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
311 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
314 CHECK_VECTOR (table
);
321 Lisp_Object args
[2], elt
;
323 /* At first try exact match. */
324 for (i
= 0; i
< len
; i
++)
326 CHECK_VECTOR (AREF (table
, i
));
327 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
328 if (EQ (val
, AREF (AREF (table
, i
), j
)))
330 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
331 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
332 | (i
<< 4) | (j
- 1));
335 /* Try also with case-folding match. */
336 s
= SSDATA (SYMBOL_NAME (val
));
337 for (i
= 0; i
< len
; i
++)
338 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
340 elt
= AREF (AREF (table
, i
), j
);
341 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
343 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
344 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
345 | (i
<< 4) | (j
- 1));
351 elt
= Fmake_vector (make_number (2), make_number (100));
354 args
[1] = Fmake_vector (make_number (1), elt
);
355 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
356 return (100 << 8) | (i
<< 4);
361 EMACS_INT numeric
= XINT (val
);
363 for (i
= 0, last_n
= -1; i
< len
; i
++)
367 CHECK_VECTOR (AREF (table
, i
));
368 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
369 n
= XINT (AREF (AREF (table
, i
), 0));
371 return (n
<< 8) | (i
<< 4);
376 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
377 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
383 return ((last_n
<< 8) | ((i
- 1) << 4));
388 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
391 Lisp_Object val
= AREF (font
, prop
);
392 Lisp_Object table
, elt
;
397 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
398 CHECK_VECTOR (table
);
399 i
= XINT (val
) & 0xFF;
400 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
401 elt
= AREF (table
, ((i
>> 4) & 0xF));
403 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
404 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
409 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
410 FONTNAME. ENCODING is a charset symbol that specifies the encoding
411 of the font. REPERTORY is a charset symbol or nil. */
414 find_font_encoding (Lisp_Object fontname
)
416 Lisp_Object tail
, elt
;
418 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
422 && STRINGP (XCAR (elt
))
423 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
424 && (SYMBOLP (XCDR (elt
))
425 ? CHARSETP (XCDR (elt
))
426 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
432 /* Return encoding charset and repertory charset for REGISTRY in
433 ENCODING and REPERTORY correspondingly. If correct information for
434 REGISTRY is available, return 0. Otherwise return -1. */
437 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
440 int encoding_id
, repertory_id
;
442 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
448 encoding_id
= XINT (XCAR (val
));
449 repertory_id
= XINT (XCDR (val
));
453 val
= find_font_encoding (SYMBOL_NAME (registry
));
454 if (SYMBOLP (val
) && CHARSETP (val
))
456 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
458 else if (CONSP (val
))
460 if (! CHARSETP (XCAR (val
)))
462 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
463 if (NILP (XCDR (val
)))
467 if (! CHARSETP (XCDR (val
)))
469 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
474 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
476 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
480 *encoding
= CHARSET_FROM_ID (encoding_id
);
482 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
487 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
492 /* Font property value validators. See the comment of
493 font_property_table for the meaning of the arguments. */
495 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
496 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
497 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
498 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
499 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
500 static int get_font_prop_index (Lisp_Object
);
503 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
506 val
= Fintern (val
, Qnil
);
509 else if (EQ (prop
, QCregistry
))
510 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
516 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
518 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
519 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
523 EMACS_INT n
= XINT (val
);
524 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
526 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
530 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
533 if ((n
& 0xF) + 1 >= ASIZE (elt
))
537 CHECK_NUMBER (AREF (elt
, 0));
538 if (XINT (AREF (elt
, 0)) != (n
>> 8))
543 else if (SYMBOLP (val
))
545 int n
= font_style_to_value (prop
, val
, 0);
547 val
= n
>= 0 ? make_number (n
) : Qerror
;
555 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
557 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
562 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
564 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
566 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
568 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
570 if (spacing
== 'c' || spacing
== 'C')
571 return make_number (FONT_SPACING_CHARCELL
);
572 if (spacing
== 'm' || spacing
== 'M')
573 return make_number (FONT_SPACING_MONO
);
574 if (spacing
== 'p' || spacing
== 'P')
575 return make_number (FONT_SPACING_PROPORTIONAL
);
576 if (spacing
== 'd' || spacing
== 'D')
577 return make_number (FONT_SPACING_DUAL
);
583 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
585 Lisp_Object tail
, tmp
;
588 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
589 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
590 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
593 if (! SYMBOLP (XCAR (val
)))
598 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
600 for (i
= 0; i
< 2; i
++)
607 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
608 if (! SYMBOLP (XCAR (tmp
)))
616 /* Structure of known font property keys and validator of the
620 /* Pointer to the key symbol. */
622 /* Function to validate PROP's value VAL, or NULL if any value is
623 ok. The value is VAL or its regularized value if VAL is valid,
624 and Qerror if not. */
625 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
626 } font_property_table
[] =
627 { { &QCtype
, font_prop_validate_symbol
},
628 { &QCfoundry
, font_prop_validate_symbol
},
629 { &QCfamily
, font_prop_validate_symbol
},
630 { &QCadstyle
, font_prop_validate_symbol
},
631 { &QCregistry
, font_prop_validate_symbol
},
632 { &QCweight
, font_prop_validate_style
},
633 { &QCslant
, font_prop_validate_style
},
634 { &QCwidth
, font_prop_validate_style
},
635 { &QCsize
, font_prop_validate_non_neg
},
636 { &QCdpi
, font_prop_validate_non_neg
},
637 { &QCspacing
, font_prop_validate_spacing
},
638 { &QCavgwidth
, font_prop_validate_non_neg
},
639 /* The order of the above entries must match with enum
640 font_property_index. */
641 { &QClang
, font_prop_validate_symbol
},
642 { &QCscript
, font_prop_validate_symbol
},
643 { &QCotf
, font_prop_validate_otf
}
646 /* Size (number of elements) of the above table. */
647 #define FONT_PROPERTY_TABLE_SIZE \
648 ((sizeof font_property_table) / (sizeof *font_property_table))
650 /* Return an index number of font property KEY or -1 if KEY is not an
651 already known property. */
654 get_font_prop_index (Lisp_Object key
)
658 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
659 if (EQ (key
, *font_property_table
[i
].key
))
664 /* Validate the font property. The property key is specified by the
665 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
666 signal an error. The value is VAL or the regularized one. */
669 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
671 Lisp_Object validated
;
676 prop
= *font_property_table
[idx
].key
;
679 idx
= get_font_prop_index (prop
);
683 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
684 if (EQ (validated
, Qerror
))
685 signal_error ("invalid font property", Fcons (prop
, val
));
690 /* Store VAL as a value of extra font property PROP in FONT while
691 keeping the sorting order. Don't check the validity of VAL. */
694 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
696 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
697 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
701 Lisp_Object prev
= Qnil
;
704 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
705 prev
= extra
, extra
= XCDR (extra
);
708 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
710 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
716 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
721 /* Font name parser and unparser */
723 static int parse_matrix (const char *);
724 static int font_expand_wildcards (Lisp_Object
*, int);
725 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
727 /* An enumerator for each field of an XLFD font name. */
728 enum xlfd_field_index
747 /* An enumerator for mask bit corresponding to each XLFD field. */
750 XLFD_FOUNDRY_MASK
= 0x0001,
751 XLFD_FAMILY_MASK
= 0x0002,
752 XLFD_WEIGHT_MASK
= 0x0004,
753 XLFD_SLANT_MASK
= 0x0008,
754 XLFD_SWIDTH_MASK
= 0x0010,
755 XLFD_ADSTYLE_MASK
= 0x0020,
756 XLFD_PIXEL_MASK
= 0x0040,
757 XLFD_POINT_MASK
= 0x0080,
758 XLFD_RESX_MASK
= 0x0100,
759 XLFD_RESY_MASK
= 0x0200,
760 XLFD_SPACING_MASK
= 0x0400,
761 XLFD_AVGWIDTH_MASK
= 0x0800,
762 XLFD_REGISTRY_MASK
= 0x1000,
763 XLFD_ENCODING_MASK
= 0x2000
767 /* Parse P pointing to the pixel/point size field of the form
768 `[A B C D]' which specifies a transformation matrix:
774 by which all glyphs of the font are transformed. The spec says
775 that scalar value N for the pixel/point size is equivalent to:
776 A = N * resx/resy, B = C = 0, D = N.
778 Return the scalar value N if the form is valid. Otherwise return
782 parse_matrix (const char *p
)
788 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
791 matrix
[i
] = - strtod (p
+ 1, &end
);
793 matrix
[i
] = strtod (p
, &end
);
796 return (i
== 4 ? (int) matrix
[3] : -1);
799 /* Expand a wildcard field in FIELD (the first N fields are filled) to
800 multiple fields to fill in all 14 XLFD fields while restricting a
801 field position by its contents. */
804 font_expand_wildcards (Lisp_Object
*field
, int n
)
807 Lisp_Object tmp
[XLFD_LAST_INDEX
];
808 /* Array of information about where this element can go. Nth
809 element is for Nth element of FIELD. */
811 /* Minimum possible field. */
813 /* Maximum possible field. */
815 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
817 } range
[XLFD_LAST_INDEX
];
819 int range_from
, range_to
;
822 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
823 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
824 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
825 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
826 | XLFD_AVGWIDTH_MASK)
827 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
829 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
830 field. The value is shifted to left one bit by one in the
832 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
833 range_mask
= (range_mask
<< 1) | 1;
835 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
836 position-based restriction for FIELD[I]. */
837 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
838 i
++, range_from
++, range_to
++, range_mask
<<= 1)
840 Lisp_Object val
= field
[i
];
846 range
[i
].from
= range_from
;
847 range
[i
].to
= range_to
;
848 range
[i
].mask
= range_mask
;
852 /* The triplet FROM, TO, and MASK is a value-based
853 restriction for FIELD[I]. */
859 EMACS_INT numeric
= XINT (val
);
862 from
= to
= XLFD_ENCODING_INDEX
,
863 mask
= XLFD_ENCODING_MASK
;
864 else if (numeric
== 0)
865 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
866 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
867 else if (numeric
<= 48)
868 from
= to
= XLFD_PIXEL_INDEX
,
869 mask
= XLFD_PIXEL_MASK
;
871 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
872 mask
= XLFD_LARGENUM_MASK
;
874 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
875 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
876 mask
= XLFD_NULL_MASK
;
878 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
881 Lisp_Object name
= SYMBOL_NAME (val
);
883 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
884 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
885 mask
= XLFD_REGENC_MASK
;
887 from
= to
= XLFD_ENCODING_INDEX
,
888 mask
= XLFD_ENCODING_MASK
;
890 else if (range_from
<= XLFD_WEIGHT_INDEX
891 && range_to
>= XLFD_WEIGHT_INDEX
892 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
893 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
894 else if (range_from
<= XLFD_SLANT_INDEX
895 && range_to
>= XLFD_SLANT_INDEX
896 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
897 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
898 else if (range_from
<= XLFD_SWIDTH_INDEX
899 && range_to
>= XLFD_SWIDTH_INDEX
900 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
901 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
904 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
905 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
907 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
908 mask
= XLFD_SYMBOL_MASK
;
911 /* Merge position-based and value-based restrictions. */
913 while (from
< range_from
)
914 mask
&= ~(1 << from
++);
915 while (from
< 14 && ! (mask
& (1 << from
)))
917 while (to
> range_to
)
918 mask
&= ~(1 << to
--);
919 while (to
>= 0 && ! (mask
& (1 << to
)))
923 range
[i
].from
= from
;
925 range
[i
].mask
= mask
;
927 if (from
> range_from
|| to
< range_to
)
929 /* The range is narrowed by value-based restrictions.
930 Reflect it to the other fields. */
932 /* Following fields should be after FROM. */
934 /* Preceding fields should be before TO. */
935 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
937 /* Check FROM for non-wildcard field. */
938 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
940 while (range
[j
].from
< from
)
941 range
[j
].mask
&= ~(1 << range
[j
].from
++);
942 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
944 range
[j
].from
= from
;
947 from
= range
[j
].from
;
948 if (range
[j
].to
> to
)
950 while (range
[j
].to
> to
)
951 range
[j
].mask
&= ~(1 << range
[j
].to
--);
952 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
965 /* Decide all fields from restrictions in RANGE. */
966 for (i
= j
= 0; i
< n
; i
++)
968 if (j
< range
[i
].from
)
970 if (i
== 0 || ! NILP (tmp
[i
- 1]))
971 /* None of TMP[X] corresponds to Jth field. */
973 for (; j
< range
[i
].from
; j
++)
978 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
980 for (; j
< XLFD_LAST_INDEX
; j
++)
982 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
983 field
[XLFD_ENCODING_INDEX
]
984 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
989 /* Parse NAME (null terminated) as XLFD and store information in FONT
990 (font-spec or font-entity). Size property of FONT is set as
992 specified XLFD fields FONT property
993 --------------------- -------------
994 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
995 POINT_SIZE and RESY calculated pixel size (Lisp integer)
996 POINT_SIZE POINT_SIZE/10 (Lisp float)
998 If NAME is successfully parsed, return 0. Otherwise return -1.
1000 FONT is usually a font-spec, but when this function is called from
1001 X font backend driver, it is a font-entity. In that case, NAME is
1002 a fully specified XLFD. */
1005 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1008 char *f
[XLFD_LAST_INDEX
+ 1];
1012 if (len
> 255 || !len
)
1013 /* Maximum XLFD name length is 255. */
1015 /* Accept "*-.." as a fully specified XLFD. */
1016 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1017 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1020 for (p
= name
+ i
; *p
; p
++)
1024 if (i
== XLFD_LAST_INDEX
)
1029 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1030 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1032 if (i
== XLFD_LAST_INDEX
)
1034 /* Fully specified XLFD. */
1037 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1038 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1039 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1040 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1042 val
= INTERN_FIELD_SYM (i
);
1045 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1047 ASET (font
, j
, make_number (n
));
1050 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1051 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1052 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1054 ASET (font
, FONT_REGISTRY_INDEX
,
1055 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1056 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1058 p
= f
[XLFD_PIXEL_INDEX
];
1059 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1060 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1063 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1065 ASET (font
, FONT_SIZE_INDEX
, val
);
1066 else if (FONT_ENTITY_P (font
))
1070 double point_size
= -1;
1072 eassert (FONT_SPEC_P (font
));
1073 p
= f
[XLFD_POINT_INDEX
];
1075 point_size
= parse_matrix (p
);
1076 else if (c_isdigit (*p
))
1077 point_size
= atoi (p
), point_size
/= 10;
1078 if (point_size
>= 0)
1079 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1083 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1084 if (! NILP (val
) && ! INTEGERP (val
))
1086 ASET (font
, FONT_DPI_INDEX
, val
);
1087 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1090 val
= font_prop_validate_spacing (QCspacing
, val
);
1091 if (! INTEGERP (val
))
1093 ASET (font
, FONT_SPACING_INDEX
, val
);
1095 p
= f
[XLFD_AVGWIDTH_INDEX
];
1098 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1099 if (! NILP (val
) && ! INTEGERP (val
))
1101 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1105 bool wild_card_found
= 0;
1106 Lisp_Object prop
[XLFD_LAST_INDEX
];
1108 if (FONT_ENTITY_P (font
))
1110 for (j
= 0; j
< i
; j
++)
1114 if (f
[j
][1] && f
[j
][1] != '-')
1117 wild_card_found
= 1;
1120 prop
[j
] = INTERN_FIELD (j
);
1122 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1124 if (! wild_card_found
)
1126 if (font_expand_wildcards (prop
, i
) < 0)
1129 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1130 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1131 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1132 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1133 if (! NILP (prop
[i
]))
1135 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1137 ASET (font
, j
, make_number (n
));
1139 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1140 val
= prop
[XLFD_REGISTRY_INDEX
];
1143 val
= prop
[XLFD_ENCODING_INDEX
];
1145 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1147 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1148 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1150 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1151 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1153 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1155 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1156 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1157 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1159 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1161 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1164 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1165 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1166 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1168 val
= font_prop_validate_spacing (QCspacing
,
1169 prop
[XLFD_SPACING_INDEX
]);
1170 if (! INTEGERP (val
))
1172 ASET (font
, FONT_SPACING_INDEX
, val
);
1174 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1175 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1181 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1182 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1183 0, use PIXEL_SIZE instead. */
1186 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1189 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1193 eassert (FONTP (font
));
1195 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1198 if (i
== FONT_ADSTYLE_INDEX
)
1199 j
= XLFD_ADSTYLE_INDEX
;
1200 else if (i
== FONT_REGISTRY_INDEX
)
1201 j
= XLFD_REGISTRY_INDEX
;
1202 val
= AREF (font
, i
);
1205 if (j
== XLFD_REGISTRY_INDEX
)
1213 val
= SYMBOL_NAME (val
);
1214 if (j
== XLFD_REGISTRY_INDEX
1215 && ! strchr (SSDATA (val
), '-'))
1217 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1218 ptrdiff_t alloc
= SBYTES (val
) + 4;
1219 if (nbytes
<= alloc
)
1221 f
[j
] = p
= alloca (alloc
);
1222 sprintf (p
, "%s%s-*", SDATA (val
),
1223 "*" + (SDATA (val
)[SBYTES (val
) - 1] == '*'));
1226 f
[j
] = SSDATA (val
);
1230 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1233 val
= font_style_symbolic (font
, i
, 0);
1238 val
= SYMBOL_NAME (val
);
1239 f
[j
] = SSDATA (val
);
1243 val
= AREF (font
, FONT_SIZE_INDEX
);
1244 eassert (NUMBERP (val
) || NILP (val
));
1247 EMACS_INT v
= XINT (val
);
1252 f
[XLFD_PIXEL_INDEX
] = p
=
1253 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1254 sprintf (p
, "%"pI
"d-*", v
);
1257 f
[XLFD_PIXEL_INDEX
] = "*-*";
1259 else if (FLOATP (val
))
1261 double v
= XFLOAT_DATA (val
) * 10;
1262 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1263 sprintf (p
, "*-%.0f", v
);
1266 f
[XLFD_PIXEL_INDEX
] = "*-*";
1268 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1270 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1271 f
[XLFD_RESX_INDEX
] = p
=
1272 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1273 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1276 f
[XLFD_RESX_INDEX
] = "*-*";
1277 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1279 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1281 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1282 : spacing
<= FONT_SPACING_DUAL
? "d"
1283 : spacing
<= FONT_SPACING_MONO
? "m"
1287 f
[XLFD_SPACING_INDEX
] = "*";
1288 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1290 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1291 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1294 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1295 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1296 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1297 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1298 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1299 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1300 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1301 f
[XLFD_REGISTRY_INDEX
]);
1302 return len
< nbytes
? len
: -1;
1305 /* Parse NAME (null terminated) and store information in FONT
1306 (font-spec or font-entity). NAME is supplied in either the
1307 Fontconfig or GTK font name format. If NAME is successfully
1308 parsed, return 0. Otherwise return -1.
1310 The fontconfig format is
1312 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1316 FAMILY [PROPS...] [SIZE]
1318 This function tries to guess which format it is. */
1321 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1324 char *size_beg
= NULL
, *size_end
= NULL
;
1325 char *props_beg
= NULL
, *family_end
= NULL
;
1330 for (p
= name
; *p
; p
++)
1332 if (*p
== '\\' && p
[1])
1336 props_beg
= family_end
= p
;
1341 bool decimal
= 0, size_found
= 1;
1342 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1343 if (! c_isdigit (*q
))
1345 if (*q
!= '.' || decimal
)
1364 Lisp_Object extra_props
= Qnil
;
1366 /* A fontconfig name with size and/or property data. */
1367 if (family_end
> name
)
1370 family
= font_intern_prop (name
, family_end
- name
, 1);
1371 ASET (font
, FONT_FAMILY_INDEX
, family
);
1375 double point_size
= strtod (size_beg
, &size_end
);
1376 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1377 if (*size_end
== ':' && size_end
[1])
1378 props_beg
= size_end
;
1382 /* Now parse ":KEY=VAL" patterns. */
1385 for (p
= props_beg
; *p
; p
= q
)
1387 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1390 /* Must be an enumerated value. */
1394 val
= font_intern_prop (p
, q
- p
, 1);
1396 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1397 && memcmp (p, STR, strlen (STR)) == 0)
1399 if (PROP_MATCH ("light")
1400 || PROP_MATCH ("medium")
1401 || PROP_MATCH ("demibold")
1402 || PROP_MATCH ("bold")
1403 || PROP_MATCH ("black"))
1404 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1405 else if (PROP_MATCH ("roman")
1406 || PROP_MATCH ("italic")
1407 || PROP_MATCH ("oblique"))
1408 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1409 else if (PROP_MATCH ("charcell"))
1410 ASET (font
, FONT_SPACING_INDEX
,
1411 make_number (FONT_SPACING_CHARCELL
));
1412 else if (PROP_MATCH ("mono"))
1413 ASET (font
, FONT_SPACING_INDEX
,
1414 make_number (FONT_SPACING_MONO
));
1415 else if (PROP_MATCH ("proportional"))
1416 ASET (font
, FONT_SPACING_INDEX
,
1417 make_number (FONT_SPACING_PROPORTIONAL
));
1426 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1427 prop
= FONT_SIZE_INDEX
;
1430 key
= font_intern_prop (p
, q
- p
, 1);
1431 prop
= get_font_prop_index (key
);
1435 for (q
= p
; *q
&& *q
!= ':'; q
++);
1436 val
= font_intern_prop (p
, q
- p
, 0);
1438 if (prop
>= FONT_FOUNDRY_INDEX
1439 && prop
< FONT_EXTRA_INDEX
)
1440 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1443 extra_props
= nconc2 (extra_props
,
1444 Fcons (Fcons (key
, val
), Qnil
));
1451 if (! NILP (extra_props
))
1453 struct font_driver_list
*driver_list
= font_driver_list
;
1454 for ( ; driver_list
; driver_list
= driver_list
->next
)
1455 if (driver_list
->driver
->filter_properties
)
1456 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1462 /* Either a fontconfig-style name with no size and property
1463 data, or a GTK-style name. */
1464 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1465 Lisp_Object width
= Qnil
, size
= Qnil
;
1469 /* Scan backwards from the end, looking for a size. */
1470 for (p
= name
+ len
- 1; p
>= name
; p
--)
1471 if (!c_isdigit (*p
))
1474 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1475 /* Found a font size. */
1476 size
= make_float (strtod (p
+ 1, NULL
));
1480 /* Now P points to the termination of the string, sans size.
1481 Scan backwards, looking for font properties. */
1482 for (; p
> name
; p
= q
)
1484 for (q
= p
- 1; q
>= name
; q
--)
1486 if (q
> name
&& *(q
-1) == '\\')
1487 --q
; /* Skip quoting backslashes. */
1493 word_len
= p
- word_start
;
1495 #define PROP_MATCH(STR) \
1496 (word_len == strlen (STR) \
1497 && memcmp (word_start, STR, strlen (STR)) == 0)
1498 #define PROP_SAVE(VAR, STR) \
1499 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1501 if (PROP_MATCH ("Ultra-Light"))
1502 PROP_SAVE (weight
, "ultra-light");
1503 else if (PROP_MATCH ("Light"))
1504 PROP_SAVE (weight
, "light");
1505 else if (PROP_MATCH ("Book"))
1506 PROP_SAVE (weight
, "book");
1507 else if (PROP_MATCH ("Medium"))
1508 PROP_SAVE (weight
, "medium");
1509 else if (PROP_MATCH ("Semi-Bold"))
1510 PROP_SAVE (weight
, "semi-bold");
1511 else if (PROP_MATCH ("Bold"))
1512 PROP_SAVE (weight
, "bold");
1513 else if (PROP_MATCH ("Italic"))
1514 PROP_SAVE (slant
, "italic");
1515 else if (PROP_MATCH ("Oblique"))
1516 PROP_SAVE (slant
, "oblique");
1517 else if (PROP_MATCH ("Semi-Condensed"))
1518 PROP_SAVE (width
, "semi-condensed");
1519 else if (PROP_MATCH ("Condensed"))
1520 PROP_SAVE (width
, "condensed");
1521 /* An unknown word must be part of the font name. */
1532 ASET (font
, FONT_FAMILY_INDEX
,
1533 font_intern_prop (name
, family_end
- name
, 1));
1535 ASET (font
, FONT_SIZE_INDEX
, size
);
1537 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1539 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1541 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1547 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1548 NAME (NBYTES length), and return the name length. If
1549 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1552 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1554 Lisp_Object family
, foundry
;
1560 Lisp_Object styles
[3];
1561 const char *style_names
[3] = { "weight", "slant", "width" };
1563 family
= AREF (font
, FONT_FAMILY_INDEX
);
1564 if (! NILP (family
))
1566 if (SYMBOLP (family
))
1567 family
= SYMBOL_NAME (family
);
1572 val
= AREF (font
, FONT_SIZE_INDEX
);
1575 if (XINT (val
) != 0)
1576 pixel_size
= XINT (val
);
1581 eassert (FLOATP (val
));
1583 point_size
= (int) XFLOAT_DATA (val
);
1586 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1587 if (! NILP (foundry
))
1589 if (SYMBOLP (foundry
))
1590 foundry
= SYMBOL_NAME (foundry
);
1595 for (i
= 0; i
< 3; i
++)
1596 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1599 lim
= name
+ nbytes
;
1600 if (! NILP (family
))
1602 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1603 if (! (0 <= len
&& len
< lim
- p
))
1609 int len
= snprintf (p
, lim
- p
, "-%d" + (p
== name
), point_size
);
1610 if (! (0 <= len
&& len
< lim
- p
))
1614 else if (pixel_size
> 0)
1616 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1617 if (! (0 <= len
&& len
< lim
- p
))
1621 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1623 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1624 SSDATA (SYMBOL_NAME (AREF (font
,
1625 FONT_FOUNDRY_INDEX
))));
1626 if (! (0 <= len
&& len
< lim
- p
))
1630 for (i
= 0; i
< 3; i
++)
1631 if (! NILP (styles
[i
]))
1633 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1634 SSDATA (SYMBOL_NAME (styles
[i
])));
1635 if (! (0 <= len
&& len
< lim
- p
))
1640 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1642 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1643 XINT (AREF (font
, FONT_DPI_INDEX
)));
1644 if (! (0 <= len
&& len
< lim
- p
))
1649 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1651 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1652 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1653 if (! (0 <= len
&& len
< lim
- p
))
1658 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1660 int len
= snprintf (p
, lim
- p
,
1661 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1663 : ":scalable=false"));
1664 if (! (0 <= len
&& len
< lim
- p
))
1672 /* Parse NAME (null terminated) and store information in FONT
1673 (font-spec or font-entity). If NAME is successfully parsed, return
1674 0. Otherwise return -1. */
1677 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1679 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1680 return font_parse_xlfd (name
, namelen
, font
);
1681 return font_parse_fcname (name
, namelen
, font
);
1685 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1686 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1690 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1696 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1698 CHECK_STRING (family
);
1699 len
= SBYTES (family
);
1700 p0
= SSDATA (family
);
1701 p1
= strchr (p0
, '-');
1704 if ((*p0
!= '*' && p1
- p0
> 0)
1705 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1706 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1709 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1712 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1714 if (! NILP (registry
))
1716 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1717 CHECK_STRING (registry
);
1718 len
= SBYTES (registry
);
1719 p0
= SSDATA (registry
);
1720 p1
= strchr (p0
, '-');
1723 if (SDATA (registry
)[len
- 1] == '*')
1724 registry
= concat2 (registry
, build_string ("-*"));
1726 registry
= concat2 (registry
, build_string ("*-*"));
1728 registry
= Fdowncase (registry
);
1729 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1734 /* This part (through the next ^L) is still experimental and not
1735 tested much. We may drastically change codes. */
1741 #define LGSTRING_HEADER_SIZE 6
1742 #define LGSTRING_GLYPH_SIZE 8
1745 check_gstring (Lisp_Object gstring
)
1751 CHECK_VECTOR (gstring
);
1752 val
= AREF (gstring
, 0);
1754 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1756 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1757 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1758 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1759 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1760 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1761 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1762 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1763 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1764 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1765 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1766 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1768 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1770 val
= LGSTRING_GLYPH (gstring
, i
);
1772 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1774 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1776 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1777 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1778 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1779 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1780 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1781 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1782 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1783 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1785 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1787 if (ASIZE (val
) < 3)
1789 for (j
= 0; j
< 3; j
++)
1790 CHECK_NUMBER (AREF (val
, j
));
1795 error ("Invalid glyph-string format");
1800 check_otf_features (Lisp_Object otf_features
)
1804 CHECK_CONS (otf_features
);
1805 CHECK_SYMBOL (XCAR (otf_features
));
1806 otf_features
= XCDR (otf_features
);
1807 CHECK_CONS (otf_features
);
1808 CHECK_SYMBOL (XCAR (otf_features
));
1809 otf_features
= XCDR (otf_features
);
1810 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1812 CHECK_SYMBOL (XCAR (val
));
1813 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1814 error ("Invalid OTF GSUB feature: %s",
1815 SDATA (SYMBOL_NAME (XCAR (val
))));
1817 otf_features
= XCDR (otf_features
);
1818 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1820 CHECK_SYMBOL (XCAR (val
));
1821 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1822 error ("Invalid OTF GPOS feature: %s",
1823 SDATA (SYMBOL_NAME (XCAR (val
))));
1830 Lisp_Object otf_list
;
1833 otf_tag_symbol (OTF_Tag tag
)
1837 OTF_tag_name (tag
, name
);
1838 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1842 otf_open (Lisp_Object file
)
1844 Lisp_Object val
= Fassoc (file
, otf_list
);
1848 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1851 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1852 val
= make_save_value (otf
, 0);
1853 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1859 /* Return a list describing which scripts/languages FONT supports by
1860 which GSUB/GPOS features of OpenType tables. See the comment of
1861 (struct font_driver).otf_capability. */
1864 font_otf_capability (struct font
*font
)
1867 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1870 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1873 for (i
= 0; i
< 2; i
++)
1875 OTF_GSUB_GPOS
*gsub_gpos
;
1876 Lisp_Object script_list
= Qnil
;
1879 if (OTF_get_features (otf
, i
== 0) < 0)
1881 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1882 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1884 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1885 Lisp_Object langsys_list
= Qnil
;
1886 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1889 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1891 OTF_LangSys
*langsys
;
1892 Lisp_Object feature_list
= Qnil
;
1893 Lisp_Object langsys_tag
;
1896 if (k
== script
->LangSysCount
)
1898 langsys
= &script
->DefaultLangSys
;
1903 langsys
= script
->LangSys
+ k
;
1905 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1907 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1909 OTF_Feature
*feature
1910 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1911 Lisp_Object feature_tag
1912 = otf_tag_symbol (feature
->FeatureTag
);
1914 feature_list
= Fcons (feature_tag
, feature_list
);
1916 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1919 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1924 XSETCAR (capability
, script_list
);
1926 XSETCDR (capability
, script_list
);
1932 /* Parse OTF features in SPEC and write a proper features spec string
1933 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1934 assured that the sufficient memory has already allocated for
1938 generate_otf_features (Lisp_Object spec
, char *features
)
1946 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1952 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1957 else if (! asterisk
)
1959 val
= SYMBOL_NAME (val
);
1960 p
+= esprintf (p
, "%s", SDATA (val
));
1964 val
= SYMBOL_NAME (val
);
1965 p
+= esprintf (p
, "~%s", SDATA (val
));
1969 error ("OTF spec too long");
1973 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1975 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1977 return Fcons (make_number (len
),
1978 make_unibyte_string (device_table
->DeltaValue
, len
));
1982 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
1984 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1986 if (value_format
& OTF_XPlacement
)
1987 ASET (val
, 0, make_number (value_record
->XPlacement
));
1988 if (value_format
& OTF_YPlacement
)
1989 ASET (val
, 1, make_number (value_record
->YPlacement
));
1990 if (value_format
& OTF_XAdvance
)
1991 ASET (val
, 2, make_number (value_record
->XAdvance
));
1992 if (value_format
& OTF_YAdvance
)
1993 ASET (val
, 3, make_number (value_record
->YAdvance
));
1994 if (value_format
& OTF_XPlaDevice
)
1995 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1996 if (value_format
& OTF_YPlaDevice
)
1997 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1998 if (value_format
& OTF_XAdvDevice
)
1999 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2000 if (value_format
& OTF_YAdvDevice
)
2001 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2006 font_otf_Anchor (OTF_Anchor
*anchor
)
2010 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2011 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2012 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2013 if (anchor
->AnchorFormat
== 2)
2014 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2017 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2018 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2022 #endif /* HAVE_LIBOTF */
2028 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2029 static int font_compare (const void *, const void *);
2030 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2034 font_rescale_ratio (Lisp_Object font_entity
)
2036 Lisp_Object tail
, elt
;
2037 Lisp_Object name
= Qnil
;
2039 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2042 if (FLOATP (XCDR (elt
)))
2044 if (STRINGP (XCAR (elt
)))
2047 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2048 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2049 return XFLOAT_DATA (XCDR (elt
));
2051 else if (FONT_SPEC_P (XCAR (elt
)))
2053 if (font_match_p (XCAR (elt
), font_entity
))
2054 return XFLOAT_DATA (XCDR (elt
));
2061 /* We sort fonts by scoring each of them against a specified
2062 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2063 the value is, the closer the font is to the font-spec.
2065 The lowest 2 bits of the score are used for driver type. The font
2066 available by the most preferred font driver is 0.
2068 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2069 WEIGHT, SLANT, WIDTH, and SIZE. */
2071 /* How many bits to shift to store the difference value of each font
2072 property in a score. Note that floats for FONT_TYPE_INDEX and
2073 FONT_REGISTRY_INDEX are not used. */
2074 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2076 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2077 The return value indicates how different ENTITY is compared with
2081 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2086 /* Score three style numeric fields. Maximum difference is 127. */
2087 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2088 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2090 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2091 - (XINT (spec_prop
[i
]) >> 8));
2094 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2097 /* Score the size. Maximum difference is 127. */
2098 i
= FONT_SIZE_INDEX
;
2099 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2100 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2102 /* We use the higher 6-bit for the actual size difference. The
2103 lowest bit is set if the DPI is different. */
2105 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2107 if (CONSP (Vface_font_rescale_alist
))
2108 pixel_size
*= font_rescale_ratio (entity
);
2109 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2113 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2114 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2116 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2117 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2119 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2126 /* Concatenate all elements of LIST into one vector. LIST is a list
2127 of font-entity vectors. */
2130 font_vconcat_entity_vectors (Lisp_Object list
)
2132 int nargs
= XINT (Flength (list
));
2133 Lisp_Object
*args
= alloca (word_size
* nargs
);
2136 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2137 args
[i
] = XCAR (list
);
2138 return Fvconcat (nargs
, args
);
2142 /* The structure for elements being sorted by qsort. */
2143 struct font_sort_data
2146 int font_driver_preference
;
2151 /* The comparison function for qsort. */
2154 font_compare (const void *d1
, const void *d2
)
2156 const struct font_sort_data
*data1
= d1
;
2157 const struct font_sort_data
*data2
= d2
;
2159 if (data1
->score
< data2
->score
)
2161 else if (data1
->score
> data2
->score
)
2163 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2167 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2168 If PREFER specifies a point-size, calculate the corresponding
2169 pixel-size from QCdpi property of PREFER or from the Y-resolution
2170 of FRAME before sorting.
2172 If BEST-ONLY is nonzero, return the best matching entity (that
2173 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2174 if BEST-ONLY is negative). Otherwise, return the sorted result as
2175 a single vector of font-entities.
2177 This function does no optimization for the case that the total
2178 number of elements is 1. The caller should avoid calling this in
2182 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2184 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2186 struct font_sort_data
*data
;
2187 unsigned best_score
;
2188 Lisp_Object best_entity
;
2189 struct frame
*f
= XFRAME (frame
);
2190 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2193 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2194 prefer_prop
[i
] = AREF (prefer
, i
);
2195 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2196 prefer_prop
[FONT_SIZE_INDEX
]
2197 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2199 if (NILP (XCDR (list
)))
2201 /* What we have to take care of is this single vector. */
2203 maxlen
= ASIZE (vec
);
2207 /* We don't have to perform sort, so there's no need of creating
2208 a single vector. But, we must find the length of the longest
2211 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2212 if (maxlen
< ASIZE (XCAR (tail
)))
2213 maxlen
= ASIZE (XCAR (tail
));
2217 /* We have to create a single vector to sort it. */
2218 vec
= font_vconcat_entity_vectors (list
);
2219 maxlen
= ASIZE (vec
);
2222 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2223 best_score
= 0xFFFFFFFF;
2226 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2228 int font_driver_preference
= 0;
2229 Lisp_Object current_font_driver
;
2235 /* We are sure that the length of VEC > 0. */
2236 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2237 /* Score the elements. */
2238 for (i
= 0; i
< len
; i
++)
2240 data
[i
].entity
= AREF (vec
, i
);
2242 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2244 ? font_score (data
[i
].entity
, prefer_prop
)
2246 if (best_only
&& best_score
> data
[i
].score
)
2248 best_score
= data
[i
].score
;
2249 best_entity
= data
[i
].entity
;
2250 if (best_score
== 0)
2253 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2255 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2256 font_driver_preference
++;
2258 data
[i
].font_driver_preference
= font_driver_preference
;
2261 /* Sort if necessary. */
2264 qsort (data
, len
, sizeof *data
, font_compare
);
2265 for (i
= 0; i
< len
; i
++)
2266 ASET (vec
, i
, data
[i
].entity
);
2275 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2280 /* API of Font Service Layer. */
2282 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2283 sort_shift_bits. Finternal_set_font_selection_order calls this
2284 function with font_sort_order after setting up it. */
2287 font_update_sort_order (int *order
)
2291 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2293 int xlfd_idx
= order
[i
];
2295 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2296 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2297 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2298 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2299 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2300 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2302 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2307 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2308 Lisp_Object features
, Lisp_Object table
)
2313 table
= assq_no_quit (script
, table
);
2316 table
= XCDR (table
);
2317 if (! NILP (langsys
))
2319 table
= assq_no_quit (langsys
, table
);
2325 val
= assq_no_quit (Qnil
, table
);
2327 table
= XCAR (table
);
2331 table
= XCDR (table
);
2332 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2334 if (NILP (XCAR (features
)))
2339 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2345 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2348 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2350 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2352 script
= XCAR (spec
);
2356 langsys
= XCAR (spec
);
2367 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2368 XCAR (otf_capability
)))
2370 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2371 XCDR (otf_capability
)))
2378 /* Check if FONT (font-entity or font-object) matches with the font
2379 specification SPEC. */
2382 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2384 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2385 Lisp_Object extra
, font_extra
;
2388 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2389 if (! NILP (AREF (spec
, i
))
2390 && ! NILP (AREF (font
, i
))
2391 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2393 props
= XFONT_SPEC (spec
)->props
;
2394 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2396 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2397 prop
[i
] = AREF (spec
, i
);
2398 prop
[FONT_SIZE_INDEX
]
2399 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2403 if (font_score (font
, props
) > 0)
2405 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2406 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2407 for (; CONSP (extra
); extra
= XCDR (extra
))
2409 Lisp_Object key
= XCAR (XCAR (extra
));
2410 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2412 if (EQ (key
, QClang
))
2414 val2
= assq_no_quit (key
, font_extra
);
2423 if (NILP (Fmemq (val
, val2
)))
2428 ? NILP (Fmemq (val
, XCDR (val2
)))
2432 else if (EQ (key
, QCscript
))
2434 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2440 /* All characters in the list must be supported. */
2441 for (; CONSP (val2
); val2
= XCDR (val2
))
2443 if (! CHARACTERP (XCAR (val2
)))
2445 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2446 == FONT_INVALID_CODE
)
2450 else if (VECTORP (val2
))
2452 /* At most one character in the vector must be supported. */
2453 for (i
= 0; i
< ASIZE (val2
); i
++)
2455 if (! CHARACTERP (AREF (val2
, i
)))
2457 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2458 != FONT_INVALID_CODE
)
2461 if (i
== ASIZE (val2
))
2466 else if (EQ (key
, QCotf
))
2470 if (! FONT_OBJECT_P (font
))
2472 fontp
= XFONT_OBJECT (font
);
2473 if (! fontp
->driver
->otf_capability
)
2475 val2
= fontp
->driver
->otf_capability (fontp
);
2476 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2487 Each font backend has the callback function get_cache, and it
2488 returns a cons cell of which cdr part can be freely used for
2489 caching fonts. The cons cell may be shared by multiple frames
2490 and/or multiple font drivers. So, we arrange the cdr part as this:
2492 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2494 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2495 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2496 cons (FONT-SPEC FONT-ENTITY ...). */
2498 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2499 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2500 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2501 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2502 struct font_driver
*);
2505 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2507 Lisp_Object cache
, val
;
2509 cache
= driver
->get_cache (f
);
2511 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2515 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2516 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2520 val
= XCDR (XCAR (val
));
2521 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2527 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2529 Lisp_Object cache
, val
, tmp
;
2532 cache
= driver
->get_cache (f
);
2534 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2535 cache
= val
, val
= XCDR (val
);
2536 eassert (! NILP (val
));
2537 tmp
= XCDR (XCAR (val
));
2538 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2539 if (XINT (XCAR (tmp
)) == 0)
2541 font_clear_cache (f
, XCAR (val
), driver
);
2542 XSETCDR (cache
, XCDR (val
));
2548 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2550 Lisp_Object val
= driver
->get_cache (f
);
2551 Lisp_Object type
= driver
->type
;
2553 eassert (CONSP (val
));
2554 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2555 eassert (CONSP (val
));
2556 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2557 val
= XCDR (XCAR (val
));
2561 static int num_fonts
;
2564 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2566 Lisp_Object tail
, elt
;
2567 Lisp_Object tail2
, entity
;
2569 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2570 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2573 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2574 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2576 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2578 entity
= XCAR (tail2
);
2580 if (FONT_ENTITY_P (entity
)
2581 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2583 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2585 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2587 Lisp_Object val
= XCAR (objlist
);
2588 struct font
*font
= XFONT_OBJECT (val
);
2590 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2592 eassert (font
&& driver
== font
->driver
);
2593 driver
->close (f
, font
);
2597 if (driver
->free_entity
)
2598 driver
->free_entity (entity
);
2603 XSETCDR (cache
, Qnil
);
2607 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2609 /* Check each font-entity in VEC, and return a list of font-entities
2610 that satisfy these conditions:
2611 (1) matches with SPEC and SIZE if SPEC is not nil, and
2612 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2616 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2618 Lisp_Object entity
, val
;
2619 enum font_property_index prop
;
2622 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2624 entity
= AREF (vec
, i
);
2625 if (! NILP (Vface_ignored_fonts
))
2629 Lisp_Object tail
, regexp
;
2631 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2634 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2636 regexp
= XCAR (tail
);
2637 if (STRINGP (regexp
)
2638 && fast_c_string_match_ignore_case (regexp
, name
,
2648 val
= Fcons (entity
, val
);
2651 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2652 if (INTEGERP (AREF (spec
, prop
))
2653 && ((XINT (AREF (spec
, prop
)) >> 8)
2654 != (XINT (AREF (entity
, prop
)) >> 8)))
2655 prop
= FONT_SPEC_MAX
;
2656 if (prop
< FONT_SPEC_MAX
2658 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2660 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2663 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2664 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2665 prop
= FONT_SPEC_MAX
;
2667 if (prop
< FONT_SPEC_MAX
2668 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2669 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2670 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2671 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2672 prop
= FONT_SPEC_MAX
;
2673 if (prop
< FONT_SPEC_MAX
2674 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2675 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2676 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2677 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2678 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2679 prop
= FONT_SPEC_MAX
;
2680 if (prop
< FONT_SPEC_MAX
)
2681 val
= Fcons (entity
, val
);
2683 return (Fvconcat (1, &val
));
2687 /* Return a list of vectors of font-entities matching with SPEC on
2688 FRAME. Each elements in the list is a vector of entities from the
2689 same font-driver. */
2692 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2694 FRAME_PTR f
= XFRAME (frame
);
2695 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2696 Lisp_Object ftype
, val
;
2697 Lisp_Object list
= Qnil
;
2699 bool need_filtering
= 0;
2702 eassert (FONT_SPEC_P (spec
));
2704 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2705 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2706 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2707 size
= font_pixel_size (f
, spec
);
2711 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2712 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2713 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2714 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2715 if (i
!= FONT_SPACING_INDEX
)
2717 ASET (scratch_font_spec
, i
, Qnil
);
2718 if (! NILP (AREF (spec
, i
)))
2721 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2722 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2724 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2726 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2728 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2730 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2731 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2738 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2742 val
= Fvconcat (1, &val
);
2743 copy
= copy_font_spec (scratch_font_spec
);
2744 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2745 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2749 || ! NILP (Vface_ignored_fonts
)))
2750 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2751 if (ASIZE (val
) > 0)
2752 list
= Fcons (val
, list
);
2755 list
= Fnreverse (list
);
2756 FONT_ADD_LOG ("list", spec
, list
);
2761 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2762 nil, is an array of face's attributes, which specifies preferred
2763 font-related attributes. */
2766 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2768 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2769 Lisp_Object ftype
, size
, entity
;
2771 Lisp_Object work
= copy_font_spec (spec
);
2773 XSETFRAME (frame
, f
);
2774 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2775 size
= AREF (spec
, FONT_SIZE_INDEX
);
2778 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2779 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2780 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2781 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2784 for (; driver_list
; driver_list
= driver_list
->next
)
2786 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2788 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2791 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2792 entity
= assoc_no_quit (work
, XCDR (cache
));
2794 entity
= XCDR (entity
);
2797 entity
= driver_list
->driver
->match (frame
, work
);
2798 copy
= copy_font_spec (work
);
2799 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2800 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2802 if (! NILP (entity
))
2805 FONT_ADD_LOG ("match", work
, entity
);
2810 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2811 opened font object. */
2814 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2816 struct font_driver_list
*driver_list
;
2817 Lisp_Object objlist
, size
, val
, font_object
;
2819 int min_width
, height
;
2820 int scaled_pixel_size
= pixel_size
;
2822 eassert (FONT_ENTITY_P (entity
));
2823 size
= AREF (entity
, FONT_SIZE_INDEX
);
2824 if (XINT (size
) != 0)
2825 scaled_pixel_size
= pixel_size
= XINT (size
);
2826 else if (CONSP (Vface_font_rescale_alist
))
2827 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2829 val
= AREF (entity
, FONT_TYPE_INDEX
);
2830 for (driver_list
= f
->font_driver_list
;
2831 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2832 driver_list
= driver_list
->next
);
2836 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2837 objlist
= XCDR (objlist
))
2839 Lisp_Object fn
= XCAR (objlist
);
2840 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2841 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2843 if (driver_list
->driver
->cached_font_ok
== NULL
2844 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2849 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2850 if (!NILP (font_object
))
2851 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2852 FONT_ADD_LOG ("open", entity
, font_object
);
2853 if (NILP (font_object
))
2855 ASET (entity
, FONT_OBJLIST_INDEX
,
2856 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2859 font
= XFONT_OBJECT (font_object
);
2860 min_width
= (font
->min_width
? font
->min_width
2861 : font
->average_width
? font
->average_width
2862 : font
->space_width
? font
->space_width
2864 height
= (font
->height
? font
->height
: 1);
2865 #ifdef HAVE_WINDOW_SYSTEM
2866 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2867 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2869 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2870 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2871 fonts_changed_p
= 1;
2875 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2876 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2877 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2878 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2886 /* Close FONT_OBJECT that is opened on frame F. */
2889 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2891 struct font
*font
= XFONT_OBJECT (font_object
);
2893 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2894 /* Already closed. */
2896 FONT_ADD_LOG ("close", font_object
, Qnil
);
2897 font
->driver
->close (f
, font
);
2898 #ifdef HAVE_WINDOW_SYSTEM
2899 eassert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2900 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2906 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2907 FONT is a font-entity and it must be opened to check. */
2910 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2914 if (FONT_ENTITY_P (font
))
2916 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2917 struct font_driver_list
*driver_list
;
2919 for (driver_list
= f
->font_driver_list
;
2920 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2921 driver_list
= driver_list
->next
);
2924 if (! driver_list
->driver
->has_char
)
2926 return driver_list
->driver
->has_char (font
, c
);
2929 eassert (FONT_OBJECT_P (font
));
2930 fontp
= XFONT_OBJECT (font
);
2931 if (fontp
->driver
->has_char
)
2933 int result
= fontp
->driver
->has_char (font
, c
);
2938 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2942 /* Return the glyph ID of FONT_OBJECT for character C. */
2945 font_encode_char (Lisp_Object font_object
, int c
)
2949 eassert (FONT_OBJECT_P (font_object
));
2950 font
= XFONT_OBJECT (font_object
);
2951 return font
->driver
->encode_char (font
, c
);
2955 /* Return the name of FONT_OBJECT. */
2958 font_get_name (Lisp_Object font_object
)
2960 eassert (FONT_OBJECT_P (font_object
));
2961 return AREF (font_object
, FONT_NAME_INDEX
);
2965 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2966 could not be parsed by font_parse_name, return Qnil. */
2969 font_spec_from_name (Lisp_Object font_name
)
2971 Lisp_Object spec
= Ffont_spec (0, NULL
);
2973 CHECK_STRING (font_name
);
2974 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2976 font_put_extra (spec
, QCname
, font_name
);
2977 font_put_extra (spec
, QCuser_spec
, font_name
);
2983 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2985 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2990 if (! NILP (Ffont_get (font
, QCname
)))
2992 font
= copy_font_spec (font
);
2993 font_put_extra (font
, QCname
, Qnil
);
2996 if (NILP (AREF (font
, prop
))
2997 && prop
!= FONT_FAMILY_INDEX
2998 && prop
!= FONT_FOUNDRY_INDEX
2999 && prop
!= FONT_WIDTH_INDEX
3000 && prop
!= FONT_SIZE_INDEX
)
3002 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3003 font
= copy_font_spec (font
);
3004 ASET (font
, prop
, Qnil
);
3005 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3007 if (prop
== FONT_FAMILY_INDEX
)
3009 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3010 /* If we are setting the font family, we must also clear
3011 FONT_WIDTH_INDEX to avoid rejecting families that lack
3012 support for some widths. */
3013 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3015 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3016 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3017 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3018 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3019 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3020 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3022 else if (prop
== FONT_SIZE_INDEX
)
3024 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3025 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3026 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3028 else if (prop
== FONT_WIDTH_INDEX
)
3029 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3030 attrs
[LFACE_FONT_INDEX
] = font
;
3033 /* Select a font from ENTITIES (list of font-entity vectors) that
3034 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3037 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3039 Lisp_Object font_entity
;
3042 FRAME_PTR f
= XFRAME (frame
);
3044 if (NILP (XCDR (entities
))
3045 && ASIZE (XCAR (entities
)) == 1)
3047 font_entity
= AREF (XCAR (entities
), 0);
3048 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3053 /* Sort fonts by properties specified in ATTRS. */
3054 prefer
= scratch_font_prefer
;
3056 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3057 ASET (prefer
, i
, Qnil
);
3058 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3060 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3062 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3063 ASET (prefer
, i
, AREF (face_font
, i
));
3065 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3066 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3067 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3068 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3069 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3070 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3071 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3073 return font_sort_entities (entities
, prefer
, frame
, c
);
3076 /* Return a font-entity that satisfies SPEC and is the best match for
3077 face's font related attributes in ATTRS. C, if not negative, is a
3078 character that the entity must support. */
3081 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3084 Lisp_Object frame
, entities
, val
;
3085 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3090 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3091 if (NILP (registry
[0]))
3093 registry
[0] = DEFAULT_ENCODING
;
3094 registry
[1] = Qascii_0
;
3095 registry
[2] = zero_vector
;
3098 registry
[1] = zero_vector
;
3100 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3102 struct charset
*encoding
, *repertory
;
3104 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3105 &encoding
, &repertory
) < 0)
3108 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3110 else if (c
> encoding
->max_char
)
3114 work
= copy_font_spec (spec
);
3115 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3116 XSETFRAME (frame
, f
);
3117 pixel_size
= font_pixel_size (f
, spec
);
3118 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3120 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3122 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3124 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3125 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3126 if (! NILP (foundry
[0]))
3127 foundry
[1] = zero_vector
;
3128 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3130 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3131 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3133 foundry
[2] = zero_vector
;
3136 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3138 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3139 if (! NILP (adstyle
[0]))
3140 adstyle
[1] = zero_vector
;
3141 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3143 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3145 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3147 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3149 adstyle
[2] = zero_vector
;
3152 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3155 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3158 val
= AREF (work
, FONT_FAMILY_INDEX
);
3159 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3161 val
= attrs
[LFACE_FAMILY_INDEX
];
3162 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3166 family
= alloca ((sizeof family
[0]) * 2);
3168 family
[1] = zero_vector
; /* terminator. */
3173 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3175 if (! NILP (alters
))
3177 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3178 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3179 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3180 family
[i
] = XCAR (alters
);
3181 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3183 family
[i
] = zero_vector
;
3187 family
= alloca ((sizeof family
[0]) * 3);
3190 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3192 family
[i
] = zero_vector
;
3196 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3198 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3199 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3201 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3202 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3204 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3205 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3207 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3208 entities
= font_list_entities (frame
, work
);
3209 if (! NILP (entities
))
3211 val
= font_select_entity (frame
, entities
,
3212 attrs
, pixel_size
, c
);
3227 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3231 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3232 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3233 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3234 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3235 size
= font_pixel_size (f
, spec
);
3239 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3240 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3243 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3244 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3245 eassert (INTEGERP (height
));
3250 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3254 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3255 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3259 return font_open_entity (f
, entity
, size
);
3263 /* Find a font that satisfies SPEC and is the best match for
3264 face's attributes in ATTRS on FRAME, and return the opened
3268 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3270 Lisp_Object entity
, name
;
3272 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3275 /* No font is listed for SPEC, but each font-backend may have
3276 different criteria about "font matching". So, try it. */
3277 entity
= font_matching_entity (f
, attrs
, spec
);
3281 /* Don't lose the original name that was put in initially. We need
3282 it to re-apply the font when font parameters (like hinting or dpi) have
3284 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3287 name
= Ffont_get (spec
, QCuser_spec
);
3288 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3294 /* Make FACE on frame F ready to use the font opened for FACE. */
3297 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3299 if (face
->font
->driver
->prepare_face
)
3300 face
->font
->driver
->prepare_face (f
, face
);
3304 /* Make FACE on frame F stop using the font opened for FACE. */
3307 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3309 if (face
->font
->driver
->done_face
)
3310 face
->font
->driver
->done_face (f
, face
);
3315 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3316 font is found, return Qnil. */
3319 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3321 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3323 /* We set up the default font-related attributes of a face to prefer
3325 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3326 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3327 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3329 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3331 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3333 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3335 return font_load_for_lface (f
, attrs
, spec
);
3339 /* Open a font that matches NAME on frame F. If no proper font is
3340 found, return Qnil. */
3343 font_open_by_name (FRAME_PTR f
, Lisp_Object name
)
3345 Lisp_Object args
[2];
3346 Lisp_Object spec
, ret
;
3350 spec
= Ffont_spec (2, args
);
3351 ret
= font_open_by_spec (f
, spec
);
3352 /* Do not lose name originally put in. */
3354 font_put_extra (ret
, QCuser_spec
, args
[1]);
3360 /* Register font-driver DRIVER. This function is used in two ways.
3362 The first is with frame F non-NULL. In this case, make DRIVER
3363 available (but not yet activated) on F. All frame creators
3364 (e.g. Fx_create_frame) must call this function at least once with
3365 an available font-driver.
3367 The second is with frame F NULL. In this case, DRIVER is globally
3368 registered in the variable `font_driver_list'. All font-driver
3369 implementations must call this function in its syms_of_XXXX
3370 (e.g. syms_of_xfont). */
3373 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3375 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3376 struct font_driver_list
*prev
, *list
;
3378 if (f
&& ! driver
->draw
)
3379 error ("Unusable font driver for a frame: %s",
3380 SDATA (SYMBOL_NAME (driver
->type
)));
3382 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3383 if (EQ (list
->driver
->type
, driver
->type
))
3384 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3386 list
= xmalloc (sizeof *list
);
3388 list
->driver
= driver
;
3393 f
->font_driver_list
= list
;
3395 font_driver_list
= list
;
3401 free_font_driver_list (FRAME_PTR f
)
3403 struct font_driver_list
*list
, *next
;
3405 for (list
= f
->font_driver_list
; list
; list
= next
)
3410 f
->font_driver_list
= NULL
;
3414 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3415 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3416 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3418 A caller must free all realized faces if any in advance. The
3419 return value is a list of font backends actually made used on
3423 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3425 Lisp_Object active_drivers
= Qnil
;
3426 struct font_driver_list
*list
;
3428 /* At first, turn off non-requested drivers, and turn on requested
3430 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3432 struct font_driver
*driver
= list
->driver
;
3433 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3438 if (driver
->end_for_frame
)
3439 driver
->end_for_frame (f
);
3440 font_finish_cache (f
, driver
);
3445 if (! driver
->start_for_frame
3446 || driver
->start_for_frame (f
) == 0)
3448 font_prepare_cache (f
, driver
);
3455 if (NILP (new_drivers
))
3458 if (! EQ (new_drivers
, Qt
))
3460 /* Re-order the driver list according to new_drivers. */
3461 struct font_driver_list
**list_table
, **next
;
3465 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3466 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3468 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3469 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3472 list_table
[i
++] = list
;
3474 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3476 list_table
[i
++] = list
;
3477 list_table
[i
] = NULL
;
3479 next
= &f
->font_driver_list
;
3480 for (i
= 0; list_table
[i
]; i
++)
3482 *next
= list_table
[i
];
3483 next
= &(*next
)->next
;
3487 if (! f
->font_driver_list
->on
)
3488 { /* None of the drivers is enabled: enable them all.
3489 Happens if you set the list of drivers to (xft x) in your .emacs
3490 and then use it under w32 or ns. */
3491 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3493 struct font_driver
*driver
= list
->driver
;
3494 eassert (! list
->on
);
3495 if (! driver
->start_for_frame
3496 || driver
->start_for_frame (f
) == 0)
3498 font_prepare_cache (f
, driver
);
3505 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3507 active_drivers
= nconc2 (active_drivers
,
3508 Fcons (list
->driver
->type
, Qnil
));
3509 return active_drivers
;
3513 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3515 struct font_data_list
*list
, *prev
;
3517 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3518 prev
= list
, list
= list
->next
)
3519 if (list
->driver
== driver
)
3526 prev
->next
= list
->next
;
3528 f
->font_data_list
= list
->next
;
3536 list
= xmalloc (sizeof *list
);
3537 list
->driver
= driver
;
3538 list
->next
= f
->font_data_list
;
3539 f
->font_data_list
= list
;
3547 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3549 struct font_data_list
*list
;
3551 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3552 if (list
->driver
== driver
)
3560 /* Sets attributes on a font. Any properties that appear in ALIST and
3561 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3562 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3563 arrays of strings. This function is intended for use by the font
3564 drivers to implement their specific font_filter_properties. */
3566 font_filter_properties (Lisp_Object font
,
3568 const char *const boolean_properties
[],
3569 const char *const non_boolean_properties
[])
3574 /* Set boolean values to Qt or Qnil */
3575 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3576 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3578 Lisp_Object key
= XCAR (XCAR (it
));
3579 Lisp_Object val
= XCDR (XCAR (it
));
3580 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3582 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3584 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3585 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3588 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3589 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3590 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3591 || strcmp ("Off", str
) == 0)
3596 Ffont_put (font
, key
, val
);
3600 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3601 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3603 Lisp_Object key
= XCAR (XCAR (it
));
3604 Lisp_Object val
= XCDR (XCAR (it
));
3605 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3606 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3607 Ffont_put (font
, key
, val
);
3612 /* Return the font used to draw character C by FACE at buffer position
3613 POS in window W. If STRING is non-nil, it is a string containing C
3614 at index POS. If C is negative, get C from the current buffer or
3618 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3623 Lisp_Object font_object
;
3625 multibyte
= (NILP (string
)
3626 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3627 : STRING_MULTIBYTE (string
));
3634 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3636 c
= FETCH_CHAR (pos_byte
);
3639 c
= FETCH_BYTE (pos
);
3645 multibyte
= STRING_MULTIBYTE (string
);
3648 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3650 str
= SDATA (string
) + pos_byte
;
3651 c
= STRING_CHAR (str
);
3654 c
= SDATA (string
)[pos
];
3658 f
= XFRAME (w
->frame
);
3659 if (! FRAME_WINDOW_P (f
))
3666 if (STRINGP (string
))
3667 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3668 DEFAULT_FACE_ID
, 0);
3670 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3672 face
= FACE_FROM_ID (f
, face_id
);
3676 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3677 face
= FACE_FROM_ID (f
, face_id
);
3682 XSETFONT (font_object
, face
->font
);
3687 #ifdef HAVE_WINDOW_SYSTEM
3689 /* Check how many characters after POS (at most to *LIMIT) can be
3690 displayed by the same font in the window W. FACE, if non-NULL, is
3691 the face selected for the character at POS. If STRING is not nil,
3692 it is the string to check instead of the current buffer. In that
3693 case, FACE must be not NULL.
3695 The return value is the font-object for the character at POS.
3696 *LIMIT is set to the position where that font can't be used.
3698 It is assured that the current buffer (or STRING) is multibyte. */
3701 font_range (ptrdiff_t pos
, ptrdiff_t *limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3703 ptrdiff_t pos_byte
, ignore
;
3705 Lisp_Object font_object
= Qnil
;
3709 pos_byte
= CHAR_TO_BYTE (pos
);
3714 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3716 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3722 pos_byte
= string_char_to_byte (string
, pos
);
3725 while (pos
< *limit
)
3727 Lisp_Object category
;
3730 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3732 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3733 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3734 if (INTEGERP (category
)
3735 && (XINT (category
) == UNICODE_CATEGORY_Cf
3736 || CHAR_VARIATION_SELECTOR_P (c
)))
3738 if (NILP (font_object
))
3740 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3741 if (NILP (font_object
))
3745 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3755 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3756 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3757 Return nil otherwise.
3758 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3759 which kind of font it is. It must be one of `font-spec', `font-entity',
3761 (Lisp_Object object
, Lisp_Object extra_type
)
3763 if (NILP (extra_type
))
3764 return (FONTP (object
) ? Qt
: Qnil
);
3765 if (EQ (extra_type
, Qfont_spec
))
3766 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3767 if (EQ (extra_type
, Qfont_entity
))
3768 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3769 if (EQ (extra_type
, Qfont_object
))
3770 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3771 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3774 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3775 doc
: /* Return a newly created font-spec with arguments as properties.
3777 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3778 valid font property name listed below:
3780 `:family', `:weight', `:slant', `:width'
3782 They are the same as face attributes of the same name. See
3783 `set-face-attribute'.
3787 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3791 VALUE must be a string or a symbol specifying the additional
3792 typographic style information of a font, e.g. ``sans''.
3796 VALUE must be a string or a symbol specifying the charset registry and
3797 encoding of a font, e.g. ``iso8859-1''.
3801 VALUE must be a non-negative integer or a floating point number
3802 specifying the font size. It specifies the font size in pixels (if
3803 VALUE is an integer), or in points (if VALUE is a float).
3807 VALUE must be a string of XLFD-style or fontconfig-style font name.
3811 VALUE must be a symbol representing a script that the font must
3812 support. It may be a symbol representing a subgroup of a script
3813 listed in the variable `script-representative-chars'.
3817 VALUE must be a symbol of two-letter ISO-639 language names,
3822 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3823 required OpenType features.
3825 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3826 LANGSYS-TAG: OpenType language system tag symbol,
3827 or nil for the default language system.
3828 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3829 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3831 GSUB and GPOS may contain `nil' element. In such a case, the font
3832 must not have any of the remaining elements.
3834 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3835 be an OpenType font whose GPOS table of `thai' script's default
3836 language system must contain `mark' feature.
3838 usage: (font-spec ARGS...) */)
3839 (ptrdiff_t nargs
, Lisp_Object
*args
)
3841 Lisp_Object spec
= font_make_spec ();
3844 for (i
= 0; i
< nargs
; i
+= 2)
3846 Lisp_Object key
= args
[i
], val
;
3850 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3853 if (EQ (key
, QCname
))
3856 font_parse_name (SSDATA (val
), SBYTES (val
), spec
);
3857 font_put_extra (spec
, key
, val
);
3861 int idx
= get_font_prop_index (key
);
3865 val
= font_prop_validate (idx
, Qnil
, val
);
3866 if (idx
< FONT_EXTRA_INDEX
)
3867 ASET (spec
, idx
, val
);
3869 font_put_extra (spec
, key
, val
);
3872 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3878 /* Return a copy of FONT as a font-spec. */
3880 copy_font_spec (Lisp_Object font
)
3882 Lisp_Object new_spec
, tail
, prev
, extra
;
3886 new_spec
= font_make_spec ();
3887 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3888 ASET (new_spec
, i
, AREF (font
, i
));
3889 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3890 /* We must remove :font-entity property. */
3891 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3892 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3895 extra
= XCDR (extra
);
3897 XSETCDR (prev
, XCDR (tail
));
3900 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3904 /* Merge font-specs FROM and TO, and return a new font-spec.
3905 Every specified property in FROM overrides the corresponding
3908 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3910 Lisp_Object extra
, tail
;
3915 to
= copy_font_spec (to
);
3916 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3917 ASET (to
, i
, AREF (from
, i
));
3918 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3919 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3920 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3922 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3925 XSETCDR (slot
, XCDR (XCAR (tail
)));
3927 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3929 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3933 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3934 doc
: /* Return the value of FONT's property KEY.
3935 FONT is a font-spec, a font-entity, or a font-object.
3936 KEY is any symbol, but these are reserved for specific meanings:
3937 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3938 :size, :name, :script, :otf
3939 See the documentation of `font-spec' for their meanings.
3940 In addition, if FONT is a font-entity or a font-object, values of
3941 :script and :otf are different from those of a font-spec as below:
3943 The value of :script may be a list of scripts that are supported by the font.
3945 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3946 representing the OpenType features supported by the font by this form:
3947 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3948 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3950 (Lisp_Object font
, Lisp_Object key
)
3958 idx
= get_font_prop_index (key
);
3959 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3960 return font_style_symbolic (font
, idx
, 0);
3961 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3962 return AREF (font
, idx
);
3963 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3964 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3966 struct font
*fontp
= XFONT_OBJECT (font
);
3968 if (fontp
->driver
->otf_capability
)
3969 val
= fontp
->driver
->otf_capability (fontp
);
3971 val
= Fcons (Qnil
, Qnil
);
3978 #ifdef HAVE_WINDOW_SYSTEM
3980 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3981 doc
: /* Return a plist of face attributes generated by FONT.
3982 FONT is a font name, a font-spec, a font-entity, or a font-object.
3983 The return value is a list of the form
3985 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3987 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3988 compatible with `set-face-attribute'. Some of these key-attribute pairs
3989 may be omitted from the list if they are not specified by FONT.
3991 The optional argument FRAME specifies the frame that the face attributes
3992 are to be displayed on. If omitted, the selected frame is used. */)
3993 (Lisp_Object font
, Lisp_Object frame
)
3996 Lisp_Object plist
[10];
4001 frame
= selected_frame
;
4002 CHECK_LIVE_FRAME (frame
);
4007 int fontset
= fs_query_fontset (font
, 0);
4008 Lisp_Object name
= font
;
4010 font
= fontset_ascii (fontset
);
4011 font
= font_spec_from_name (name
);
4013 signal_error ("Invalid font name", name
);
4015 else if (! FONTP (font
))
4016 signal_error ("Invalid font object", font
);
4018 val
= AREF (font
, FONT_FAMILY_INDEX
);
4021 plist
[n
++] = QCfamily
;
4022 plist
[n
++] = SYMBOL_NAME (val
);
4025 val
= AREF (font
, FONT_SIZE_INDEX
);
4028 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4029 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4030 plist
[n
++] = QCheight
;
4031 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4033 else if (FLOATP (val
))
4035 plist
[n
++] = QCheight
;
4036 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4039 val
= FONT_WEIGHT_FOR_FACE (font
);
4042 plist
[n
++] = QCweight
;
4046 val
= FONT_SLANT_FOR_FACE (font
);
4049 plist
[n
++] = QCslant
;
4053 val
= FONT_WIDTH_FOR_FACE (font
);
4056 plist
[n
++] = QCwidth
;
4060 return Flist (n
, plist
);
4065 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4066 doc
: /* Set one property of FONT: give property KEY value VAL.
4067 FONT is a font-spec, a font-entity, or a font-object.
4069 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4070 accepted by the function `font-spec' (which see), VAL must be what
4071 allowed in `font-spec'.
4073 If FONT is a font-entity or a font-object, KEY must not be the one
4074 accepted by `font-spec'. */)
4075 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4079 idx
= get_font_prop_index (prop
);
4080 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4082 CHECK_FONT_SPEC (font
);
4083 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4087 if (EQ (prop
, QCname
)
4088 || EQ (prop
, QCscript
)
4089 || EQ (prop
, QClang
)
4090 || EQ (prop
, QCotf
))
4091 CHECK_FONT_SPEC (font
);
4094 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4099 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4100 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4101 Optional 2nd argument FRAME specifies the target frame.
4102 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4103 Optional 4th argument PREFER, if non-nil, is a font-spec to
4104 control the order of the returned list. Fonts are sorted by
4105 how close they are to PREFER. */)
4106 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4108 Lisp_Object vec
, list
;
4112 frame
= selected_frame
;
4113 CHECK_LIVE_FRAME (frame
);
4114 CHECK_FONT_SPEC (font_spec
);
4122 if (! NILP (prefer
))
4123 CHECK_FONT_SPEC (prefer
);
4125 list
= font_list_entities (frame
, font_spec
);
4128 if (NILP (XCDR (list
))
4129 && ASIZE (XCAR (list
)) == 1)
4130 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4132 if (! NILP (prefer
))
4133 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4135 vec
= font_vconcat_entity_vectors (list
);
4136 if (n
== 0 || n
>= ASIZE (vec
))
4138 Lisp_Object args
[2];
4142 list
= Fappend (2, args
);
4146 for (list
= Qnil
, n
--; n
>= 0; n
--)
4147 list
= Fcons (AREF (vec
, n
), list
);
4152 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4153 doc
: /* List available font families on the current frame.
4154 Optional argument FRAME, if non-nil, specifies the target frame. */)
4158 struct font_driver_list
*driver_list
;
4162 frame
= selected_frame
;
4163 CHECK_LIVE_FRAME (frame
);
4166 for (driver_list
= f
->font_driver_list
; driver_list
;
4167 driver_list
= driver_list
->next
)
4168 if (driver_list
->driver
->list_family
)
4170 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4171 Lisp_Object tail
= list
;
4173 for (; CONSP (val
); val
= XCDR (val
))
4174 if (NILP (Fmemq (XCAR (val
), tail
))
4175 && SYMBOLP (XCAR (val
)))
4176 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4181 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4182 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4183 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4184 (Lisp_Object font_spec
, Lisp_Object frame
)
4186 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4193 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4194 doc
: /* Return XLFD name of FONT.
4195 FONT is a font-spec, font-entity, or font-object.
4196 If the name is too long for XLFD (maximum 255 chars), return nil.
4197 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4198 the consecutive wildcards are folded into one. */)
4199 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4202 int namelen
, pixel_size
= 0;
4206 if (FONT_OBJECT_P (font
))
4208 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4210 if (STRINGP (font_name
)
4211 && SDATA (font_name
)[0] == '-')
4213 if (NILP (fold_wildcards
))
4215 strcpy (name
, SSDATA (font_name
));
4216 namelen
= SBYTES (font_name
);
4219 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4221 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4225 if (! NILP (fold_wildcards
))
4227 char *p0
= name
, *p1
;
4229 while ((p1
= strstr (p0
, "-*-*")))
4231 strcpy (p1
, p1
+ 2);
4237 return make_string (name
, namelen
);
4240 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4241 doc
: /* Clear font cache. */)
4244 Lisp_Object list
, frame
;
4246 FOR_EACH_FRAME (list
, frame
)
4248 FRAME_PTR f
= XFRAME (frame
);
4249 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4251 for (; driver_list
; driver_list
= driver_list
->next
)
4252 if (driver_list
->on
)
4254 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4255 Lisp_Object val
, tmp
;
4259 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4261 eassert (! NILP (val
));
4262 tmp
= XCDR (XCAR (val
));
4263 if (XINT (XCAR (tmp
)) == 0)
4265 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4266 XSETCDR (cache
, XCDR (val
));
4276 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4278 struct font
*font
= XFONT_OBJECT (font_object
);
4279 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4280 struct font_metrics metrics
;
4282 LGLYPH_SET_CODE (glyph
, code
);
4283 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4284 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4285 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4286 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4287 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4288 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4292 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4293 doc
: /* Shape the glyph-string GSTRING.
4294 Shaping means substituting glyphs and/or adjusting positions of glyphs
4295 to get the correct visual image of character sequences set in the
4296 header of the glyph-string.
4298 If the shaping was successful, the value is GSTRING itself or a newly
4299 created glyph-string. Otherwise, the value is nil.
4301 See the documentation of `composition-get-gstring' for the format of
4303 (Lisp_Object gstring
)
4306 Lisp_Object font_object
, n
, glyph
;
4307 ptrdiff_t i
, j
, from
, to
;
4309 if (! composition_gstring_p (gstring
))
4310 signal_error ("Invalid glyph-string: ", gstring
);
4311 if (! NILP (LGSTRING_ID (gstring
)))
4313 font_object
= LGSTRING_FONT (gstring
);
4314 CHECK_FONT_OBJECT (font_object
);
4315 font
= XFONT_OBJECT (font_object
);
4316 if (! font
->driver
->shape
)
4319 /* Try at most three times with larger gstring each time. */
4320 for (i
= 0; i
< 3; i
++)
4322 n
= font
->driver
->shape (gstring
);
4325 gstring
= larger_vector (gstring
,
4326 LGSTRING_GLYPH_LEN (gstring
), -1);
4328 if (i
== 3 || XINT (n
) == 0)
4330 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4331 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4333 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4334 GLYPHS covers all characters in GSTRING. More formally, provided
4335 that NCHARS is the number of characters in GSTRING, N is the
4336 number of glyphs, and GLYPHS[i] is the ith glyph, FROM_IDX and
4337 TO_IDX of each glyph must satisfy these conditions:
4339 GLYPHS[0].FROM_IDX == 0
4340 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4341 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4342 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4343 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4345 ;; Be sure to cover all characters.
4346 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1
4347 GLYPHS[N-1].TO_IDX == NCHARS - 1 */
4348 glyph
= LGSTRING_GLYPH (gstring
, 0);
4349 from
= LGLYPH_FROM (glyph
);
4350 to
= LGLYPH_TO (glyph
);
4351 if (from
!= 0 || to
< from
)
4353 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4355 glyph
= LGSTRING_GLYPH (gstring
, i
);
4358 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4359 && (LGLYPH_FROM (glyph
) == from
4360 ? LGLYPH_TO (glyph
) == to
4361 : LGLYPH_FROM (glyph
) == to
+ 1)))
4363 from
= LGLYPH_FROM (glyph
);
4364 to
= LGLYPH_TO (glyph
);
4366 if (to
!= LGSTRING_CHAR_LEN (gstring
) - 1)
4368 return composition_gstring_put_cache (gstring
, XINT (n
));
4374 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4376 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4377 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4379 VARIATION-SELECTOR is a character code of variation selection
4380 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4381 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4382 (Lisp_Object font_object
, Lisp_Object character
)
4384 unsigned variations
[256];
4389 CHECK_FONT_OBJECT (font_object
);
4390 CHECK_CHARACTER (character
);
4391 font
= XFONT_OBJECT (font_object
);
4392 if (! font
->driver
->get_variation_glyphs
)
4394 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4398 for (i
= 0; i
< 255; i
++)
4401 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4402 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4403 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4410 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4411 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4412 OTF-FEATURES specifies which features to apply in this format:
4413 (SCRIPT LANGSYS GSUB GPOS)
4415 SCRIPT is a symbol specifying a script tag of OpenType,
4416 LANGSYS is a symbol specifying a langsys tag of OpenType,
4417 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4419 If LANGYS is nil, the default langsys is selected.
4421 The features are applied in the order they appear in the list. The
4422 symbol `*' means to apply all available features not present in this
4423 list, and the remaining features are ignored. For instance, (vatu
4424 pstf * haln) is to apply vatu and pstf in this order, then to apply
4425 all available features other than vatu, pstf, and haln.
4427 The features are applied to the glyphs in the range FROM and TO of
4428 the glyph-string GSTRING-IN.
4430 If some feature is actually applicable, the resulting glyphs are
4431 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4432 this case, the value is the number of produced glyphs.
4434 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4437 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4438 produced in GSTRING-OUT, and the value is nil.
4440 See the documentation of `composition-get-gstring' for the format of
4442 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4444 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4449 check_otf_features (otf_features
);
4450 CHECK_FONT_OBJECT (font_object
);
4451 font
= XFONT_OBJECT (font_object
);
4452 if (! font
->driver
->otf_drive
)
4453 error ("Font backend %s can't drive OpenType GSUB table",
4454 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4455 CHECK_CONS (otf_features
);
4456 CHECK_SYMBOL (XCAR (otf_features
));
4457 val
= XCDR (otf_features
);
4458 CHECK_SYMBOL (XCAR (val
));
4459 val
= XCDR (otf_features
);
4462 len
= check_gstring (gstring_in
);
4463 CHECK_VECTOR (gstring_out
);
4464 CHECK_NATNUM (from
);
4466 CHECK_NATNUM (index
);
4468 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4469 args_out_of_range_3 (from
, to
, make_number (len
));
4470 if (XINT (index
) >= ASIZE (gstring_out
))
4471 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4472 num
= font
->driver
->otf_drive (font
, otf_features
,
4473 gstring_in
, XINT (from
), XINT (to
),
4474 gstring_out
, XINT (index
), 0);
4477 return make_number (num
);
4480 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4482 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4483 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4485 (SCRIPT LANGSYS FEATURE ...)
4486 See the documentation of `font-drive-otf' for more detail.
4488 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4489 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4490 character code corresponding to the glyph or nil if there's no
4491 corresponding character. */)
4492 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4495 Lisp_Object gstring_in
, gstring_out
, g
;
4496 Lisp_Object alternates
;
4499 CHECK_FONT_GET_OBJECT (font_object
, font
);
4500 if (! font
->driver
->otf_drive
)
4501 error ("Font backend %s can't drive OpenType GSUB table",
4502 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4503 CHECK_CHARACTER (character
);
4504 CHECK_CONS (otf_features
);
4506 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4507 g
= LGSTRING_GLYPH (gstring_in
, 0);
4508 LGLYPH_SET_CHAR (g
, XINT (character
));
4509 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4510 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4511 gstring_out
, 0, 1)) < 0)
4512 gstring_out
= Ffont_make_gstring (font_object
,
4513 make_number (ASIZE (gstring_out
) * 2));
4515 for (i
= 0; i
< num
; i
++)
4517 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4518 int c
= LGLYPH_CHAR (g
);
4519 unsigned code
= LGLYPH_CODE (g
);
4521 alternates
= Fcons (Fcons (make_number (code
),
4522 c
> 0 ? make_number (c
) : Qnil
),
4525 return Fnreverse (alternates
);
4531 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4532 doc
: /* Open FONT-ENTITY. */)
4533 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4537 CHECK_FONT_ENTITY (font_entity
);
4539 frame
= selected_frame
;
4540 CHECK_LIVE_FRAME (frame
);
4543 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4546 CHECK_NUMBER_OR_FLOAT (size
);
4548 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4550 isize
= XINT (size
);
4551 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4552 args_out_of_range (font_entity
, size
);
4556 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4559 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4560 doc
: /* Close FONT-OBJECT. */)
4561 (Lisp_Object font_object
, Lisp_Object frame
)
4563 CHECK_FONT_OBJECT (font_object
);
4565 frame
= selected_frame
;
4566 CHECK_LIVE_FRAME (frame
);
4567 font_close_object (XFRAME (frame
), font_object
);
4571 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4572 doc
: /* Return information about FONT-OBJECT.
4573 The value is a vector:
4574 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4577 NAME is the font name, a string (or nil if the font backend doesn't
4580 FILENAME is the font file name, a string (or nil if the font backend
4581 doesn't provide a file name).
4583 PIXEL-SIZE is a pixel size by which the font is opened.
4585 SIZE is a maximum advance width of the font in pixels.
4587 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4590 CAPABILITY is a list whose first element is a symbol representing the
4591 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4592 remaining elements describe the details of the font capability.
4594 If the font is OpenType font, the form of the list is
4595 \(opentype GSUB GPOS)
4596 where GSUB shows which "GSUB" features the font supports, and GPOS
4597 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4598 lists of the format:
4599 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4601 If the font is not OpenType font, currently the length of the form is
4604 SCRIPT is a symbol representing OpenType script tag.
4606 LANGSYS is a symbol representing OpenType langsys tag, or nil
4607 representing the default langsys.
4609 FEATURE is a symbol representing OpenType feature tag.
4611 If the font is not OpenType font, CAPABILITY is nil. */)
4612 (Lisp_Object font_object
)
4617 CHECK_FONT_GET_OBJECT (font_object
, font
);
4619 val
= Fmake_vector (make_number (9), Qnil
);
4620 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4621 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4622 ASET (val
, 2, make_number (font
->pixel_size
));
4623 ASET (val
, 3, make_number (font
->max_width
));
4624 ASET (val
, 4, make_number (font
->ascent
));
4625 ASET (val
, 5, make_number (font
->descent
));
4626 ASET (val
, 6, make_number (font
->space_width
));
4627 ASET (val
, 7, make_number (font
->average_width
));
4628 if (font
->driver
->otf_capability
)
4629 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4633 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4635 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4636 FROM and TO are positions (integers or markers) specifying a region
4637 of the current buffer.
4638 If the optional fourth arg OBJECT is not nil, it is a string or a
4639 vector containing the target characters.
4641 Each element is a vector containing information of a glyph in this format:
4642 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4644 FROM is an index numbers of a character the glyph corresponds to.
4645 TO is the same as FROM.
4646 C is the character of the glyph.
4647 CODE is the glyph-code of C in FONT-OBJECT.
4648 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4649 ADJUSTMENT is always nil.
4650 If FONT-OBJECT doesn't have a glyph for a character,
4651 the corresponding element is nil. */)
4652 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4657 Lisp_Object
*chars
, vec
;
4660 CHECK_FONT_GET_OBJECT (font_object
, font
);
4663 ptrdiff_t charpos
, bytepos
;
4665 validate_region (&from
, &to
);
4668 len
= XFASTINT (to
) - XFASTINT (from
);
4669 SAFE_ALLOCA_LISP (chars
, len
);
4670 charpos
= XFASTINT (from
);
4671 bytepos
= CHAR_TO_BYTE (charpos
);
4672 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4675 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4676 chars
[i
] = make_number (c
);
4679 else if (STRINGP (object
))
4681 const unsigned char *p
;
4683 CHECK_NUMBER (from
);
4685 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4686 || XINT (to
) > SCHARS (object
))
4687 args_out_of_range_3 (object
, from
, to
);
4690 len
= XFASTINT (to
) - XFASTINT (from
);
4691 SAFE_ALLOCA_LISP (chars
, len
);
4693 if (STRING_MULTIBYTE (object
))
4694 for (i
= 0; i
< len
; i
++)
4696 int c
= STRING_CHAR_ADVANCE (p
);
4697 chars
[i
] = make_number (c
);
4700 for (i
= 0; i
< len
; i
++)
4701 chars
[i
] = make_number (p
[i
]);
4705 CHECK_VECTOR (object
);
4706 CHECK_NUMBER (from
);
4708 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4709 || XINT (to
) > ASIZE (object
))
4710 args_out_of_range_3 (object
, from
, to
);
4713 len
= XFASTINT (to
) - XFASTINT (from
);
4714 for (i
= 0; i
< len
; i
++)
4716 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4717 CHECK_CHARACTER (elt
);
4719 chars
= aref_addr (object
, XFASTINT (from
));
4722 vec
= Fmake_vector (make_number (len
), Qnil
);
4723 for (i
= 0; i
< len
; i
++)
4726 int c
= XFASTINT (chars
[i
]);
4728 struct font_metrics metrics
;
4730 code
= font
->driver
->encode_char (font
, c
);
4731 if (code
== FONT_INVALID_CODE
)
4733 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4734 LGLYPH_SET_FROM (g
, i
);
4735 LGLYPH_SET_TO (g
, i
);
4736 LGLYPH_SET_CHAR (g
, c
);
4737 LGLYPH_SET_CODE (g
, code
);
4738 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4739 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4740 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4741 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4742 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4743 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4746 if (! VECTORP (object
))
4751 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4752 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4753 FONT is a font-spec, font-entity, or font-object. */)
4754 (Lisp_Object spec
, Lisp_Object font
)
4756 CHECK_FONT_SPEC (spec
);
4759 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4762 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4763 doc
: /* Return a font-object for displaying a character at POSITION.
4764 Optional second arg WINDOW, if non-nil, is a window displaying
4765 the current buffer. It defaults to the currently selected window. */)
4766 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4773 CHECK_NUMBER_COERCE_MARKER (position
);
4774 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4775 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4776 pos
= XINT (position
);
4780 CHECK_NUMBER (position
);
4781 CHECK_STRING (string
);
4782 if (! (0 < XINT (position
) && XINT (position
) < SCHARS (string
)))
4783 args_out_of_range (string
, position
);
4784 pos
= XINT (position
);
4787 window
= selected_window
;
4788 CHECK_LIVE_WINDOW (window
);
4789 w
= XWINDOW (window
);
4791 return font_at (-1, pos
, NULL
, w
, string
);
4795 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4796 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4797 The value is a number of glyphs drawn.
4798 Type C-l to recover what previously shown. */)
4799 (Lisp_Object font_object
, Lisp_Object string
)
4801 Lisp_Object frame
= selected_frame
;
4802 FRAME_PTR f
= XFRAME (frame
);
4808 CHECK_FONT_GET_OBJECT (font_object
, font
);
4809 CHECK_STRING (string
);
4810 len
= SCHARS (string
);
4811 code
= alloca (sizeof (unsigned) * len
);
4812 for (i
= 0; i
< len
; i
++)
4814 Lisp_Object ch
= Faref (string
, make_number (i
));
4818 code
[i
] = font
->driver
->encode_char (font
, c
);
4819 if (code
[i
] == FONT_INVALID_CODE
)
4822 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4824 if (font
->driver
->prepare_face
)
4825 font
->driver
->prepare_face (f
, face
);
4826 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4827 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4828 if (font
->driver
->done_face
)
4829 font
->driver
->done_face (f
, face
);
4831 return make_number (len
);
4835 #endif /* FONT_DEBUG */
4837 #ifdef HAVE_WINDOW_SYSTEM
4839 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4840 doc
: /* Return information about a font named NAME on frame FRAME.
4841 If FRAME is omitted or nil, use the selected frame.
4842 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4843 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4845 OPENED-NAME is the name used for opening the font,
4846 FULL-NAME is the full name of the font,
4847 SIZE is the pixelsize of the font,
4848 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4849 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4850 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4851 how to compose characters.
4852 If the named font is not yet loaded, return nil. */)
4853 (Lisp_Object name
, Lisp_Object frame
)
4858 Lisp_Object font_object
;
4860 (*check_window_system_func
) ();
4863 CHECK_STRING (name
);
4865 frame
= selected_frame
;
4866 CHECK_LIVE_FRAME (frame
);
4871 int fontset
= fs_query_fontset (name
, 0);
4874 name
= fontset_ascii (fontset
);
4875 font_object
= font_open_by_name (f
, name
);
4877 else if (FONT_OBJECT_P (name
))
4879 else if (FONT_ENTITY_P (name
))
4880 font_object
= font_open_entity (f
, name
, 0);
4883 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4884 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4886 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4888 if (NILP (font_object
))
4890 font
= XFONT_OBJECT (font_object
);
4892 info
= Fmake_vector (make_number (7), Qnil
);
4893 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4894 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4895 ASET (info
, 2, make_number (font
->pixel_size
));
4896 ASET (info
, 3, make_number (font
->height
));
4897 ASET (info
, 4, make_number (font
->baseline_offset
));
4898 ASET (info
, 5, make_number (font
->relative_compose
));
4899 ASET (info
, 6, make_number (font
->default_ascent
));
4902 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4903 close it now. Perhaps, we should manage font-objects
4904 by `reference-count'. */
4905 font_close_object (f
, font_object
);
4912 #define BUILD_STYLE_TABLE(TBL) \
4913 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4916 build_style_table (const struct table_entry
*entry
, int nelement
)
4919 Lisp_Object table
, elt
;
4921 table
= Fmake_vector (make_number (nelement
), Qnil
);
4922 for (i
= 0; i
< nelement
; i
++)
4924 for (j
= 0; entry
[i
].names
[j
]; j
++);
4925 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4926 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4927 for (j
= 0; entry
[i
].names
[j
]; j
++)
4928 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4929 ASET (table
, i
, elt
);
4934 /* The deferred font-log data of the form [ACTION ARG RESULT].
4935 If ACTION is not nil, that is added to the log when font_add_log is
4936 called next time. At that time, ACTION is set back to nil. */
4937 static Lisp_Object Vfont_log_deferred
;
4939 /* Prepend the font-related logging data in Vfont_log if it is not
4940 `t'. ACTION describes a kind of font-related action (e.g. listing,
4941 opening), ARG is the argument for the action, and RESULT is the
4942 result of the action. */
4944 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4949 if (EQ (Vfont_log
, Qt
))
4951 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4953 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4955 ASET (Vfont_log_deferred
, 0, Qnil
);
4956 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4957 AREF (Vfont_log_deferred
, 2));
4962 Lisp_Object tail
, elt
;
4963 Lisp_Object equalstr
= build_string ("=");
4965 val
= Ffont_xlfd_name (arg
, Qt
);
4966 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4970 if (EQ (XCAR (elt
), QCscript
)
4971 && SYMBOLP (XCDR (elt
)))
4972 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4973 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4974 else if (EQ (XCAR (elt
), QClang
)
4975 && SYMBOLP (XCDR (elt
)))
4976 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4977 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4978 else if (EQ (XCAR (elt
), QCotf
)
4979 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4980 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4982 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4988 && VECTORP (XCAR (result
))
4989 && ASIZE (XCAR (result
)) > 0
4990 && FONTP (AREF (XCAR (result
), 0)))
4991 result
= font_vconcat_entity_vectors (result
);
4994 val
= Ffont_xlfd_name (result
, Qt
);
4995 if (! FONT_SPEC_P (result
))
4996 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4997 build_string (":"), val
);
5000 else if (CONSP (result
))
5003 result
= Fcopy_sequence (result
);
5004 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5008 val
= Ffont_xlfd_name (val
, Qt
);
5009 XSETCAR (tail
, val
);
5012 else if (VECTORP (result
))
5014 result
= Fcopy_sequence (result
);
5015 for (i
= 0; i
< ASIZE (result
); i
++)
5017 val
= AREF (result
, i
);
5019 val
= Ffont_xlfd_name (val
, Qt
);
5020 ASET (result
, i
, val
);
5023 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5026 /* Record a font-related logging data to be added to Vfont_log when
5027 font_add_log is called next time. ACTION, ARG, RESULT are the same
5031 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5033 if (EQ (Vfont_log
, Qt
))
5035 ASET (Vfont_log_deferred
, 0, build_string (action
));
5036 ASET (Vfont_log_deferred
, 1, arg
);
5037 ASET (Vfont_log_deferred
, 2, result
);
5043 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5044 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5045 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5046 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5047 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5048 /* Note that the other elements in sort_shift_bits are not used. */
5050 staticpro (&font_charset_alist
);
5051 font_charset_alist
= Qnil
;
5053 DEFSYM (Qopentype
, "opentype");
5055 DEFSYM (Qascii_0
, "ascii-0");
5056 DEFSYM (Qiso8859_1
, "iso8859-1");
5057 DEFSYM (Qiso10646_1
, "iso10646-1");
5058 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5059 DEFSYM (Qunicode_sip
, "unicode-sip");
5063 DEFSYM (QCotf
, ":otf");
5064 DEFSYM (QClang
, ":lang");
5065 DEFSYM (QCscript
, ":script");
5066 DEFSYM (QCantialias
, ":antialias");
5068 DEFSYM (QCfoundry
, ":foundry");
5069 DEFSYM (QCadstyle
, ":adstyle");
5070 DEFSYM (QCregistry
, ":registry");
5071 DEFSYM (QCspacing
, ":spacing");
5072 DEFSYM (QCdpi
, ":dpi");
5073 DEFSYM (QCscalable
, ":scalable");
5074 DEFSYM (QCavgwidth
, ":avgwidth");
5075 DEFSYM (QCfont_entity
, ":font-entity");
5076 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5086 DEFSYM (QCuser_spec
, "user-spec");
5088 staticpro (&scratch_font_spec
);
5089 scratch_font_spec
= Ffont_spec (0, NULL
);
5090 staticpro (&scratch_font_prefer
);
5091 scratch_font_prefer
= Ffont_spec (0, NULL
);
5093 staticpro (&Vfont_log_deferred
);
5094 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5098 staticpro (&otf_list
);
5100 #endif /* HAVE_LIBOTF */
5104 defsubr (&Sfont_spec
);
5105 defsubr (&Sfont_get
);
5106 #ifdef HAVE_WINDOW_SYSTEM
5107 defsubr (&Sfont_face_attributes
);
5109 defsubr (&Sfont_put
);
5110 defsubr (&Slist_fonts
);
5111 defsubr (&Sfont_family_list
);
5112 defsubr (&Sfind_font
);
5113 defsubr (&Sfont_xlfd_name
);
5114 defsubr (&Sclear_font_cache
);
5115 defsubr (&Sfont_shape_gstring
);
5116 defsubr (&Sfont_variation_glyphs
);
5118 defsubr (&Sfont_drive_otf
);
5119 defsubr (&Sfont_otf_alternates
);
5123 defsubr (&Sopen_font
);
5124 defsubr (&Sclose_font
);
5125 defsubr (&Squery_font
);
5126 defsubr (&Sfont_get_glyphs
);
5127 defsubr (&Sfont_match_p
);
5128 defsubr (&Sfont_at
);
5130 defsubr (&Sdraw_string
);
5132 #endif /* FONT_DEBUG */
5133 #ifdef HAVE_WINDOW_SYSTEM
5134 defsubr (&Sfont_info
);
5137 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5139 Alist of fontname patterns vs the corresponding encoding and repertory info.
5140 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5141 where ENCODING is a charset or a char-table,
5142 and REPERTORY is a charset, a char-table, or nil.
5144 If ENCODING and REPERTORY are the same, the element can have the form
5145 \(REGEXP . ENCODING).
5147 ENCODING is for converting a character to a glyph code of the font.
5148 If ENCODING is a charset, encoding a character by the charset gives
5149 the corresponding glyph code. If ENCODING is a char-table, looking up
5150 the table by a character gives the corresponding glyph code.
5152 REPERTORY specifies a repertory of characters supported by the font.
5153 If REPERTORY is a charset, all characters belonging to the charset are
5154 supported. If REPERTORY is a char-table, all characters who have a
5155 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5156 gets the repertory information by an opened font and ENCODING. */);
5157 Vfont_encoding_alist
= Qnil
;
5159 /* FIXME: These 3 vars are not quite what they appear: setq on them
5160 won't have any effect other than disconnect them from the style
5161 table used by the font display code. So we make them read-only,
5162 to avoid this confusing situation. */
5164 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5165 doc
: /* Vector of valid font weight values.
5166 Each element has the form:
5167 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5168 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5169 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5170 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5172 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5173 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5174 See `font-weight-table' for the format of the vector. */);
5175 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5176 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5178 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5179 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5180 See `font-weight-table' for the format of the vector. */);
5181 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5182 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5184 staticpro (&font_style_table
);
5185 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5186 ASET (font_style_table
, 0, Vfont_weight_table
);
5187 ASET (font_style_table
, 1, Vfont_slant_table
);
5188 ASET (font_style_table
, 2, Vfont_width_table
);
5190 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5191 *Logging list of font related actions and results.
5192 The value t means to suppress the logging.
5193 The initial value is set to nil if the environment variable
5194 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5197 #ifdef HAVE_WINDOW_SYSTEM
5198 #ifdef HAVE_FREETYPE
5200 #ifdef HAVE_X_WINDOWS
5205 #endif /* HAVE_XFT */
5206 #endif /* HAVE_X_WINDOWS */
5207 #else /* not HAVE_FREETYPE */
5208 #ifdef HAVE_X_WINDOWS
5210 #endif /* HAVE_X_WINDOWS */
5211 #endif /* not HAVE_FREETYPE */
5214 #endif /* HAVE_BDFFONT */
5217 #endif /* WINDOWSNT */
5220 #endif /* HAVE_NS */
5221 #endif /* HAVE_WINDOW_SYSTEM */
5227 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;