1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2014 Free Software Foundation, Inc.
4 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
30 #include "character.h"
34 #include "dispextern.h"
36 #include "composite.h"
40 #ifdef HAVE_WINDOW_SYSTEM
42 #endif /* HAVE_WINDOW_SYSTEM */
44 Lisp_Object Qopentype
;
46 /* Important character set strings. */
47 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
49 #define DEFAULT_ENCODING Qiso8859_1
51 /* Unicode category `Cf'. */
52 static Lisp_Object QCf
;
54 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
55 static Lisp_Object font_style_table
;
57 /* Structure used for tables mapping weight, slant, and width numeric
58 values and their names. */
63 /* The first one is a valid name as a face attribute.
64 The second one (if any) is a typical name in XLFD field. */
68 /* Table of weight numeric values and their names. This table must be
69 sorted by numeric values in ascending order. */
71 static const struct table_entry weight_table
[] =
74 { 20, { "ultra-light", "ultralight" }},
75 { 40, { "extra-light", "extralight" }},
77 { 75, { "semi-light", "semilight", "demilight", "book" }},
78 { 100, { "normal", "medium", "regular", "unspecified" }},
79 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
81 { 205, { "extra-bold", "extrabold" }},
82 { 210, { "ultra-bold", "ultrabold", "black" }}
85 /* Table of slant numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static const struct table_entry slant_table
[] =
90 { 0, { "reverse-oblique", "ro" }},
91 { 10, { "reverse-italic", "ri" }},
92 { 100, { "normal", "r", "unspecified" }},
93 { 200, { "italic" ,"i", "ot" }},
94 { 210, { "oblique", "o" }}
97 /* Table of width numeric values and their names. This table must be
98 sorted by numeric values in ascending order. */
100 static const struct table_entry width_table
[] =
102 { 50, { "ultra-condensed", "ultracondensed" }},
103 { 63, { "extra-condensed", "extracondensed" }},
104 { 75, { "condensed", "compressed", "narrow" }},
105 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
106 { 100, { "normal", "medium", "regular", "unspecified" }},
107 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
108 { 125, { "expanded" }},
109 { 150, { "extra-expanded", "extraexpanded" }},
110 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
113 Lisp_Object QCfoundry
;
114 static Lisp_Object QCadstyle
, QCregistry
;
115 /* Symbols representing keys of font extra info. */
116 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
117 Lisp_Object QCantialias
, QCfont_entity
;
118 static Lisp_Object QCfc_unknown_spec
;
119 /* Symbols representing values of font spacing property. */
120 static Lisp_Object Qc
, Qm
, Qd
;
122 /* Special ADSTYLE properties to avoid fonts used for Latin
123 characters; used in xfont.c and ftfont.c. */
124 Lisp_Object Qja
, Qko
;
126 static Lisp_Object QCuser_spec
;
128 /* Alist of font registry symbols and the corresponding charset
129 information. The information is retrieved from
130 Vfont_encoding_alist on demand.
132 Eash element has the form:
133 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
137 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
138 encodes a character code to a glyph code of a font, and
139 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
140 character is supported by a font.
142 The latter form means that the information for REGISTRY couldn't be
144 static Lisp_Object font_charset_alist
;
146 /* List of all font drivers. Each font-backend (XXXfont.c) calls
147 register_font_driver in syms_of_XXXfont to register its font-driver
149 static struct font_driver_list
*font_driver_list
;
151 #ifdef ENABLE_CHECKING
153 /* Used to catch bogus pointers in font objects. */
156 valid_font_driver (struct font_driver
*drv
)
158 Lisp_Object tail
, frame
;
159 struct font_driver_list
*fdl
;
161 for (fdl
= font_driver_list
; fdl
; fdl
= fdl
->next
)
162 if (fdl
->driver
== drv
)
164 FOR_EACH_FRAME (tail
, frame
)
165 for (fdl
= XFRAME (frame
)->font_driver_list
; fdl
; fdl
= fdl
->next
)
166 if (fdl
->driver
== drv
)
171 #endif /* ENABLE_CHECKING */
173 /* Creators of font-related Lisp object. */
176 font_make_spec (void)
178 Lisp_Object font_spec
;
179 struct font_spec
*spec
180 = ((struct font_spec
*)
181 allocate_pseudovector (VECSIZE (struct font_spec
),
182 FONT_SPEC_MAX
, PVEC_FONT
));
183 XSETFONT (font_spec
, spec
);
188 font_make_entity (void)
190 Lisp_Object font_entity
;
191 struct font_entity
*entity
192 = ((struct font_entity
*)
193 allocate_pseudovector (VECSIZE (struct font_entity
),
194 FONT_ENTITY_MAX
, PVEC_FONT
));
195 XSETFONT (font_entity
, entity
);
199 /* Create a font-object whose structure size is SIZE. If ENTITY is
200 not nil, copy properties from ENTITY to the font-object. If
201 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
203 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
205 Lisp_Object font_object
;
207 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
210 /* GC can happen before the driver is set up,
211 so avoid dangling pointer here (Bug#17771). */
213 XSETFONT (font_object
, font
);
217 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
218 font
->props
[i
] = AREF (entity
, i
);
219 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
220 font
->props
[FONT_EXTRA_INDEX
]
221 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
224 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
230 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
231 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
232 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
234 static unsigned font_encode_char (Lisp_Object
, int);
236 /* Number of registered font drivers. */
237 static int num_font_drivers
;
240 /* Return a Lispy value of a font property value at STR and LEN bytes.
241 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
242 consist entirely of one or more digits, return a symbol interned
243 from STR. Otherwise, return an integer. */
246 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
251 ptrdiff_t nbytes
, nchars
;
253 if (len
== 1 && *str
== '*')
255 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
257 for (i
= 1; i
< len
; i
++)
258 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
265 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
268 return make_number (n
);
269 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
273 xsignal1 (Qoverflow_error
, make_string (str
, len
));
277 /* This code is similar to intern function from lread.c. */
278 obarray
= check_obarray (Vobarray
);
279 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
280 tem
= make_specified_string (str
, nchars
, len
,
281 len
!= nchars
&& len
== nbytes
);
282 return Fintern (tem
, obarray
);
285 /* Return a pixel size of font-spec SPEC on frame F. */
288 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
290 #ifdef HAVE_WINDOW_SYSTEM
291 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
300 eassert (FLOATP (size
));
301 point_size
= XFLOAT_DATA (size
);
302 val
= AREF (spec
, FONT_DPI_INDEX
);
306 dpi
= FRAME_RES_Y (f
);
307 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
315 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
316 font vector. If VAL is not valid (i.e. not registered in
317 font_style_table), return -1 if NOERROR is zero, and return a
318 proper index if NOERROR is nonzero. In that case, register VAL in
319 font_style_table if VAL is a symbol, and return the closest index if
320 VAL is an integer. */
323 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
326 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
329 CHECK_VECTOR (table
);
336 Lisp_Object args
[2], elt
;
338 /* At first try exact match. */
339 for (i
= 0; i
< len
; i
++)
341 CHECK_VECTOR (AREF (table
, i
));
342 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
343 if (EQ (val
, AREF (AREF (table
, i
), j
)))
345 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
346 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
347 | (i
<< 4) | (j
- 1));
350 /* Try also with case-folding match. */
351 s
= SSDATA (SYMBOL_NAME (val
));
352 for (i
= 0; i
< len
; i
++)
353 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
355 elt
= AREF (AREF (table
, i
), j
);
356 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
358 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
359 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
360 | (i
<< 4) | (j
- 1));
366 elt
= Fmake_vector (make_number (2), make_number (100));
369 args
[1] = Fmake_vector (make_number (1), elt
);
370 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
371 return (100 << 8) | (i
<< 4);
376 EMACS_INT numeric
= XINT (val
);
378 for (i
= 0, last_n
= -1; i
< len
; i
++)
382 CHECK_VECTOR (AREF (table
, i
));
383 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
384 n
= XINT (AREF (AREF (table
, i
), 0));
386 return (n
<< 8) | (i
<< 4);
391 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
392 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
398 return ((last_n
<< 8) | ((i
- 1) << 4));
403 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
406 Lisp_Object val
= AREF (font
, prop
);
407 Lisp_Object table
, elt
;
412 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
413 CHECK_VECTOR (table
);
414 i
= XINT (val
) & 0xFF;
415 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
416 elt
= AREF (table
, ((i
>> 4) & 0xF));
418 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
419 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
424 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
425 FONTNAME. ENCODING is a charset symbol that specifies the encoding
426 of the font. REPERTORY is a charset symbol or nil. */
429 find_font_encoding (Lisp_Object fontname
)
431 Lisp_Object tail
, elt
;
433 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
437 && STRINGP (XCAR (elt
))
438 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
439 && (SYMBOLP (XCDR (elt
))
440 ? CHARSETP (XCDR (elt
))
441 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
447 /* Return encoding charset and repertory charset for REGISTRY in
448 ENCODING and REPERTORY correspondingly. If correct information for
449 REGISTRY is available, return 0. Otherwise return -1. */
452 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
455 int encoding_id
, repertory_id
;
457 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
463 encoding_id
= XINT (XCAR (val
));
464 repertory_id
= XINT (XCDR (val
));
468 val
= find_font_encoding (SYMBOL_NAME (registry
));
469 if (SYMBOLP (val
) && CHARSETP (val
))
471 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
473 else if (CONSP (val
))
475 if (! CHARSETP (XCAR (val
)))
477 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
478 if (NILP (XCDR (val
)))
482 if (! CHARSETP (XCDR (val
)))
484 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
489 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
491 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
495 *encoding
= CHARSET_FROM_ID (encoding_id
);
497 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
502 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
507 /* Font property value validators. See the comment of
508 font_property_table for the meaning of the arguments. */
510 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
511 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
512 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
513 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
514 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
515 static int get_font_prop_index (Lisp_Object
);
518 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
521 val
= Fintern (val
, Qnil
);
524 else if (EQ (prop
, QCregistry
))
525 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
531 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
533 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
534 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
538 EMACS_INT n
= XINT (val
);
539 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
541 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
545 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
548 if ((n
& 0xF) + 1 >= ASIZE (elt
))
552 CHECK_NUMBER (AREF (elt
, 0));
553 if (XINT (AREF (elt
, 0)) != (n
>> 8))
558 else if (SYMBOLP (val
))
560 int n
= font_style_to_value (prop
, val
, 0);
562 val
= n
>= 0 ? make_number (n
) : Qerror
;
570 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
572 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
577 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
579 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
581 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
583 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
585 if (spacing
== 'c' || spacing
== 'C')
586 return make_number (FONT_SPACING_CHARCELL
);
587 if (spacing
== 'm' || spacing
== 'M')
588 return make_number (FONT_SPACING_MONO
);
589 if (spacing
== 'p' || spacing
== 'P')
590 return make_number (FONT_SPACING_PROPORTIONAL
);
591 if (spacing
== 'd' || spacing
== 'D')
592 return make_number (FONT_SPACING_DUAL
);
598 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
600 Lisp_Object tail
, tmp
;
603 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
604 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
605 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
608 if (! SYMBOLP (XCAR (val
)))
613 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
615 for (i
= 0; i
< 2; i
++)
622 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
623 if (! SYMBOLP (XCAR (tmp
)))
631 /* Structure of known font property keys and validator of the
635 /* Pointer to the key symbol. */
637 /* Function to validate PROP's value VAL, or NULL if any value is
638 ok. The value is VAL or its regularized value if VAL is valid,
639 and Qerror if not. */
640 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
641 } font_property_table
[] =
642 { { &QCtype
, font_prop_validate_symbol
},
643 { &QCfoundry
, font_prop_validate_symbol
},
644 { &QCfamily
, font_prop_validate_symbol
},
645 { &QCadstyle
, font_prop_validate_symbol
},
646 { &QCregistry
, font_prop_validate_symbol
},
647 { &QCweight
, font_prop_validate_style
},
648 { &QCslant
, font_prop_validate_style
},
649 { &QCwidth
, font_prop_validate_style
},
650 { &QCsize
, font_prop_validate_non_neg
},
651 { &QCdpi
, font_prop_validate_non_neg
},
652 { &QCspacing
, font_prop_validate_spacing
},
653 { &QCavgwidth
, font_prop_validate_non_neg
},
654 /* The order of the above entries must match with enum
655 font_property_index. */
656 { &QClang
, font_prop_validate_symbol
},
657 { &QCscript
, font_prop_validate_symbol
},
658 { &QCotf
, font_prop_validate_otf
}
661 /* Return an index number of font property KEY or -1 if KEY is not an
662 already known property. */
665 get_font_prop_index (Lisp_Object key
)
669 for (i
= 0; i
< ARRAYELTS (font_property_table
); i
++)
670 if (EQ (key
, *font_property_table
[i
].key
))
675 /* Validate the font property. The property key is specified by the
676 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
677 signal an error. The value is VAL or the regularized one. */
680 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
682 Lisp_Object validated
;
687 prop
= *font_property_table
[idx
].key
;
690 idx
= get_font_prop_index (prop
);
694 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
695 if (EQ (validated
, Qerror
))
696 signal_error ("invalid font property", Fcons (prop
, val
));
701 /* Store VAL as a value of extra font property PROP in FONT while
702 keeping the sorting order. Don't check the validity of VAL. */
705 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
707 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
708 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
712 Lisp_Object prev
= Qnil
;
715 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
716 prev
= extra
, extra
= XCDR (extra
);
719 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
721 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
727 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
732 /* Font name parser and unparser. */
734 static int parse_matrix (const char *);
735 static int font_expand_wildcards (Lisp_Object
*, int);
736 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
738 /* An enumerator for each field of an XLFD font name. */
739 enum xlfd_field_index
758 /* An enumerator for mask bit corresponding to each XLFD field. */
761 XLFD_FOUNDRY_MASK
= 0x0001,
762 XLFD_FAMILY_MASK
= 0x0002,
763 XLFD_WEIGHT_MASK
= 0x0004,
764 XLFD_SLANT_MASK
= 0x0008,
765 XLFD_SWIDTH_MASK
= 0x0010,
766 XLFD_ADSTYLE_MASK
= 0x0020,
767 XLFD_PIXEL_MASK
= 0x0040,
768 XLFD_POINT_MASK
= 0x0080,
769 XLFD_RESX_MASK
= 0x0100,
770 XLFD_RESY_MASK
= 0x0200,
771 XLFD_SPACING_MASK
= 0x0400,
772 XLFD_AVGWIDTH_MASK
= 0x0800,
773 XLFD_REGISTRY_MASK
= 0x1000,
774 XLFD_ENCODING_MASK
= 0x2000
778 /* Parse P pointing to the pixel/point size field of the form
779 `[A B C D]' which specifies a transformation matrix:
785 by which all glyphs of the font are transformed. The spec says
786 that scalar value N for the pixel/point size is equivalent to:
787 A = N * resx/resy, B = C = 0, D = N.
789 Return the scalar value N if the form is valid. Otherwise return
793 parse_matrix (const char *p
)
799 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
802 matrix
[i
] = - strtod (p
+ 1, &end
);
804 matrix
[i
] = strtod (p
, &end
);
807 return (i
== 4 ? (int) matrix
[3] : -1);
810 /* Expand a wildcard field in FIELD (the first N fields are filled) to
811 multiple fields to fill in all 14 XLFD fields while restricting a
812 field position by its contents. */
815 font_expand_wildcards (Lisp_Object
*field
, int n
)
818 Lisp_Object tmp
[XLFD_LAST_INDEX
];
819 /* Array of information about where this element can go. Nth
820 element is for Nth element of FIELD. */
822 /* Minimum possible field. */
824 /* Maximum possible field. */
826 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
828 } range
[XLFD_LAST_INDEX
];
830 int range_from
, range_to
;
833 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
834 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
835 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
836 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
837 | XLFD_AVGWIDTH_MASK)
838 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
840 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
841 field. The value is shifted to left one bit by one in the
843 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
844 range_mask
= (range_mask
<< 1) | 1;
846 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
847 position-based restriction for FIELD[I]. */
848 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
849 i
++, range_from
++, range_to
++, range_mask
<<= 1)
851 Lisp_Object val
= field
[i
];
857 range
[i
].from
= range_from
;
858 range
[i
].to
= range_to
;
859 range
[i
].mask
= range_mask
;
863 /* The triplet FROM, TO, and MASK is a value-based
864 restriction for FIELD[I]. */
870 EMACS_INT numeric
= XINT (val
);
873 from
= to
= XLFD_ENCODING_INDEX
,
874 mask
= XLFD_ENCODING_MASK
;
875 else if (numeric
== 0)
876 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
877 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
878 else if (numeric
<= 48)
879 from
= to
= XLFD_PIXEL_INDEX
,
880 mask
= XLFD_PIXEL_MASK
;
882 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
883 mask
= XLFD_LARGENUM_MASK
;
885 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
886 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
887 mask
= XLFD_NULL_MASK
;
889 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
892 Lisp_Object name
= SYMBOL_NAME (val
);
894 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
895 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
896 mask
= XLFD_REGENC_MASK
;
898 from
= to
= XLFD_ENCODING_INDEX
,
899 mask
= XLFD_ENCODING_MASK
;
901 else if (range_from
<= XLFD_WEIGHT_INDEX
902 && range_to
>= XLFD_WEIGHT_INDEX
903 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
904 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
905 else if (range_from
<= XLFD_SLANT_INDEX
906 && range_to
>= XLFD_SLANT_INDEX
907 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
908 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
909 else if (range_from
<= XLFD_SWIDTH_INDEX
910 && range_to
>= XLFD_SWIDTH_INDEX
911 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
912 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
915 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
916 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
918 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
919 mask
= XLFD_SYMBOL_MASK
;
922 /* Merge position-based and value-based restrictions. */
924 while (from
< range_from
)
925 mask
&= ~(1 << from
++);
926 while (from
< 14 && ! (mask
& (1 << from
)))
928 while (to
> range_to
)
929 mask
&= ~(1 << to
--);
930 while (to
>= 0 && ! (mask
& (1 << to
)))
934 range
[i
].from
= from
;
936 range
[i
].mask
= mask
;
938 if (from
> range_from
|| to
< range_to
)
940 /* The range is narrowed by value-based restrictions.
941 Reflect it to the other fields. */
943 /* Following fields should be after FROM. */
945 /* Preceding fields should be before TO. */
946 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
948 /* Check FROM for non-wildcard field. */
949 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
951 while (range
[j
].from
< from
)
952 range
[j
].mask
&= ~(1 << range
[j
].from
++);
953 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
955 range
[j
].from
= from
;
958 from
= range
[j
].from
;
959 if (range
[j
].to
> to
)
961 while (range
[j
].to
> to
)
962 range
[j
].mask
&= ~(1 << range
[j
].to
--);
963 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
976 /* Decide all fields from restrictions in RANGE. */
977 for (i
= j
= 0; i
< n
; i
++)
979 if (j
< range
[i
].from
)
981 if (i
== 0 || ! NILP (tmp
[i
- 1]))
982 /* None of TMP[X] corresponds to Jth field. */
984 for (; j
< range
[i
].from
; j
++)
989 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
991 for (; j
< XLFD_LAST_INDEX
; j
++)
993 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
994 field
[XLFD_ENCODING_INDEX
]
995 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1000 /* Parse NAME (null terminated) as XLFD and store information in FONT
1001 (font-spec or font-entity). Size property of FONT is set as
1003 specified XLFD fields FONT property
1004 --------------------- -------------
1005 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1006 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1007 POINT_SIZE POINT_SIZE/10 (Lisp float)
1009 If NAME is successfully parsed, return 0. Otherwise return -1.
1011 FONT is usually a font-spec, but when this function is called from
1012 X font backend driver, it is a font-entity. In that case, NAME is
1013 a fully specified XLFD. */
1016 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1019 char *f
[XLFD_LAST_INDEX
+ 1];
1023 if (len
> 255 || !len
)
1024 /* Maximum XLFD name length is 255. */
1026 /* Accept "*-.." as a fully specified XLFD. */
1027 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1028 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1031 for (p
= name
+ i
; *p
; p
++)
1035 if (i
== XLFD_LAST_INDEX
)
1040 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1041 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1043 if (i
== XLFD_LAST_INDEX
)
1045 /* Fully specified XLFD. */
1048 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1049 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1050 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1051 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1053 val
= INTERN_FIELD_SYM (i
);
1056 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1058 ASET (font
, j
, make_number (n
));
1061 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1062 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1063 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1065 ASET (font
, FONT_REGISTRY_INDEX
,
1066 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1067 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1069 p
= f
[XLFD_PIXEL_INDEX
];
1070 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1071 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1074 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1076 ASET (font
, FONT_SIZE_INDEX
, val
);
1077 else if (FONT_ENTITY_P (font
))
1081 double point_size
= -1;
1083 eassert (FONT_SPEC_P (font
));
1084 p
= f
[XLFD_POINT_INDEX
];
1086 point_size
= parse_matrix (p
);
1087 else if (c_isdigit (*p
))
1088 point_size
= atoi (p
), point_size
/= 10;
1089 if (point_size
>= 0)
1090 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1094 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1095 if (! NILP (val
) && ! INTEGERP (val
))
1097 ASET (font
, FONT_DPI_INDEX
, val
);
1098 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1101 val
= font_prop_validate_spacing (QCspacing
, val
);
1102 if (! INTEGERP (val
))
1104 ASET (font
, FONT_SPACING_INDEX
, val
);
1106 p
= f
[XLFD_AVGWIDTH_INDEX
];
1109 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1110 if (! NILP (val
) && ! INTEGERP (val
))
1112 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1116 bool wild_card_found
= 0;
1117 Lisp_Object prop
[XLFD_LAST_INDEX
];
1119 if (FONT_ENTITY_P (font
))
1121 for (j
= 0; j
< i
; j
++)
1125 if (f
[j
][1] && f
[j
][1] != '-')
1128 wild_card_found
= 1;
1131 prop
[j
] = INTERN_FIELD (j
);
1133 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1135 if (! wild_card_found
)
1137 if (font_expand_wildcards (prop
, i
) < 0)
1140 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1141 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1142 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1143 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1144 if (! NILP (prop
[i
]))
1146 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1148 ASET (font
, j
, make_number (n
));
1150 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1151 val
= prop
[XLFD_REGISTRY_INDEX
];
1154 val
= prop
[XLFD_ENCODING_INDEX
];
1156 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1158 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1159 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1161 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1162 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1164 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1166 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1167 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1168 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1170 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1172 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1175 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1176 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1177 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1179 val
= font_prop_validate_spacing (QCspacing
,
1180 prop
[XLFD_SPACING_INDEX
]);
1181 if (! INTEGERP (val
))
1183 ASET (font
, FONT_SPACING_INDEX
, val
);
1185 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1186 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1192 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1193 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1194 0, use PIXEL_SIZE instead. */
1197 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1200 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1204 eassert (FONTP (font
));
1206 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1209 if (i
== FONT_ADSTYLE_INDEX
)
1210 j
= XLFD_ADSTYLE_INDEX
;
1211 else if (i
== FONT_REGISTRY_INDEX
)
1212 j
= XLFD_REGISTRY_INDEX
;
1213 val
= AREF (font
, i
);
1216 if (j
== XLFD_REGISTRY_INDEX
)
1224 val
= SYMBOL_NAME (val
);
1225 if (j
== XLFD_REGISTRY_INDEX
1226 && ! strchr (SSDATA (val
), '-'))
1228 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1229 ptrdiff_t alloc
= SBYTES (val
) + 4;
1230 if (nbytes
<= alloc
)
1232 f
[j
] = p
= alloca (alloc
);
1233 sprintf (p
, "%s%s-*", SDATA (val
),
1234 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1237 f
[j
] = SSDATA (val
);
1241 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1244 val
= font_style_symbolic (font
, i
, 0);
1252 val
= SYMBOL_NAME (val
);
1253 alloc
= SBYTES (val
) + 1;
1254 if (nbytes
<= alloc
)
1256 f
[j
] = p
= alloca (alloc
);
1257 /* Copy the name while excluding '-', '?', ',', and '"'. */
1258 for (k
= l
= 0; k
< alloc
; k
++)
1261 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1267 val
= AREF (font
, FONT_SIZE_INDEX
);
1268 eassert (NUMBERP (val
) || NILP (val
));
1271 EMACS_INT v
= XINT (val
);
1276 f
[XLFD_PIXEL_INDEX
] = p
=
1277 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1278 sprintf (p
, "%"pI
"d-*", v
);
1281 f
[XLFD_PIXEL_INDEX
] = "*-*";
1283 else if (FLOATP (val
))
1285 double v
= XFLOAT_DATA (val
) * 10;
1286 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1287 sprintf (p
, "*-%.0f", v
);
1290 f
[XLFD_PIXEL_INDEX
] = "*-*";
1292 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1294 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1295 f
[XLFD_RESX_INDEX
] = p
=
1296 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1297 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1300 f
[XLFD_RESX_INDEX
] = "*-*";
1301 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1303 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1305 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1306 : spacing
<= FONT_SPACING_DUAL
? "d"
1307 : spacing
<= FONT_SPACING_MONO
? "m"
1311 f
[XLFD_SPACING_INDEX
] = "*";
1312 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1314 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1315 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1318 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1319 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1320 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1321 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1322 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1323 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1324 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1325 f
[XLFD_REGISTRY_INDEX
]);
1326 return len
< nbytes
? len
: -1;
1329 /* Parse NAME (null terminated) and store information in FONT
1330 (font-spec or font-entity). NAME is supplied in either the
1331 Fontconfig or GTK font name format. If NAME is successfully
1332 parsed, return 0. Otherwise return -1.
1334 The fontconfig format is
1336 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1340 FAMILY [PROPS...] [SIZE]
1342 This function tries to guess which format it is. */
1345 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1348 char *size_beg
= NULL
, *size_end
= NULL
;
1349 char *props_beg
= NULL
, *family_end
= NULL
;
1354 for (p
= name
; *p
; p
++)
1356 if (*p
== '\\' && p
[1])
1360 props_beg
= family_end
= p
;
1365 bool decimal
= 0, size_found
= 1;
1366 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1367 if (! c_isdigit (*q
))
1369 if (*q
!= '.' || decimal
)
1388 Lisp_Object extra_props
= Qnil
;
1390 /* A fontconfig name with size and/or property data. */
1391 if (family_end
> name
)
1394 family
= font_intern_prop (name
, family_end
- name
, 1);
1395 ASET (font
, FONT_FAMILY_INDEX
, family
);
1399 double point_size
= strtod (size_beg
, &size_end
);
1400 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1401 if (*size_end
== ':' && size_end
[1])
1402 props_beg
= size_end
;
1406 /* Now parse ":KEY=VAL" patterns. */
1409 for (p
= props_beg
; *p
; p
= q
)
1411 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1414 /* Must be an enumerated value. */
1418 val
= font_intern_prop (p
, q
- p
, 1);
1420 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1421 && memcmp (p, STR, strlen (STR)) == 0)
1423 if (PROP_MATCH ("light")
1424 || PROP_MATCH ("medium")
1425 || PROP_MATCH ("demibold")
1426 || PROP_MATCH ("bold")
1427 || PROP_MATCH ("black"))
1428 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1429 else if (PROP_MATCH ("roman")
1430 || PROP_MATCH ("italic")
1431 || PROP_MATCH ("oblique"))
1432 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1433 else if (PROP_MATCH ("charcell"))
1434 ASET (font
, FONT_SPACING_INDEX
,
1435 make_number (FONT_SPACING_CHARCELL
));
1436 else if (PROP_MATCH ("mono"))
1437 ASET (font
, FONT_SPACING_INDEX
,
1438 make_number (FONT_SPACING_MONO
));
1439 else if (PROP_MATCH ("proportional"))
1440 ASET (font
, FONT_SPACING_INDEX
,
1441 make_number (FONT_SPACING_PROPORTIONAL
));
1450 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1451 prop
= FONT_SIZE_INDEX
;
1454 key
= font_intern_prop (p
, q
- p
, 1);
1455 prop
= get_font_prop_index (key
);
1459 for (q
= p
; *q
&& *q
!= ':'; q
++);
1460 val
= font_intern_prop (p
, q
- p
, 0);
1462 if (prop
>= FONT_FOUNDRY_INDEX
1463 && prop
< FONT_EXTRA_INDEX
)
1464 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1467 extra_props
= nconc2 (extra_props
,
1468 list1 (Fcons (key
, val
)));
1475 if (! NILP (extra_props
))
1477 struct font_driver_list
*driver_list
= font_driver_list
;
1478 for ( ; driver_list
; driver_list
= driver_list
->next
)
1479 if (driver_list
->driver
->filter_properties
)
1480 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1486 /* Either a fontconfig-style name with no size and property
1487 data, or a GTK-style name. */
1488 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1489 Lisp_Object width
= Qnil
, size
= Qnil
;
1493 /* Scan backwards from the end, looking for a size. */
1494 for (p
= name
+ len
- 1; p
>= name
; p
--)
1495 if (!c_isdigit (*p
))
1498 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1499 /* Found a font size. */
1500 size
= make_float (strtod (p
+ 1, NULL
));
1504 /* Now P points to the termination of the string, sans size.
1505 Scan backwards, looking for font properties. */
1506 for (; p
> name
; p
= q
)
1508 for (q
= p
- 1; q
>= name
; q
--)
1510 if (q
> name
&& *(q
-1) == '\\')
1511 --q
; /* Skip quoting backslashes. */
1517 word_len
= p
- word_start
;
1519 #define PROP_MATCH(STR) \
1520 (word_len == strlen (STR) \
1521 && memcmp (word_start, STR, strlen (STR)) == 0)
1522 #define PROP_SAVE(VAR, STR) \
1523 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1525 if (PROP_MATCH ("Ultra-Light"))
1526 PROP_SAVE (weight
, "ultra-light");
1527 else if (PROP_MATCH ("Light"))
1528 PROP_SAVE (weight
, "light");
1529 else if (PROP_MATCH ("Book"))
1530 PROP_SAVE (weight
, "book");
1531 else if (PROP_MATCH ("Medium"))
1532 PROP_SAVE (weight
, "medium");
1533 else if (PROP_MATCH ("Semi-Bold"))
1534 PROP_SAVE (weight
, "semi-bold");
1535 else if (PROP_MATCH ("Bold"))
1536 PROP_SAVE (weight
, "bold");
1537 else if (PROP_MATCH ("Italic"))
1538 PROP_SAVE (slant
, "italic");
1539 else if (PROP_MATCH ("Oblique"))
1540 PROP_SAVE (slant
, "oblique");
1541 else if (PROP_MATCH ("Semi-Condensed"))
1542 PROP_SAVE (width
, "semi-condensed");
1543 else if (PROP_MATCH ("Condensed"))
1544 PROP_SAVE (width
, "condensed");
1545 /* An unknown word must be part of the font name. */
1556 ASET (font
, FONT_FAMILY_INDEX
,
1557 font_intern_prop (name
, family_end
- name
, 1));
1559 ASET (font
, FONT_SIZE_INDEX
, size
);
1561 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1563 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1565 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1571 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1572 NAME (NBYTES length), and return the name length. If
1573 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1576 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1578 Lisp_Object family
, foundry
;
1584 Lisp_Object styles
[3];
1585 const char *style_names
[3] = { "weight", "slant", "width" };
1587 family
= AREF (font
, FONT_FAMILY_INDEX
);
1588 if (! NILP (family
))
1590 if (SYMBOLP (family
))
1591 family
= SYMBOL_NAME (family
);
1596 val
= AREF (font
, FONT_SIZE_INDEX
);
1599 if (XINT (val
) != 0)
1600 pixel_size
= XINT (val
);
1605 eassert (FLOATP (val
));
1607 point_size
= (int) XFLOAT_DATA (val
);
1610 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1611 if (! NILP (foundry
))
1613 if (SYMBOLP (foundry
))
1614 foundry
= SYMBOL_NAME (foundry
);
1619 for (i
= 0; i
< 3; i
++)
1620 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1623 lim
= name
+ nbytes
;
1624 if (! NILP (family
))
1626 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1627 if (! (0 <= len
&& len
< lim
- p
))
1633 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1634 if (! (0 <= len
&& len
< lim
- p
))
1638 else if (pixel_size
> 0)
1640 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1641 if (! (0 <= len
&& len
< lim
- p
))
1645 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1647 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1648 SSDATA (SYMBOL_NAME (AREF (font
,
1649 FONT_FOUNDRY_INDEX
))));
1650 if (! (0 <= len
&& len
< lim
- p
))
1654 for (i
= 0; i
< 3; i
++)
1655 if (! NILP (styles
[i
]))
1657 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1658 SSDATA (SYMBOL_NAME (styles
[i
])));
1659 if (! (0 <= len
&& len
< lim
- p
))
1664 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1666 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1667 XINT (AREF (font
, FONT_DPI_INDEX
)));
1668 if (! (0 <= len
&& len
< lim
- p
))
1673 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1675 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1676 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1677 if (! (0 <= len
&& len
< lim
- p
))
1682 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1684 int len
= snprintf (p
, lim
- p
,
1685 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1687 : ":scalable=false"));
1688 if (! (0 <= len
&& len
< lim
- p
))
1696 /* Parse NAME (null terminated) and store information in FONT
1697 (font-spec or font-entity). If NAME is successfully parsed, return
1698 0. Otherwise return -1. */
1701 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1703 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1704 return font_parse_xlfd (name
, namelen
, font
);
1705 return font_parse_fcname (name
, namelen
, font
);
1709 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1710 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1714 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1720 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1722 CHECK_STRING (family
);
1723 len
= SBYTES (family
);
1724 p0
= SSDATA (family
);
1725 p1
= strchr (p0
, '-');
1728 if ((*p0
!= '*' && p1
- p0
> 0)
1729 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1730 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1733 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1736 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1738 if (! NILP (registry
))
1740 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1741 CHECK_STRING (registry
);
1742 len
= SBYTES (registry
);
1743 p0
= SSDATA (registry
);
1744 p1
= strchr (p0
, '-');
1747 if (SDATA (registry
)[len
- 1] == '*')
1748 registry
= concat2 (registry
, build_string ("-*"));
1750 registry
= concat2 (registry
, build_string ("*-*"));
1752 registry
= Fdowncase (registry
);
1753 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1758 /* This part (through the next ^L) is still experimental and not
1759 tested much. We may drastically change codes. */
1765 #define LGSTRING_HEADER_SIZE 6
1766 #define LGSTRING_GLYPH_SIZE 8
1769 check_gstring (Lisp_Object gstring
)
1775 CHECK_VECTOR (gstring
);
1776 val
= AREF (gstring
, 0);
1778 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1780 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1781 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1782 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1783 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1784 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1785 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1786 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1787 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1788 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1789 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1790 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1792 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1794 val
= LGSTRING_GLYPH (gstring
, i
);
1796 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1798 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1800 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1801 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1802 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1803 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1804 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1805 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1806 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1807 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1809 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1811 if (ASIZE (val
) < 3)
1813 for (j
= 0; j
< 3; j
++)
1814 CHECK_NUMBER (AREF (val
, j
));
1819 error ("Invalid glyph-string format");
1824 check_otf_features (Lisp_Object otf_features
)
1828 CHECK_CONS (otf_features
);
1829 CHECK_SYMBOL (XCAR (otf_features
));
1830 otf_features
= XCDR (otf_features
);
1831 CHECK_CONS (otf_features
);
1832 CHECK_SYMBOL (XCAR (otf_features
));
1833 otf_features
= XCDR (otf_features
);
1834 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1836 CHECK_SYMBOL (XCAR (val
));
1837 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1838 error ("Invalid OTF GSUB feature: %s",
1839 SDATA (SYMBOL_NAME (XCAR (val
))));
1841 otf_features
= XCDR (otf_features
);
1842 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1844 CHECK_SYMBOL (XCAR (val
));
1845 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1846 error ("Invalid OTF GPOS feature: %s",
1847 SDATA (SYMBOL_NAME (XCAR (val
))));
1854 Lisp_Object otf_list
;
1857 otf_tag_symbol (OTF_Tag tag
)
1861 OTF_tag_name (tag
, name
);
1862 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1866 otf_open (Lisp_Object file
)
1868 Lisp_Object val
= Fassoc (file
, otf_list
);
1872 otf
= XSAVE_POINTER (XCDR (val
), 0);
1875 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1876 val
= make_save_ptr (otf
);
1877 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1883 /* Return a list describing which scripts/languages FONT supports by
1884 which GSUB/GPOS features of OpenType tables. See the comment of
1885 (struct font_driver).otf_capability. */
1888 font_otf_capability (struct font
*font
)
1891 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1894 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1897 for (i
= 0; i
< 2; i
++)
1899 OTF_GSUB_GPOS
*gsub_gpos
;
1900 Lisp_Object script_list
= Qnil
;
1903 if (OTF_get_features (otf
, i
== 0) < 0)
1905 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1906 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1908 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1909 Lisp_Object langsys_list
= Qnil
;
1910 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1913 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1915 OTF_LangSys
*langsys
;
1916 Lisp_Object feature_list
= Qnil
;
1917 Lisp_Object langsys_tag
;
1920 if (k
== script
->LangSysCount
)
1922 langsys
= &script
->DefaultLangSys
;
1927 langsys
= script
->LangSys
+ k
;
1929 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1931 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1933 OTF_Feature
*feature
1934 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1935 Lisp_Object feature_tag
1936 = otf_tag_symbol (feature
->FeatureTag
);
1938 feature_list
= Fcons (feature_tag
, feature_list
);
1940 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1943 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1948 XSETCAR (capability
, script_list
);
1950 XSETCDR (capability
, script_list
);
1956 /* Parse OTF features in SPEC and write a proper features spec string
1957 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1958 assured that the sufficient memory has already allocated for
1962 generate_otf_features (Lisp_Object spec
, char *features
)
1970 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1976 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1981 else if (! asterisk
)
1983 val
= SYMBOL_NAME (val
);
1984 p
+= esprintf (p
, "%s", SDATA (val
));
1988 val
= SYMBOL_NAME (val
);
1989 p
+= esprintf (p
, "~%s", SDATA (val
));
1993 error ("OTF spec too long");
1997 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1999 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2001 return Fcons (make_number (len
),
2002 make_unibyte_string (device_table
->DeltaValue
, len
));
2006 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2008 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2010 if (value_format
& OTF_XPlacement
)
2011 ASET (val
, 0, make_number (value_record
->XPlacement
));
2012 if (value_format
& OTF_YPlacement
)
2013 ASET (val
, 1, make_number (value_record
->YPlacement
));
2014 if (value_format
& OTF_XAdvance
)
2015 ASET (val
, 2, make_number (value_record
->XAdvance
));
2016 if (value_format
& OTF_YAdvance
)
2017 ASET (val
, 3, make_number (value_record
->YAdvance
));
2018 if (value_format
& OTF_XPlaDevice
)
2019 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2020 if (value_format
& OTF_YPlaDevice
)
2021 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2022 if (value_format
& OTF_XAdvDevice
)
2023 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2024 if (value_format
& OTF_YAdvDevice
)
2025 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2030 font_otf_Anchor (OTF_Anchor
*anchor
)
2034 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2035 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2036 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2037 if (anchor
->AnchorFormat
== 2)
2038 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2041 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2042 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2046 #endif /* HAVE_LIBOTF */
2053 font_rescale_ratio (Lisp_Object font_entity
)
2055 Lisp_Object tail
, elt
;
2056 Lisp_Object name
= Qnil
;
2058 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2061 if (FLOATP (XCDR (elt
)))
2063 if (STRINGP (XCAR (elt
)))
2066 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2067 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2068 return XFLOAT_DATA (XCDR (elt
));
2070 else if (FONT_SPEC_P (XCAR (elt
)))
2072 if (font_match_p (XCAR (elt
), font_entity
))
2073 return XFLOAT_DATA (XCDR (elt
));
2080 /* We sort fonts by scoring each of them against a specified
2081 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2082 the value is, the closer the font is to the font-spec.
2084 The lowest 2 bits of the score are used for driver type. The font
2085 available by the most preferred font driver is 0.
2087 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2088 WEIGHT, SLANT, WIDTH, and SIZE. */
2090 /* How many bits to shift to store the difference value of each font
2091 property in a score. Note that floats for FONT_TYPE_INDEX and
2092 FONT_REGISTRY_INDEX are not used. */
2093 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2095 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2096 The return value indicates how different ENTITY is compared with
2100 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2105 /* Score three style numeric fields. Maximum difference is 127. */
2106 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2107 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2109 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2110 - (XINT (spec_prop
[i
]) >> 8));
2111 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2114 /* Score the size. Maximum difference is 127. */
2115 i
= FONT_SIZE_INDEX
;
2116 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2117 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2119 /* We use the higher 6-bit for the actual size difference. The
2120 lowest bit is set if the DPI is different. */
2122 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2124 if (CONSP (Vface_font_rescale_alist
))
2125 pixel_size
*= font_rescale_ratio (entity
);
2126 diff
= eabs (pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
))) << 1;
2127 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2128 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2130 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2131 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2133 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2140 /* Concatenate all elements of LIST into one vector. LIST is a list
2141 of font-entity vectors. */
2144 font_vconcat_entity_vectors (Lisp_Object list
)
2146 int nargs
= XINT (Flength (list
));
2147 Lisp_Object
*args
= alloca (word_size
* nargs
);
2150 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2151 args
[i
] = XCAR (list
);
2152 return Fvconcat (nargs
, args
);
2156 /* The structure for elements being sorted by qsort. */
2157 struct font_sort_data
2160 int font_driver_preference
;
2165 /* The comparison function for qsort. */
2168 font_compare (const void *d1
, const void *d2
)
2170 const struct font_sort_data
*data1
= d1
;
2171 const struct font_sort_data
*data2
= d2
;
2173 if (data1
->score
< data2
->score
)
2175 else if (data1
->score
> data2
->score
)
2177 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2181 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2182 If PREFER specifies a point-size, calculate the corresponding
2183 pixel-size from QCdpi property of PREFER or from the Y-resolution
2184 of FRAME before sorting.
2186 If BEST-ONLY is nonzero, return the best matching entity (that
2187 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2188 if BEST-ONLY is negative). Otherwise, return the sorted result as
2189 a single vector of font-entities.
2191 This function does no optimization for the case that the total
2192 number of elements is 1. The caller should avoid calling this in
2196 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2197 struct frame
*f
, int best_only
)
2199 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2201 struct font_sort_data
*data
;
2202 unsigned best_score
;
2203 Lisp_Object best_entity
;
2204 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2207 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2208 prefer_prop
[i
] = AREF (prefer
, i
);
2209 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2210 prefer_prop
[FONT_SIZE_INDEX
]
2211 = make_number (font_pixel_size (f
, prefer
));
2213 if (NILP (XCDR (list
)))
2215 /* What we have to take care of is this single vector. */
2217 maxlen
= ASIZE (vec
);
2221 /* We don't have to perform sort, so there's no need of creating
2222 a single vector. But, we must find the length of the longest
2225 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2226 if (maxlen
< ASIZE (XCAR (tail
)))
2227 maxlen
= ASIZE (XCAR (tail
));
2231 /* We have to create a single vector to sort it. */
2232 vec
= font_vconcat_entity_vectors (list
);
2233 maxlen
= ASIZE (vec
);
2236 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2237 best_score
= 0xFFFFFFFF;
2240 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2242 int font_driver_preference
= 0;
2243 Lisp_Object current_font_driver
;
2249 /* We are sure that the length of VEC > 0. */
2250 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2251 /* Score the elements. */
2252 for (i
= 0; i
< len
; i
++)
2254 data
[i
].entity
= AREF (vec
, i
);
2256 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2258 ? font_score (data
[i
].entity
, prefer_prop
)
2260 if (best_only
&& best_score
> data
[i
].score
)
2262 best_score
= data
[i
].score
;
2263 best_entity
= data
[i
].entity
;
2264 if (best_score
== 0)
2267 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2269 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2270 font_driver_preference
++;
2272 data
[i
].font_driver_preference
= font_driver_preference
;
2275 /* Sort if necessary. */
2278 qsort (data
, len
, sizeof *data
, font_compare
);
2279 for (i
= 0; i
< len
; i
++)
2280 ASET (vec
, i
, data
[i
].entity
);
2289 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2294 /* API of Font Service Layer. */
2296 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2297 sort_shift_bits. Finternal_set_font_selection_order calls this
2298 function with font_sort_order after setting up it. */
2301 font_update_sort_order (int *order
)
2305 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2307 int xlfd_idx
= order
[i
];
2309 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2310 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2311 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2312 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2313 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2314 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2316 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2321 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2322 Lisp_Object features
, Lisp_Object table
)
2327 table
= assq_no_quit (script
, table
);
2330 table
= XCDR (table
);
2331 if (! NILP (langsys
))
2333 table
= assq_no_quit (langsys
, table
);
2339 val
= assq_no_quit (Qnil
, table
);
2341 table
= XCAR (table
);
2345 table
= XCDR (table
);
2346 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2348 if (NILP (XCAR (features
)))
2353 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2359 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2362 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2364 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2366 script
= XCAR (spec
);
2370 langsys
= XCAR (spec
);
2381 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2382 XCAR (otf_capability
)))
2384 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2385 XCDR (otf_capability
)))
2392 /* Check if FONT (font-entity or font-object) matches with the font
2393 specification SPEC. */
2396 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2398 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2399 Lisp_Object extra
, font_extra
;
2402 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2403 if (! NILP (AREF (spec
, i
))
2404 && ! NILP (AREF (font
, i
))
2405 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2407 props
= XFONT_SPEC (spec
)->props
;
2408 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2410 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2411 prop
[i
] = AREF (spec
, i
);
2412 prop
[FONT_SIZE_INDEX
]
2413 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2417 if (font_score (font
, props
) > 0)
2419 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2420 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2421 for (; CONSP (extra
); extra
= XCDR (extra
))
2423 Lisp_Object key
= XCAR (XCAR (extra
));
2424 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2426 if (EQ (key
, QClang
))
2428 val2
= assq_no_quit (key
, font_extra
);
2437 if (NILP (Fmemq (val
, val2
)))
2442 ? NILP (Fmemq (val
, XCDR (val2
)))
2446 else if (EQ (key
, QCscript
))
2448 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2454 /* All characters in the list must be supported. */
2455 for (; CONSP (val2
); val2
= XCDR (val2
))
2457 if (! CHARACTERP (XCAR (val2
)))
2459 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2460 == FONT_INVALID_CODE
)
2464 else if (VECTORP (val2
))
2466 /* At most one character in the vector must be supported. */
2467 for (i
= 0; i
< ASIZE (val2
); i
++)
2469 if (! CHARACTERP (AREF (val2
, i
)))
2471 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2472 != FONT_INVALID_CODE
)
2475 if (i
== ASIZE (val2
))
2480 else if (EQ (key
, QCotf
))
2484 if (! FONT_OBJECT_P (font
))
2486 fontp
= XFONT_OBJECT (font
);
2487 if (! fontp
->driver
->otf_capability
)
2489 val2
= fontp
->driver
->otf_capability (fontp
);
2490 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2501 Each font backend has the callback function get_cache, and it
2502 returns a cons cell of which cdr part can be freely used for
2503 caching fonts. The cons cell may be shared by multiple frames
2504 and/or multiple font drivers. So, we arrange the cdr part as this:
2506 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2508 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2509 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2510 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2512 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2513 static void font_finish_cache (struct frame
*, struct font_driver
*);
2514 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2515 static void font_clear_cache (struct frame
*, Lisp_Object
,
2516 struct font_driver
*);
2519 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2521 Lisp_Object cache
, val
;
2523 cache
= driver
->get_cache (f
);
2525 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2529 val
= list2 (driver
->type
, make_number (1));
2530 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2534 val
= XCDR (XCAR (val
));
2535 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2541 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2543 Lisp_Object cache
, val
, tmp
;
2546 cache
= driver
->get_cache (f
);
2548 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2549 cache
= val
, val
= XCDR (val
);
2550 eassert (! NILP (val
));
2551 tmp
= XCDR (XCAR (val
));
2552 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2553 if (XINT (XCAR (tmp
)) == 0)
2555 font_clear_cache (f
, XCAR (val
), driver
);
2556 XSETCDR (cache
, XCDR (val
));
2562 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2564 Lisp_Object val
= driver
->get_cache (f
);
2565 Lisp_Object type
= driver
->type
;
2567 eassert (CONSP (val
));
2568 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2569 eassert (CONSP (val
));
2570 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2571 val
= XCDR (XCAR (val
));
2577 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2579 Lisp_Object tail
, elt
;
2583 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2584 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2587 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2588 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2591 eassert (VECTORP (elt
));
2592 for (i
= 0; i
< ASIZE (elt
); i
++)
2594 entity
= AREF (elt
, i
);
2596 if (FONT_ENTITY_P (entity
)
2597 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2599 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2601 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2603 Lisp_Object val
= XCAR (objlist
);
2604 struct font
*font
= XFONT_OBJECT (val
);
2606 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2608 eassert (font
&& driver
== font
->driver
);
2609 driver
->close (font
);
2612 if (driver
->free_entity
)
2613 driver
->free_entity (entity
);
2618 XSETCDR (cache
, Qnil
);
2622 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2624 /* Check each font-entity in VEC, and return a list of font-entities
2625 that satisfy these conditions:
2626 (1) matches with SPEC and SIZE if SPEC is not nil, and
2627 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2631 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2633 Lisp_Object entity
, val
;
2634 enum font_property_index prop
;
2637 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2639 entity
= AREF (vec
, i
);
2640 if (! NILP (Vface_ignored_fonts
))
2644 Lisp_Object tail
, regexp
;
2646 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2649 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2651 regexp
= XCAR (tail
);
2652 if (STRINGP (regexp
)
2653 && fast_c_string_match_ignore_case (regexp
, name
,
2663 val
= Fcons (entity
, val
);
2666 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2667 if (INTEGERP (AREF (spec
, prop
))
2668 && ((XINT (AREF (spec
, prop
)) >> 8)
2669 != (XINT (AREF (entity
, prop
)) >> 8)))
2670 prop
= FONT_SPEC_MAX
;
2671 if (prop
< FONT_SPEC_MAX
2673 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2675 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2677 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2678 prop
= FONT_SPEC_MAX
;
2680 if (prop
< FONT_SPEC_MAX
2681 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2682 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2683 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2684 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2685 prop
= FONT_SPEC_MAX
;
2686 if (prop
< FONT_SPEC_MAX
2687 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2688 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2689 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2690 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2691 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2692 prop
= FONT_SPEC_MAX
;
2693 if (prop
< FONT_SPEC_MAX
)
2694 val
= Fcons (entity
, val
);
2696 return (Fvconcat (1, &val
));
2700 /* Return a list of vectors of font-entities matching with SPEC on
2701 FRAME. Each elements in the list is a vector of entities from the
2702 same font-driver. */
2705 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2707 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2708 Lisp_Object ftype
, val
;
2709 Lisp_Object list
= Qnil
;
2711 bool need_filtering
= 0;
2714 eassert (FONT_SPEC_P (spec
));
2716 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2717 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2718 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2719 size
= font_pixel_size (f
, spec
);
2723 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2724 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2725 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2726 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2727 if (i
!= FONT_SPACING_INDEX
)
2729 ASET (scratch_font_spec
, i
, Qnil
);
2730 if (! NILP (AREF (spec
, i
)))
2733 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2734 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2736 for (; driver_list
; driver_list
= driver_list
->next
)
2738 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2740 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2742 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2743 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2748 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2751 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2753 val
= Fvconcat (1, &val
);
2754 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2755 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2758 if (VECTORP (val
) && ASIZE (val
) > 0
2760 || ! NILP (Vface_ignored_fonts
)))
2761 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2762 if (VECTORP (val
) && ASIZE (val
) > 0)
2763 list
= Fcons (val
, list
);
2766 list
= Fnreverse (list
);
2767 FONT_ADD_LOG ("list", spec
, list
);
2772 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2773 nil, is an array of face's attributes, which specifies preferred
2774 font-related attributes. */
2777 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2779 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2780 Lisp_Object ftype
, size
, entity
;
2781 Lisp_Object work
= copy_font_spec (spec
);
2783 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2784 size
= AREF (spec
, FONT_SIZE_INDEX
);
2787 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2788 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2789 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2790 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2793 for (; driver_list
; driver_list
= driver_list
->next
)
2795 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2797 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2799 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2800 entity
= assoc_no_quit (work
, XCDR (cache
));
2802 entity
= AREF (XCDR (entity
), 0);
2805 entity
= driver_list
->driver
->match (f
, work
);
2808 Lisp_Object copy
= copy_font_spec (work
);
2809 Lisp_Object match
= Fvector (1, &entity
);
2811 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2812 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2815 if (! NILP (entity
))
2818 FONT_ADD_LOG ("match", work
, entity
);
2823 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2824 opened font object. */
2827 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2829 struct font_driver_list
*driver_list
;
2830 Lisp_Object objlist
, size
, val
, font_object
;
2832 int min_width
, height
, psize
;
2834 eassert (FONT_ENTITY_P (entity
));
2835 size
= AREF (entity
, FONT_SIZE_INDEX
);
2836 if (XINT (size
) != 0)
2837 pixel_size
= XINT (size
);
2839 val
= AREF (entity
, FONT_TYPE_INDEX
);
2840 for (driver_list
= f
->font_driver_list
;
2841 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2842 driver_list
= driver_list
->next
);
2846 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2847 objlist
= XCDR (objlist
))
2849 Lisp_Object fn
= XCAR (objlist
);
2850 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2851 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2853 if (driver_list
->driver
->cached_font_ok
== NULL
2854 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2859 /* We always open a font of manageable size; i.e non-zero average
2860 width and height. */
2861 for (psize
= pixel_size
; ; psize
++)
2863 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2864 if (NILP (font_object
))
2866 font
= XFONT_OBJECT (font_object
);
2867 if (font
->average_width
> 0 && font
->height
> 0)
2870 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2871 FONT_ADD_LOG ("open", entity
, font_object
);
2872 ASET (entity
, FONT_OBJLIST_INDEX
,
2873 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2875 font
= XFONT_OBJECT (font_object
);
2876 min_width
= (font
->min_width
? font
->min_width
2877 : font
->average_width
? font
->average_width
2878 : font
->space_width
? font
->space_width
2880 height
= (font
->height
? font
->height
: 1);
2881 #ifdef HAVE_WINDOW_SYSTEM
2882 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2883 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2885 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2886 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2887 f
->fonts_changed
= 1;
2891 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2892 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2893 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2894 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2902 /* Close FONT_OBJECT that is opened on frame F. */
2905 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2907 struct font
*font
= XFONT_OBJECT (font_object
);
2909 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2910 /* Already closed. */
2912 FONT_ADD_LOG ("close", font_object
, Qnil
);
2913 font
->driver
->close (font
);
2914 #ifdef HAVE_WINDOW_SYSTEM
2915 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2916 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2921 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2922 FONT is a font-entity and it must be opened to check. */
2925 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2929 if (FONT_ENTITY_P (font
))
2931 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2932 struct font_driver_list
*driver_list
;
2934 for (driver_list
= f
->font_driver_list
;
2935 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2936 driver_list
= driver_list
->next
);
2939 if (! driver_list
->driver
->has_char
)
2941 return driver_list
->driver
->has_char (font
, c
);
2944 eassert (FONT_OBJECT_P (font
));
2945 fontp
= XFONT_OBJECT (font
);
2946 if (fontp
->driver
->has_char
)
2948 int result
= fontp
->driver
->has_char (font
, c
);
2953 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2957 /* Return the glyph ID of FONT_OBJECT for character C. */
2960 font_encode_char (Lisp_Object font_object
, int c
)
2964 eassert (FONT_OBJECT_P (font_object
));
2965 font
= XFONT_OBJECT (font_object
);
2966 return font
->driver
->encode_char (font
, c
);
2970 /* Return the name of FONT_OBJECT. */
2973 font_get_name (Lisp_Object font_object
)
2975 eassert (FONT_OBJECT_P (font_object
));
2976 return AREF (font_object
, FONT_NAME_INDEX
);
2980 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2981 could not be parsed by font_parse_name, return Qnil. */
2984 font_spec_from_name (Lisp_Object font_name
)
2986 Lisp_Object spec
= Ffont_spec (0, NULL
);
2988 CHECK_STRING (font_name
);
2989 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2991 font_put_extra (spec
, QCname
, font_name
);
2992 font_put_extra (spec
, QCuser_spec
, font_name
);
2998 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3000 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3005 if (! NILP (Ffont_get (font
, QCname
)))
3007 font
= copy_font_spec (font
);
3008 font_put_extra (font
, QCname
, Qnil
);
3011 if (NILP (AREF (font
, prop
))
3012 && prop
!= FONT_FAMILY_INDEX
3013 && prop
!= FONT_FOUNDRY_INDEX
3014 && prop
!= FONT_WIDTH_INDEX
3015 && prop
!= FONT_SIZE_INDEX
)
3017 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3018 font
= copy_font_spec (font
);
3019 ASET (font
, prop
, Qnil
);
3020 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3022 if (prop
== FONT_FAMILY_INDEX
)
3024 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3025 /* If we are setting the font family, we must also clear
3026 FONT_WIDTH_INDEX to avoid rejecting families that lack
3027 support for some widths. */
3028 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3030 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3031 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3032 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3033 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3034 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3035 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3037 else if (prop
== FONT_SIZE_INDEX
)
3039 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3040 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3041 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3043 else if (prop
== FONT_WIDTH_INDEX
)
3044 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3045 attrs
[LFACE_FONT_INDEX
] = font
;
3048 /* Select a font from ENTITIES (list of font-entity vectors) that
3049 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3052 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3053 Lisp_Object
*attrs
, int pixel_size
, int c
)
3055 Lisp_Object font_entity
;
3059 if (NILP (XCDR (entities
))
3060 && ASIZE (XCAR (entities
)) == 1)
3062 font_entity
= AREF (XCAR (entities
), 0);
3063 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3068 /* Sort fonts by properties specified in ATTRS. */
3069 prefer
= scratch_font_prefer
;
3071 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3072 ASET (prefer
, i
, Qnil
);
3073 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3075 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3077 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3078 ASET (prefer
, i
, AREF (face_font
, i
));
3080 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3081 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3082 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3083 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3084 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3085 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3086 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3088 return font_sort_entities (entities
, prefer
, f
, c
);
3091 /* Return a font-entity that satisfies SPEC and is the best match for
3092 face's font related attributes in ATTRS. C, if not negative, is a
3093 character that the entity must support. */
3096 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3099 Lisp_Object entities
, val
;
3100 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3105 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3106 if (NILP (registry
[0]))
3108 registry
[0] = DEFAULT_ENCODING
;
3109 registry
[1] = Qascii_0
;
3110 registry
[2] = zero_vector
;
3113 registry
[1] = zero_vector
;
3115 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3117 struct charset
*encoding
, *repertory
;
3119 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3120 &encoding
, &repertory
) < 0)
3123 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3125 else if (c
> encoding
->max_char
)
3129 work
= copy_font_spec (spec
);
3130 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3131 pixel_size
= font_pixel_size (f
, spec
);
3132 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3134 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3136 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3140 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3141 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3142 if (! NILP (foundry
[0]))
3143 foundry
[1] = zero_vector
;
3144 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3146 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3147 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3149 foundry
[2] = zero_vector
;
3152 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3154 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3155 if (! NILP (adstyle
[0]))
3156 adstyle
[1] = zero_vector
;
3157 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3159 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3161 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3163 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3165 adstyle
[2] = zero_vector
;
3168 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3171 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3174 val
= AREF (work
, FONT_FAMILY_INDEX
);
3175 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3177 val
= attrs
[LFACE_FAMILY_INDEX
];
3178 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3182 family
= alloca ((sizeof family
[0]) * 2);
3184 family
[1] = zero_vector
; /* terminator. */
3189 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3191 if (! NILP (alters
))
3193 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3194 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3195 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3196 family
[i
] = XCAR (alters
);
3197 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3199 family
[i
] = zero_vector
;
3203 family
= alloca ((sizeof family
[0]) * 3);
3206 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3208 family
[i
] = zero_vector
;
3212 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3214 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3215 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3217 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3218 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3220 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3221 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3223 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3224 entities
= font_list_entities (f
, work
);
3225 if (! NILP (entities
))
3227 val
= font_select_entity (f
, entities
,
3228 attrs
, pixel_size
, c
);
3246 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3250 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3251 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3252 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3255 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3256 size
= font_pixel_size (f
, spec
);
3260 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3261 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3264 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3265 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3266 eassert (INTEGERP (height
));
3271 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3275 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3276 size
= (NUMBERP (ffsize
)
3277 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3281 size
*= font_rescale_ratio (entity
);
3284 return font_open_entity (f
, entity
, size
);
3288 /* Find a font that satisfies SPEC and is the best match for
3289 face's attributes in ATTRS on FRAME, and return the opened
3293 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3295 Lisp_Object entity
, name
;
3297 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3300 /* No font is listed for SPEC, but each font-backend may have
3301 different criteria about "font matching". So, try it. */
3302 entity
= font_matching_entity (f
, attrs
, spec
);
3306 /* Don't lose the original name that was put in initially. We need
3307 it to re-apply the font when font parameters (like hinting or dpi) have
3309 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3312 name
= Ffont_get (spec
, QCuser_spec
);
3313 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3319 /* Make FACE on frame F ready to use the font opened for FACE. */
3322 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3324 if (face
->font
->driver
->prepare_face
)
3325 face
->font
->driver
->prepare_face (f
, face
);
3329 /* Make FACE on frame F stop using the font opened for FACE. */
3332 font_done_for_face (struct frame
*f
, struct face
*face
)
3334 if (face
->font
->driver
->done_face
)
3335 face
->font
->driver
->done_face (f
, face
);
3339 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3340 font is found, return Qnil. */
3343 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3345 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3347 /* We set up the default font-related attributes of a face to prefer
3349 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3350 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3351 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3353 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3355 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3357 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3359 return font_load_for_lface (f
, attrs
, spec
);
3363 /* Open a font that matches NAME on frame F. If no proper font is
3364 found, return Qnil. */
3367 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3369 Lisp_Object args
[2];
3370 Lisp_Object spec
, ret
;
3374 spec
= Ffont_spec (2, args
);
3375 ret
= font_open_by_spec (f
, spec
);
3376 /* Do not lose name originally put in. */
3378 font_put_extra (ret
, QCuser_spec
, args
[1]);
3384 /* Register font-driver DRIVER. This function is used in two ways.
3386 The first is with frame F non-NULL. In this case, make DRIVER
3387 available (but not yet activated) on F. All frame creators
3388 (e.g. Fx_create_frame) must call this function at least once with
3389 an available font-driver.
3391 The second is with frame F NULL. In this case, DRIVER is globally
3392 registered in the variable `font_driver_list'. All font-driver
3393 implementations must call this function in its syms_of_XXXX
3394 (e.g. syms_of_xfont). */
3397 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3399 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3400 struct font_driver_list
*prev
, *list
;
3402 #ifdef HAVE_WINDOW_SYSTEM
3403 if (f
&& ! driver
->draw
)
3404 error ("Unusable font driver for a frame: %s",
3405 SDATA (SYMBOL_NAME (driver
->type
)));
3406 #endif /* HAVE_WINDOW_SYSTEM */
3408 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3409 if (EQ (list
->driver
->type
, driver
->type
))
3410 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3412 list
= xmalloc (sizeof *list
);
3414 list
->driver
= driver
;
3419 f
->font_driver_list
= list
;
3421 font_driver_list
= list
;
3427 free_font_driver_list (struct frame
*f
)
3429 struct font_driver_list
*list
, *next
;
3431 for (list
= f
->font_driver_list
; list
; list
= next
)
3436 f
->font_driver_list
= NULL
;
3440 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3441 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3442 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3444 A caller must free all realized faces if any in advance. The
3445 return value is a list of font backends actually made used on
3449 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3451 Lisp_Object active_drivers
= Qnil
;
3452 struct font_driver_list
*list
;
3454 /* At first, turn off non-requested drivers, and turn on requested
3456 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3458 struct font_driver
*driver
= list
->driver
;
3459 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3464 if (driver
->end_for_frame
)
3465 driver
->end_for_frame (f
);
3466 font_finish_cache (f
, driver
);
3471 if (! driver
->start_for_frame
3472 || driver
->start_for_frame (f
) == 0)
3474 font_prepare_cache (f
, driver
);
3481 if (NILP (new_drivers
))
3484 if (! EQ (new_drivers
, Qt
))
3486 /* Re-order the driver list according to new_drivers. */
3487 struct font_driver_list
**list_table
, **next
;
3491 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3492 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3494 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3495 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3498 list_table
[i
++] = list
;
3500 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3502 list_table
[i
++] = list
;
3503 list_table
[i
] = NULL
;
3505 next
= &f
->font_driver_list
;
3506 for (i
= 0; list_table
[i
]; i
++)
3508 *next
= list_table
[i
];
3509 next
= &(*next
)->next
;
3513 if (! f
->font_driver_list
->on
)
3514 { /* None of the drivers is enabled: enable them all.
3515 Happens if you set the list of drivers to (xft x) in your .emacs
3516 and then use it under w32 or ns. */
3517 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3519 struct font_driver
*driver
= list
->driver
;
3520 eassert (! list
->on
);
3521 if (! driver
->start_for_frame
3522 || driver
->start_for_frame (f
) == 0)
3524 font_prepare_cache (f
, driver
);
3531 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3533 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3534 return active_drivers
;
3538 font_put_frame_data (struct frame
*f
, struct font_driver
*driver
, void *data
)
3540 struct font_data_list
*list
, *prev
;
3542 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3543 prev
= list
, list
= list
->next
)
3544 if (list
->driver
== driver
)
3551 prev
->next
= list
->next
;
3553 f
->font_data_list
= list
->next
;
3561 list
= xmalloc (sizeof *list
);
3562 list
->driver
= driver
;
3563 list
->next
= f
->font_data_list
;
3564 f
->font_data_list
= list
;
3572 font_get_frame_data (struct frame
*f
, struct font_driver
*driver
)
3574 struct font_data_list
*list
;
3576 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3577 if (list
->driver
== driver
)
3585 /* Sets attributes on a font. Any properties that appear in ALIST and
3586 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3587 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3588 arrays of strings. This function is intended for use by the font
3589 drivers to implement their specific font_filter_properties. */
3591 font_filter_properties (Lisp_Object font
,
3593 const char *const boolean_properties
[],
3594 const char *const non_boolean_properties
[])
3599 /* Set boolean values to Qt or Qnil. */
3600 for (i
= 0; 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
));
3607 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3609 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3610 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3613 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3614 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3615 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3616 || strcmp ("Off", str
) == 0)
3621 Ffont_put (font
, key
, val
);
3625 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3626 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3628 Lisp_Object key
= XCAR (XCAR (it
));
3629 Lisp_Object val
= XCDR (XCAR (it
));
3630 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3631 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3632 Ffont_put (font
, key
, val
);
3637 /* Return the font used to draw character C by FACE at buffer position
3638 POS in window W. If STRING is non-nil, it is a string containing C
3639 at index POS. If C is negative, get C from the current buffer or
3643 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3648 Lisp_Object font_object
;
3650 multibyte
= (NILP (string
)
3651 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3652 : STRING_MULTIBYTE (string
));
3659 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3661 c
= FETCH_CHAR (pos_byte
);
3664 c
= FETCH_BYTE (pos
);
3670 multibyte
= STRING_MULTIBYTE (string
);
3673 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3675 str
= SDATA (string
) + pos_byte
;
3676 c
= STRING_CHAR (str
);
3679 c
= SDATA (string
)[pos
];
3683 f
= XFRAME (w
->frame
);
3684 if (! FRAME_WINDOW_P (f
))
3691 if (STRINGP (string
))
3692 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3693 DEFAULT_FACE_ID
, 0);
3695 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3697 face
= FACE_FROM_ID (f
, face_id
);
3701 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3702 face
= FACE_FROM_ID (f
, face_id
);
3707 XSETFONT (font_object
, face
->font
);
3712 #ifdef HAVE_WINDOW_SYSTEM
3714 /* Check how many characters after character/byte position POS/POS_BYTE
3715 (at most to *LIMIT) can be displayed by the same font in the window W.
3716 FACE, if non-NULL, is the face selected for the character at POS.
3717 If STRING is not nil, it is the string to check instead of the current
3718 buffer. In that case, FACE must be not NULL.
3720 The return value is the font-object for the character at POS.
3721 *LIMIT is set to the position where that font can't be used.
3723 It is assured that the current buffer (or STRING) is multibyte. */
3726 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3727 struct window
*w
, struct face
*face
, Lisp_Object string
)
3731 Lisp_Object font_object
= Qnil
;
3739 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3741 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3747 while (pos
< *limit
)
3749 Lisp_Object category
;
3752 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3754 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3755 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3756 if (INTEGERP (category
)
3757 && (XINT (category
) == UNICODE_CATEGORY_Cf
3758 || CHAR_VARIATION_SELECTOR_P (c
)))
3760 if (NILP (font_object
))
3762 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3763 if (NILP (font_object
))
3767 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3777 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3778 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3779 Return nil otherwise.
3780 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3781 which kind of font it is. It must be one of `font-spec', `font-entity',
3783 (Lisp_Object object
, Lisp_Object extra_type
)
3785 if (NILP (extra_type
))
3786 return (FONTP (object
) ? Qt
: Qnil
);
3787 if (EQ (extra_type
, Qfont_spec
))
3788 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3789 if (EQ (extra_type
, Qfont_entity
))
3790 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3791 if (EQ (extra_type
, Qfont_object
))
3792 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3793 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3796 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3797 doc
: /* Return a newly created font-spec with arguments as properties.
3799 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3800 valid font property name listed below:
3802 `:family', `:weight', `:slant', `:width'
3804 They are the same as face attributes of the same name. See
3805 `set-face-attribute'.
3809 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3813 VALUE must be a string or a symbol specifying the additional
3814 typographic style information of a font, e.g. ``sans''.
3818 VALUE must be a string or a symbol specifying the charset registry and
3819 encoding of a font, e.g. ``iso8859-1''.
3823 VALUE must be a non-negative integer or a floating point number
3824 specifying the font size. It specifies the font size in pixels (if
3825 VALUE is an integer), or in points (if VALUE is a float).
3829 VALUE must be a string of XLFD-style or fontconfig-style font name.
3833 VALUE must be a symbol representing a script that the font must
3834 support. It may be a symbol representing a subgroup of a script
3835 listed in the variable `script-representative-chars'.
3839 VALUE must be a symbol of two-letter ISO-639 language names,
3844 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3845 required OpenType features.
3847 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3848 LANGSYS-TAG: OpenType language system tag symbol,
3849 or nil for the default language system.
3850 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3851 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3853 GSUB and GPOS may contain `nil' element. In such a case, the font
3854 must not have any of the remaining elements.
3856 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3857 be an OpenType font whose GPOS table of `thai' script's default
3858 language system must contain `mark' feature.
3860 usage: (font-spec ARGS...) */)
3861 (ptrdiff_t nargs
, Lisp_Object
*args
)
3863 Lisp_Object spec
= font_make_spec ();
3866 for (i
= 0; i
< nargs
; i
+= 2)
3868 Lisp_Object key
= args
[i
], val
;
3872 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3875 if (EQ (key
, QCname
))
3878 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3879 error ("Invalid font name: %s", SSDATA (val
));
3880 font_put_extra (spec
, key
, val
);
3884 int idx
= get_font_prop_index (key
);
3888 val
= font_prop_validate (idx
, Qnil
, val
);
3889 if (idx
< FONT_EXTRA_INDEX
)
3890 ASET (spec
, idx
, val
);
3892 font_put_extra (spec
, key
, val
);
3895 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3901 /* Return a copy of FONT as a font-spec. */
3903 copy_font_spec (Lisp_Object font
)
3905 Lisp_Object new_spec
, tail
, prev
, extra
;
3909 new_spec
= font_make_spec ();
3910 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3911 ASET (new_spec
, i
, AREF (font
, i
));
3912 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3913 /* We must remove :font-entity property. */
3914 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3915 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3918 extra
= XCDR (extra
);
3920 XSETCDR (prev
, XCDR (tail
));
3923 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3927 /* Merge font-specs FROM and TO, and return a new font-spec.
3928 Every specified property in FROM overrides the corresponding
3931 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3933 Lisp_Object extra
, tail
;
3938 to
= copy_font_spec (to
);
3939 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3940 ASET (to
, i
, AREF (from
, i
));
3941 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3942 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3943 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3945 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3948 XSETCDR (slot
, XCDR (XCAR (tail
)));
3950 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3952 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3956 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3957 doc
: /* Return the value of FONT's property KEY.
3958 FONT is a font-spec, a font-entity, or a font-object.
3959 KEY is any symbol, but these are reserved for specific meanings:
3960 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3961 :size, :name, :script, :otf
3962 See the documentation of `font-spec' for their meanings.
3963 In addition, if FONT is a font-entity or a font-object, values of
3964 :script and :otf are different from those of a font-spec as below:
3966 The value of :script may be a list of scripts that are supported by the font.
3968 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3969 representing the OpenType features supported by the font by this form:
3970 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3971 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3973 (Lisp_Object font
, Lisp_Object key
)
3981 idx
= get_font_prop_index (key
);
3982 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3983 return font_style_symbolic (font
, idx
, 0);
3984 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3985 return AREF (font
, idx
);
3986 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3987 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3989 struct font
*fontp
= XFONT_OBJECT (font
);
3991 if (fontp
->driver
->otf_capability
)
3992 val
= fontp
->driver
->otf_capability (fontp
);
3994 val
= Fcons (Qnil
, Qnil
);
4001 #ifdef HAVE_WINDOW_SYSTEM
4003 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4004 doc
: /* Return a plist of face attributes generated by FONT.
4005 FONT is a font name, a font-spec, a font-entity, or a font-object.
4006 The return value is a list of the form
4008 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4010 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4011 compatible with `set-face-attribute'. Some of these key-attribute pairs
4012 may be omitted from the list if they are not specified by FONT.
4014 The optional argument FRAME specifies the frame that the face attributes
4015 are to be displayed on. If omitted, the selected frame is used. */)
4016 (Lisp_Object font
, Lisp_Object frame
)
4018 struct frame
*f
= decode_live_frame (frame
);
4019 Lisp_Object plist
[10];
4025 int fontset
= fs_query_fontset (font
, 0);
4026 Lisp_Object name
= font
;
4028 font
= fontset_ascii (fontset
);
4029 font
= font_spec_from_name (name
);
4031 signal_error ("Invalid font name", name
);
4033 else if (! FONTP (font
))
4034 signal_error ("Invalid font object", font
);
4036 val
= AREF (font
, FONT_FAMILY_INDEX
);
4039 plist
[n
++] = QCfamily
;
4040 plist
[n
++] = SYMBOL_NAME (val
);
4043 val
= AREF (font
, FONT_SIZE_INDEX
);
4046 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4047 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4048 plist
[n
++] = QCheight
;
4049 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4051 else if (FLOATP (val
))
4053 plist
[n
++] = QCheight
;
4054 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4057 val
= FONT_WEIGHT_FOR_FACE (font
);
4060 plist
[n
++] = QCweight
;
4064 val
= FONT_SLANT_FOR_FACE (font
);
4067 plist
[n
++] = QCslant
;
4071 val
= FONT_WIDTH_FOR_FACE (font
);
4074 plist
[n
++] = QCwidth
;
4078 return Flist (n
, plist
);
4083 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4084 doc
: /* Set one property of FONT: give property KEY value VAL.
4085 FONT is a font-spec, a font-entity, or a font-object.
4087 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4088 accepted by the function `font-spec' (which see), VAL must be what
4089 allowed in `font-spec'.
4091 If FONT is a font-entity or a font-object, KEY must not be the one
4092 accepted by `font-spec'. */)
4093 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4097 idx
= get_font_prop_index (prop
);
4098 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4100 CHECK_FONT_SPEC (font
);
4101 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4105 if (EQ (prop
, QCname
)
4106 || EQ (prop
, QCscript
)
4107 || EQ (prop
, QClang
)
4108 || EQ (prop
, QCotf
))
4109 CHECK_FONT_SPEC (font
);
4112 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4117 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4118 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4119 Optional 2nd argument FRAME specifies the target frame.
4120 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4121 Optional 4th argument PREFER, if non-nil, is a font-spec to
4122 control the order of the returned list. Fonts are sorted by
4123 how close they are to PREFER. */)
4124 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4126 struct frame
*f
= decode_live_frame (frame
);
4127 Lisp_Object vec
, list
;
4130 CHECK_FONT_SPEC (font_spec
);
4138 if (! NILP (prefer
))
4139 CHECK_FONT_SPEC (prefer
);
4141 list
= font_list_entities (f
, font_spec
);
4144 if (NILP (XCDR (list
))
4145 && ASIZE (XCAR (list
)) == 1)
4146 return list1 (AREF (XCAR (list
), 0));
4148 if (! NILP (prefer
))
4149 vec
= font_sort_entities (list
, prefer
, f
, 0);
4151 vec
= font_vconcat_entity_vectors (list
);
4152 if (n
== 0 || n
>= ASIZE (vec
))
4154 Lisp_Object args
[2];
4158 list
= Fappend (2, args
);
4162 for (list
= Qnil
, n
--; n
>= 0; n
--)
4163 list
= Fcons (AREF (vec
, n
), list
);
4168 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4169 doc
: /* List available font families on the current frame.
4170 If FRAME is omitted or nil, the selected frame is used. */)
4173 struct frame
*f
= decode_live_frame (frame
);
4174 struct font_driver_list
*driver_list
;
4175 Lisp_Object list
= Qnil
;
4177 for (driver_list
= f
->font_driver_list
; driver_list
;
4178 driver_list
= driver_list
->next
)
4179 if (driver_list
->driver
->list_family
)
4181 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4182 Lisp_Object tail
= list
;
4184 for (; CONSP (val
); val
= XCDR (val
))
4185 if (NILP (Fmemq (XCAR (val
), tail
))
4186 && SYMBOLP (XCAR (val
)))
4187 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4192 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4193 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4194 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4195 (Lisp_Object font_spec
, Lisp_Object frame
)
4197 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4204 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4205 doc
: /* Return XLFD name of FONT.
4206 FONT is a font-spec, font-entity, or font-object.
4207 If the name is too long for XLFD (maximum 255 chars), return nil.
4208 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4209 the consecutive wildcards are folded into one. */)
4210 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4213 int namelen
, pixel_size
= 0;
4217 if (FONT_OBJECT_P (font
))
4219 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4221 if (STRINGP (font_name
)
4222 && SDATA (font_name
)[0] == '-')
4224 if (NILP (fold_wildcards
))
4226 strcpy (name
, SSDATA (font_name
));
4227 namelen
= SBYTES (font_name
);
4230 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4232 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4236 if (! NILP (fold_wildcards
))
4238 char *p0
= name
, *p1
;
4240 while ((p1
= strstr (p0
, "-*-*")))
4242 strcpy (p1
, p1
+ 2);
4248 return make_string (name
, namelen
);
4252 clear_font_cache (struct frame
*f
)
4254 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4256 for (; driver_list
; driver_list
= driver_list
->next
)
4257 if (driver_list
->on
)
4259 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4263 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4265 eassert (! NILP (val
));
4266 tmp
= XCDR (XCAR (val
));
4267 if (XINT (XCAR (tmp
)) == 0)
4269 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4270 XSETCDR (cache
, XCDR (val
));
4275 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4276 doc
: /* Clear font cache of each frame. */)
4279 Lisp_Object list
, frame
;
4281 FOR_EACH_FRAME (list
, frame
)
4282 clear_font_cache (XFRAME (frame
));
4289 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4291 struct font
*font
= XFONT_OBJECT (font_object
);
4292 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4293 struct font_metrics metrics
;
4295 LGLYPH_SET_CODE (glyph
, code
);
4296 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4297 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4298 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4299 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4300 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4301 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4305 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4306 doc
: /* Shape the glyph-string GSTRING.
4307 Shaping means substituting glyphs and/or adjusting positions of glyphs
4308 to get the correct visual image of character sequences set in the
4309 header of the glyph-string.
4311 If the shaping was successful, the value is GSTRING itself or a newly
4312 created glyph-string. Otherwise, the value is nil.
4314 See the documentation of `composition-get-gstring' for the format of
4316 (Lisp_Object gstring
)
4319 Lisp_Object font_object
, n
, glyph
;
4320 ptrdiff_t i
, from
, to
;
4322 if (! composition_gstring_p (gstring
))
4323 signal_error ("Invalid glyph-string: ", gstring
);
4324 if (! NILP (LGSTRING_ID (gstring
)))
4326 font_object
= LGSTRING_FONT (gstring
);
4327 CHECK_FONT_OBJECT (font_object
);
4328 font
= XFONT_OBJECT (font_object
);
4329 if (! font
->driver
->shape
)
4332 /* Try at most three times with larger gstring each time. */
4333 for (i
= 0; i
< 3; i
++)
4335 n
= font
->driver
->shape (gstring
);
4338 gstring
= larger_vector (gstring
,
4339 LGSTRING_GLYPH_LEN (gstring
), -1);
4341 if (i
== 3 || XINT (n
) == 0)
4343 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4344 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4346 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4347 GLYPHS covers all characters (except for the last few ones) in
4348 GSTRING. More formally, provided that NCHARS is the number of
4349 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4350 and TO_IDX of each glyph must satisfy these conditions:
4352 GLYPHS[0].FROM_IDX == 0
4353 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4354 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4355 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4356 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4358 ;; Be sure to cover all characters.
4359 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4360 glyph
= LGSTRING_GLYPH (gstring
, 0);
4361 from
= LGLYPH_FROM (glyph
);
4362 to
= LGLYPH_TO (glyph
);
4363 if (from
!= 0 || to
< from
)
4365 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4367 glyph
= LGSTRING_GLYPH (gstring
, i
);
4370 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4371 && (LGLYPH_FROM (glyph
) == from
4372 ? LGLYPH_TO (glyph
) == to
4373 : LGLYPH_FROM (glyph
) == to
+ 1)))
4375 from
= LGLYPH_FROM (glyph
);
4376 to
= LGLYPH_TO (glyph
);
4378 return composition_gstring_put_cache (gstring
, XINT (n
));
4384 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4386 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4387 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4389 VARIATION-SELECTOR is a character code of variation selection
4390 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4391 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4392 (Lisp_Object font_object
, Lisp_Object character
)
4394 unsigned variations
[256];
4399 CHECK_FONT_OBJECT (font_object
);
4400 CHECK_CHARACTER (character
);
4401 font
= XFONT_OBJECT (font_object
);
4402 if (! font
->driver
->get_variation_glyphs
)
4404 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4408 for (i
= 0; i
< 255; i
++)
4411 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4412 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4413 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4420 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4421 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4422 OTF-FEATURES specifies which features to apply in this format:
4423 (SCRIPT LANGSYS GSUB GPOS)
4425 SCRIPT is a symbol specifying a script tag of OpenType,
4426 LANGSYS is a symbol specifying a langsys tag of OpenType,
4427 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4429 If LANGSYS is nil, the default langsys is selected.
4431 The features are applied in the order they appear in the list. The
4432 symbol `*' means to apply all available features not present in this
4433 list, and the remaining features are ignored. For instance, (vatu
4434 pstf * haln) is to apply vatu and pstf in this order, then to apply
4435 all available features other than vatu, pstf, and haln.
4437 The features are applied to the glyphs in the range FROM and TO of
4438 the glyph-string GSTRING-IN.
4440 If some feature is actually applicable, the resulting glyphs are
4441 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4442 this case, the value is the number of produced glyphs.
4444 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4447 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4448 produced in GSTRING-OUT, and the value is nil.
4450 See the documentation of `composition-get-gstring' for the format of
4452 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4454 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4459 check_otf_features (otf_features
);
4460 CHECK_FONT_OBJECT (font_object
);
4461 font
= XFONT_OBJECT (font_object
);
4462 if (! font
->driver
->otf_drive
)
4463 error ("Font backend %s can't drive OpenType GSUB table",
4464 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4465 CHECK_CONS (otf_features
);
4466 CHECK_SYMBOL (XCAR (otf_features
));
4467 val
= XCDR (otf_features
);
4468 CHECK_SYMBOL (XCAR (val
));
4469 val
= XCDR (otf_features
);
4472 len
= check_gstring (gstring_in
);
4473 CHECK_VECTOR (gstring_out
);
4474 CHECK_NATNUM (from
);
4476 CHECK_NATNUM (index
);
4478 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4479 args_out_of_range_3 (from
, to
, make_number (len
));
4480 if (XINT (index
) >= ASIZE (gstring_out
))
4481 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4482 num
= font
->driver
->otf_drive (font
, otf_features
,
4483 gstring_in
, XINT (from
), XINT (to
),
4484 gstring_out
, XINT (index
), 0);
4487 return make_number (num
);
4490 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4492 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4493 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4495 (SCRIPT LANGSYS FEATURE ...)
4496 See the documentation of `font-drive-otf' for more detail.
4498 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4499 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4500 character code corresponding to the glyph or nil if there's no
4501 corresponding character. */)
4502 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4505 Lisp_Object gstring_in
, gstring_out
, g
;
4506 Lisp_Object alternates
;
4509 CHECK_FONT_GET_OBJECT (font_object
, font
);
4510 if (! font
->driver
->otf_drive
)
4511 error ("Font backend %s can't drive OpenType GSUB table",
4512 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4513 CHECK_CHARACTER (character
);
4514 CHECK_CONS (otf_features
);
4516 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4517 g
= LGSTRING_GLYPH (gstring_in
, 0);
4518 LGLYPH_SET_CHAR (g
, XINT (character
));
4519 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4520 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4521 gstring_out
, 0, 1)) < 0)
4522 gstring_out
= Ffont_make_gstring (font_object
,
4523 make_number (ASIZE (gstring_out
) * 2));
4525 for (i
= 0; i
< num
; i
++)
4527 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4528 int c
= LGLYPH_CHAR (g
);
4529 unsigned code
= LGLYPH_CODE (g
);
4531 alternates
= Fcons (Fcons (make_number (code
),
4532 c
> 0 ? make_number (c
) : Qnil
),
4535 return Fnreverse (alternates
);
4541 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4542 doc
: /* Open FONT-ENTITY. */)
4543 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4546 struct frame
*f
= decode_live_frame (frame
);
4548 CHECK_FONT_ENTITY (font_entity
);
4551 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4554 CHECK_NUMBER_OR_FLOAT (size
);
4556 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4558 isize
= XINT (size
);
4559 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4560 args_out_of_range (font_entity
, size
);
4564 return font_open_entity (f
, font_entity
, isize
);
4567 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4568 doc
: /* Close FONT-OBJECT. */)
4569 (Lisp_Object font_object
, Lisp_Object frame
)
4571 CHECK_FONT_OBJECT (font_object
);
4572 font_close_object (decode_live_frame (frame
), font_object
);
4576 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4577 doc
: /* Return information about FONT-OBJECT.
4578 The value is a vector:
4579 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4582 NAME is the font name, a string (or nil if the font backend doesn't
4585 FILENAME is the font file name, a string (or nil if the font backend
4586 doesn't provide a file name).
4588 PIXEL-SIZE is a pixel size by which the font is opened.
4590 SIZE is a maximum advance width of the font in pixels.
4592 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4595 CAPABILITY is a list whose first element is a symbol representing the
4596 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4597 remaining elements describe the details of the font capability.
4599 If the font is OpenType font, the form of the list is
4600 \(opentype GSUB GPOS)
4601 where GSUB shows which "GSUB" features the font supports, and GPOS
4602 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4603 lists of the format:
4604 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4606 If the font is not OpenType font, currently the length of the form is
4609 SCRIPT is a symbol representing OpenType script tag.
4611 LANGSYS is a symbol representing OpenType langsys tag, or nil
4612 representing the default langsys.
4614 FEATURE is a symbol representing OpenType feature tag.
4616 If the font is not OpenType font, CAPABILITY is nil. */)
4617 (Lisp_Object font_object
)
4622 CHECK_FONT_GET_OBJECT (font_object
, font
);
4624 val
= make_uninit_vector (9);
4625 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4626 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4627 ASET (val
, 2, make_number (font
->pixel_size
));
4628 ASET (val
, 3, make_number (font
->max_width
));
4629 ASET (val
, 4, make_number (font
->ascent
));
4630 ASET (val
, 5, make_number (font
->descent
));
4631 ASET (val
, 6, make_number (font
->space_width
));
4632 ASET (val
, 7, make_number (font
->average_width
));
4633 if (font
->driver
->otf_capability
)
4634 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4636 ASET (val
, 8, Qnil
);
4640 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4642 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4643 FROM and TO are positions (integers or markers) specifying a region
4644 of the current buffer.
4645 If the optional fourth arg OBJECT is not nil, it is a string or a
4646 vector containing the target characters.
4648 Each element is a vector containing information of a glyph in this format:
4649 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4651 FROM is an index numbers of a character the glyph corresponds to.
4652 TO is the same as FROM.
4653 C is the character of the glyph.
4654 CODE is the glyph-code of C in FONT-OBJECT.
4655 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4656 ADJUSTMENT is always nil.
4657 If FONT-OBJECT doesn't have a glyph for a character,
4658 the corresponding element is nil. */)
4659 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4664 Lisp_Object
*chars
, vec
;
4667 CHECK_FONT_GET_OBJECT (font_object
, font
);
4670 ptrdiff_t charpos
, bytepos
;
4672 validate_region (&from
, &to
);
4675 len
= XFASTINT (to
) - XFASTINT (from
);
4676 SAFE_ALLOCA_LISP (chars
, len
);
4677 charpos
= XFASTINT (from
);
4678 bytepos
= CHAR_TO_BYTE (charpos
);
4679 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4682 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4683 chars
[i
] = make_number (c
);
4686 else if (STRINGP (object
))
4688 const unsigned char *p
;
4690 CHECK_NUMBER (from
);
4692 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4693 || XINT (to
) > SCHARS (object
))
4694 args_out_of_range_3 (object
, from
, to
);
4697 len
= XFASTINT (to
) - XFASTINT (from
);
4698 SAFE_ALLOCA_LISP (chars
, len
);
4700 if (STRING_MULTIBYTE (object
))
4701 for (i
= 0; i
< len
; i
++)
4703 int c
= STRING_CHAR_ADVANCE (p
);
4704 chars
[i
] = make_number (c
);
4707 for (i
= 0; i
< len
; i
++)
4708 chars
[i
] = make_number (p
[i
]);
4712 CHECK_VECTOR (object
);
4713 CHECK_NUMBER (from
);
4715 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4716 || XINT (to
) > ASIZE (object
))
4717 args_out_of_range_3 (object
, from
, to
);
4720 len
= XFASTINT (to
) - XFASTINT (from
);
4721 for (i
= 0; i
< len
; i
++)
4723 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4724 CHECK_CHARACTER (elt
);
4726 chars
= aref_addr (object
, XFASTINT (from
));
4729 vec
= make_uninit_vector (len
);
4730 for (i
= 0; i
< len
; i
++)
4733 int c
= XFASTINT (chars
[i
]);
4735 struct font_metrics metrics
;
4737 code
= font
->driver
->encode_char (font
, c
);
4738 if (code
== FONT_INVALID_CODE
)
4740 ASET (vec
, i
, Qnil
);
4744 LGLYPH_SET_FROM (g
, i
);
4745 LGLYPH_SET_TO (g
, i
);
4746 LGLYPH_SET_CHAR (g
, c
);
4747 LGLYPH_SET_CODE (g
, code
);
4748 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4749 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4750 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4751 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4752 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4753 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4756 if (! VECTORP (object
))
4761 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4762 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4763 FONT is a font-spec, font-entity, or font-object. */)
4764 (Lisp_Object spec
, Lisp_Object font
)
4766 CHECK_FONT_SPEC (spec
);
4769 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4772 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4773 doc
: /* Return a font-object for displaying a character at POSITION.
4774 Optional second arg WINDOW, if non-nil, is a window displaying
4775 the current buffer. It defaults to the currently selected window.
4776 Optional third arg STRING, if non-nil, is a string containing the target
4777 character at index specified by POSITION. */)
4778 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4780 struct window
*w
= decode_live_window (window
);
4784 if (XBUFFER (w
->contents
) != current_buffer
)
4785 error ("Specified window is not displaying the current buffer");
4786 CHECK_NUMBER_COERCE_MARKER (position
);
4787 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4788 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4792 CHECK_NUMBER (position
);
4793 CHECK_STRING (string
);
4794 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4795 args_out_of_range (string
, position
);
4798 return font_at (-1, XINT (position
), NULL
, w
, string
);
4802 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4803 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4804 The value is a number of glyphs drawn.
4805 Type C-l to recover what previously shown. */)
4806 (Lisp_Object font_object
, Lisp_Object string
)
4808 Lisp_Object frame
= selected_frame
;
4809 struct frame
*f
= XFRAME (frame
);
4815 CHECK_FONT_GET_OBJECT (font_object
, font
);
4816 CHECK_STRING (string
);
4817 len
= SCHARS (string
);
4818 code
= alloca (sizeof (unsigned) * len
);
4819 for (i
= 0; i
< len
; i
++)
4821 Lisp_Object ch
= Faref (string
, make_number (i
));
4825 code
[i
] = font
->driver
->encode_char (font
, c
);
4826 if (code
[i
] == FONT_INVALID_CODE
)
4829 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4831 if (font
->driver
->prepare_face
)
4832 font
->driver
->prepare_face (f
, face
);
4833 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4834 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4835 if (font
->driver
->done_face
)
4836 font
->driver
->done_face (f
, face
);
4838 return make_number (len
);
4842 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4843 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4844 If FRAME is omitted or nil, use the selected frame. */)
4847 #ifdef HAVE_WINDOW_SYSTEM
4848 struct frame
*f
= decode_live_frame (frame
);
4850 if (FRAME_WINDOW_P (f
))
4851 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4857 #endif /* FONT_DEBUG */
4859 #ifdef HAVE_WINDOW_SYSTEM
4861 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4862 doc
: /* Return information about a font named NAME on frame FRAME.
4863 If FRAME is omitted or nil, use the selected frame.
4864 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4865 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4867 OPENED-NAME is the name used for opening the font,
4868 FULL-NAME is the full name of the font,
4869 SIZE is the pixelsize of the font,
4870 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4871 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4872 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4873 how to compose characters.
4874 If the named font is not yet loaded, return nil. */)
4875 (Lisp_Object name
, Lisp_Object frame
)
4880 Lisp_Object font_object
;
4883 CHECK_STRING (name
);
4884 f
= decode_window_system_frame (frame
);
4888 int fontset
= fs_query_fontset (name
, 0);
4891 name
= fontset_ascii (fontset
);
4892 font_object
= font_open_by_name (f
, name
);
4894 else if (FONT_OBJECT_P (name
))
4896 else if (FONT_ENTITY_P (name
))
4897 font_object
= font_open_entity (f
, name
, 0);
4900 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4901 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4903 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4905 if (NILP (font_object
))
4907 font
= XFONT_OBJECT (font_object
);
4909 info
= make_uninit_vector (7);
4910 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4911 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4912 ASET (info
, 2, make_number (font
->pixel_size
));
4913 ASET (info
, 3, make_number (font
->height
));
4914 ASET (info
, 4, make_number (font
->baseline_offset
));
4915 ASET (info
, 5, make_number (font
->relative_compose
));
4916 ASET (info
, 6, make_number (font
->default_ascent
));
4919 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4920 close it now. Perhaps, we should manage font-objects
4921 by `reference-count'. */
4922 font_close_object (f
, font_object
);
4929 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
4932 build_style_table (const struct table_entry
*entry
, int nelement
)
4935 Lisp_Object table
, elt
;
4937 table
= make_uninit_vector (nelement
);
4938 for (i
= 0; i
< nelement
; i
++)
4940 for (j
= 0; entry
[i
].names
[j
]; j
++);
4941 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4942 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4943 for (j
= 0; entry
[i
].names
[j
]; j
++)
4944 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4945 ASET (table
, i
, elt
);
4950 /* The deferred font-log data of the form [ACTION ARG RESULT].
4951 If ACTION is not nil, that is added to the log when font_add_log is
4952 called next time. At that time, ACTION is set back to nil. */
4953 static Lisp_Object Vfont_log_deferred
;
4955 /* Prepend the font-related logging data in Vfont_log if it is not
4956 `t'. ACTION describes a kind of font-related action (e.g. listing,
4957 opening), ARG is the argument for the action, and RESULT is the
4958 result of the action. */
4960 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4965 if (EQ (Vfont_log
, Qt
))
4967 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4969 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4971 ASET (Vfont_log_deferred
, 0, Qnil
);
4972 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4973 AREF (Vfont_log_deferred
, 2));
4978 Lisp_Object tail
, elt
;
4979 Lisp_Object equalstr
= build_string ("=");
4981 val
= Ffont_xlfd_name (arg
, Qt
);
4982 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4986 if (EQ (XCAR (elt
), QCscript
)
4987 && SYMBOLP (XCDR (elt
)))
4988 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4989 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4990 else if (EQ (XCAR (elt
), QClang
)
4991 && SYMBOLP (XCDR (elt
)))
4992 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4993 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4994 else if (EQ (XCAR (elt
), QCotf
)
4995 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4996 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4998 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5004 && VECTORP (XCAR (result
))
5005 && ASIZE (XCAR (result
)) > 0
5006 && FONTP (AREF (XCAR (result
), 0)))
5007 result
= font_vconcat_entity_vectors (result
);
5010 val
= Ffont_xlfd_name (result
, Qt
);
5011 if (! FONT_SPEC_P (result
))
5012 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5013 build_string (":"), val
);
5016 else if (CONSP (result
))
5019 result
= Fcopy_sequence (result
);
5020 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5024 val
= Ffont_xlfd_name (val
, Qt
);
5025 XSETCAR (tail
, val
);
5028 else if (VECTORP (result
))
5030 result
= Fcopy_sequence (result
);
5031 for (i
= 0; i
< ASIZE (result
); i
++)
5033 val
= AREF (result
, i
);
5035 val
= Ffont_xlfd_name (val
, Qt
);
5036 ASET (result
, i
, val
);
5039 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5042 /* Record a font-related logging data to be added to Vfont_log when
5043 font_add_log is called next time. ACTION, ARG, RESULT are the same
5047 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5049 if (EQ (Vfont_log
, Qt
))
5051 ASET (Vfont_log_deferred
, 0, build_string (action
));
5052 ASET (Vfont_log_deferred
, 1, arg
);
5053 ASET (Vfont_log_deferred
, 2, result
);
5061 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5062 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5063 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5064 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5065 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5066 /* Note that the other elements in sort_shift_bits are not used. */
5068 staticpro (&font_charset_alist
);
5069 font_charset_alist
= Qnil
;
5071 DEFSYM (Qopentype
, "opentype");
5073 DEFSYM (Qascii_0
, "ascii-0");
5074 DEFSYM (Qiso8859_1
, "iso8859-1");
5075 DEFSYM (Qiso10646_1
, "iso10646-1");
5076 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5077 DEFSYM (Qunicode_sip
, "unicode-sip");
5081 DEFSYM (QCotf
, ":otf");
5082 DEFSYM (QClang
, ":lang");
5083 DEFSYM (QCscript
, ":script");
5084 DEFSYM (QCantialias
, ":antialias");
5086 DEFSYM (QCfoundry
, ":foundry");
5087 DEFSYM (QCadstyle
, ":adstyle");
5088 DEFSYM (QCregistry
, ":registry");
5089 DEFSYM (QCspacing
, ":spacing");
5090 DEFSYM (QCdpi
, ":dpi");
5091 DEFSYM (QCscalable
, ":scalable");
5092 DEFSYM (QCavgwidth
, ":avgwidth");
5093 DEFSYM (QCfont_entity
, ":font-entity");
5094 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5104 DEFSYM (QCuser_spec
, "user-spec");
5106 staticpro (&scratch_font_spec
);
5107 scratch_font_spec
= Ffont_spec (0, NULL
);
5108 staticpro (&scratch_font_prefer
);
5109 scratch_font_prefer
= Ffont_spec (0, NULL
);
5111 staticpro (&Vfont_log_deferred
);
5112 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5116 staticpro (&otf_list
);
5118 #endif /* HAVE_LIBOTF */
5121 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5123 Alist of fontname patterns vs the corresponding encoding and repertory info.
5124 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5125 where ENCODING is a charset or a char-table,
5126 and REPERTORY is a charset, a char-table, or nil.
5128 If ENCODING and REPERTORY are the same, the element can have the form
5129 \(REGEXP . ENCODING).
5131 ENCODING is for converting a character to a glyph code of the font.
5132 If ENCODING is a charset, encoding a character by the charset gives
5133 the corresponding glyph code. If ENCODING is a char-table, looking up
5134 the table by a character gives the corresponding glyph code.
5136 REPERTORY specifies a repertory of characters supported by the font.
5137 If REPERTORY is a charset, all characters belonging to the charset are
5138 supported. If REPERTORY is a char-table, all characters who have a
5139 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5140 gets the repertory information by an opened font and ENCODING. */);
5141 Vfont_encoding_alist
= Qnil
;
5143 /* FIXME: These 3 vars are not quite what they appear: setq on them
5144 won't have any effect other than disconnect them from the style
5145 table used by the font display code. So we make them read-only,
5146 to avoid this confusing situation. */
5148 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5149 doc
: /* Vector of valid font weight values.
5150 Each element has the form:
5151 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5152 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5153 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5154 SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-weight-table")), 1);
5156 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5157 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5158 See `font-weight-table' for the format of the vector. */);
5159 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5160 SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-slant-table")), 1);
5162 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5163 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5164 See `font-weight-table' for the format of the vector. */);
5165 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5166 SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-width-table")), 1);
5168 staticpro (&font_style_table
);
5169 font_style_table
= make_uninit_vector (3);
5170 ASET (font_style_table
, 0, Vfont_weight_table
);
5171 ASET (font_style_table
, 1, Vfont_slant_table
);
5172 ASET (font_style_table
, 2, Vfont_width_table
);
5174 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5175 *Logging list of font related actions and results.
5176 The value t means to suppress the logging.
5177 The initial value is set to nil if the environment variable
5178 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5181 #ifdef HAVE_WINDOW_SYSTEM
5182 #ifdef HAVE_FREETYPE
5184 #ifdef HAVE_X_WINDOWS
5189 #endif /* HAVE_XFT */
5190 #endif /* HAVE_X_WINDOWS */
5191 #else /* not HAVE_FREETYPE */
5192 #ifdef HAVE_X_WINDOWS
5194 #endif /* HAVE_X_WINDOWS */
5195 #endif /* not HAVE_FREETYPE */
5198 #endif /* HAVE_BDFFONT */
5201 #endif /* HAVE_NTGUI */
5202 #endif /* HAVE_WINDOW_SYSTEM */
5208 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;