1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2015 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 #define DEFAULT_ENCODING Qiso8859_1
46 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
47 static Lisp_Object font_style_table
;
49 /* Structure used for tables mapping weight, slant, and width numeric
50 values and their names. */
55 /* The first one is a valid name as a face attribute.
56 The second one (if any) is a typical name in XLFD field. */
60 /* Table of weight numeric values and their names. This table must be
61 sorted by numeric values in ascending order. */
63 static const struct table_entry weight_table
[] =
66 { 20, { "ultra-light", "ultralight" }},
67 { 40, { "extra-light", "extralight" }},
69 { 75, { "semi-light", "semilight", "demilight", "book" }},
70 { 100, { "normal", "medium", "regular", "unspecified" }},
71 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
73 { 205, { "extra-bold", "extrabold" }},
74 { 210, { "ultra-bold", "ultrabold", "black" }}
77 /* Table of slant numeric values and their names. This table must be
78 sorted by numeric values in ascending order. */
80 static const struct table_entry slant_table
[] =
82 { 0, { "reverse-oblique", "ro" }},
83 { 10, { "reverse-italic", "ri" }},
84 { 100, { "normal", "r", "unspecified" }},
85 { 200, { "italic" ,"i", "ot" }},
86 { 210, { "oblique", "o" }}
89 /* Table of width numeric values and their names. This table must be
90 sorted by numeric values in ascending order. */
92 static const struct table_entry width_table
[] =
94 { 50, { "ultra-condensed", "ultracondensed" }},
95 { 63, { "extra-condensed", "extracondensed" }},
96 { 75, { "condensed", "compressed", "narrow" }},
97 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
98 { 100, { "normal", "medium", "regular", "unspecified" }},
99 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
100 { 125, { "expanded" }},
101 { 150, { "extra-expanded", "extraexpanded" }},
102 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
105 /* Alist of font registry symbols and the corresponding charset
106 information. The information is retrieved from
107 Vfont_encoding_alist on demand.
109 Eash element has the form:
110 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
114 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
115 encodes a character code to a glyph code of a font, and
116 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
117 character is supported by a font.
119 The latter form means that the information for REGISTRY couldn't be
121 static Lisp_Object font_charset_alist
;
123 /* List of all font drivers. Each font-backend (XXXfont.c) calls
124 register_font_driver in syms_of_XXXfont to register its font-driver
126 static struct font_driver_list
*font_driver_list
;
128 #ifdef ENABLE_CHECKING
130 /* Used to catch bogus pointers in font objects. */
133 valid_font_driver (struct font_driver
*drv
)
135 Lisp_Object tail
, frame
;
136 struct font_driver_list
*fdl
;
138 for (fdl
= font_driver_list
; fdl
; fdl
= fdl
->next
)
139 if (fdl
->driver
== drv
)
141 FOR_EACH_FRAME (tail
, frame
)
142 for (fdl
= XFRAME (frame
)->font_driver_list
; fdl
; fdl
= fdl
->next
)
143 if (fdl
->driver
== drv
)
148 #endif /* ENABLE_CHECKING */
150 /* Creators of font-related Lisp object. */
153 font_make_spec (void)
155 Lisp_Object font_spec
;
156 struct font_spec
*spec
157 = ((struct font_spec
*)
158 allocate_pseudovector (VECSIZE (struct font_spec
),
159 FONT_SPEC_MAX
, PVEC_FONT
));
160 XSETFONT (font_spec
, spec
);
165 font_make_entity (void)
167 Lisp_Object font_entity
;
168 struct font_entity
*entity
169 = ((struct font_entity
*)
170 allocate_pseudovector (VECSIZE (struct font_entity
),
171 FONT_ENTITY_MAX
, PVEC_FONT
));
172 XSETFONT (font_entity
, entity
);
176 /* Create a font-object whose structure size is SIZE. If ENTITY is
177 not nil, copy properties from ENTITY to the font-object. If
178 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
180 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
182 Lisp_Object font_object
;
184 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
187 /* GC can happen before the driver is set up,
188 so avoid dangling pointer here (Bug#17771). */
190 XSETFONT (font_object
, font
);
194 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
195 font
->props
[i
] = AREF (entity
, i
);
196 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
197 font
->props
[FONT_EXTRA_INDEX
]
198 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
201 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
205 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
207 static int font_unparse_fcname (Lisp_Object
, int, char *, int);
209 /* Like above, but also set `type', `name' and `fullname' properties
213 font_build_object (int vectorsize
, Lisp_Object type
,
214 Lisp_Object entity
, double pixelsize
)
218 Lisp_Object font_object
= font_make_object (vectorsize
, entity
, pixelsize
);
220 ASET (font_object
, FONT_TYPE_INDEX
, type
);
221 len
= font_unparse_xlfd (entity
, pixelsize
, name
, sizeof name
);
223 ASET (font_object
, FONT_NAME_INDEX
, make_string (name
, len
));
224 len
= font_unparse_fcname (entity
, pixelsize
, name
, sizeof name
);
226 ASET (font_object
, FONT_FULLNAME_INDEX
, make_string (name
, len
));
228 ASET (font_object
, FONT_FULLNAME_INDEX
,
229 AREF (font_object
, FONT_NAME_INDEX
));
233 #endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */
235 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
236 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
237 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
239 static unsigned font_encode_char (Lisp_Object
, int);
241 /* Number of registered font drivers. */
242 static int num_font_drivers
;
245 /* Return a Lispy value of a font property value at STR and LEN bytes.
246 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
247 consist entirely of one or more digits, return a symbol interned
248 from STR. Otherwise, return an integer. */
251 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
253 ptrdiff_t i
, nbytes
, nchars
;
254 Lisp_Object tem
, name
, obarray
;
256 if (len
== 1 && *str
== '*')
258 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
260 for (i
= 1; i
< len
; i
++)
261 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
268 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
271 return make_number (n
);
272 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
276 xsignal1 (Qoverflow_error
, make_string (str
, len
));
280 /* This code is similar to intern function from lread.c. */
281 obarray
= check_obarray (Vobarray
);
282 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
283 tem
= oblookup (obarray
, str
,
284 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
287 name
= make_specified_string (str
, nchars
, len
,
288 len
!= nchars
&& len
== nbytes
);
289 return intern_driver (name
, obarray
, tem
);
292 /* Return a pixel size of font-spec SPEC on frame F. */
295 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
297 #ifdef HAVE_WINDOW_SYSTEM
298 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
307 eassert (FLOATP (size
));
308 point_size
= XFLOAT_DATA (size
);
309 val
= AREF (spec
, FONT_DPI_INDEX
);
313 dpi
= FRAME_RES_Y (f
);
314 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
322 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
323 font vector. If VAL is not valid (i.e. not registered in
324 font_style_table), return -1 if NOERROR is zero, and return a
325 proper index if NOERROR is nonzero. In that case, register VAL in
326 font_style_table if VAL is a symbol, and return the closest index if
327 VAL is an integer. */
330 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
333 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
336 CHECK_VECTOR (table
);
345 /* At first try exact match. */
346 for (i
= 0; i
< len
; i
++)
348 CHECK_VECTOR (AREF (table
, i
));
349 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
350 if (EQ (val
, AREF (AREF (table
, i
), j
)))
352 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
353 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
354 | (i
<< 4) | (j
- 1));
357 /* Try also with case-folding match. */
358 s
= SSDATA (SYMBOL_NAME (val
));
359 for (i
= 0; i
< len
; i
++)
360 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
362 elt
= AREF (AREF (table
, i
), j
);
363 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
365 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
366 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
367 | (i
<< 4) | (j
- 1));
373 elt
= Fmake_vector (make_number (2), make_number (100));
375 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
,
376 Fvconcat (2, ((Lisp_Object
[])
377 { table
, Fmake_vector (make_number (1), elt
) })));
378 return (100 << 8) | (i
<< 4);
383 EMACS_INT numeric
= XINT (val
);
385 for (i
= 0, last_n
= -1; i
< len
; i
++)
389 CHECK_VECTOR (AREF (table
, i
));
390 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
391 n
= XINT (AREF (AREF (table
, i
), 0));
393 return (n
<< 8) | (i
<< 4);
398 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
399 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
405 return ((last_n
<< 8) | ((i
- 1) << 4));
410 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
413 Lisp_Object val
= AREF (font
, prop
);
414 Lisp_Object table
, elt
;
419 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
420 CHECK_VECTOR (table
);
421 i
= XINT (val
) & 0xFF;
422 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
423 elt
= AREF (table
, ((i
>> 4) & 0xF));
425 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
426 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
431 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
432 FONTNAME. ENCODING is a charset symbol that specifies the encoding
433 of the font. REPERTORY is a charset symbol or nil. */
436 find_font_encoding (Lisp_Object fontname
)
438 Lisp_Object tail
, elt
;
440 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
444 && STRINGP (XCAR (elt
))
445 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
446 && (SYMBOLP (XCDR (elt
))
447 ? CHARSETP (XCDR (elt
))
448 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
454 /* Return encoding charset and repertory charset for REGISTRY in
455 ENCODING and REPERTORY correspondingly. If correct information for
456 REGISTRY is available, return 0. Otherwise return -1. */
459 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
462 int encoding_id
, repertory_id
;
464 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
470 encoding_id
= XINT (XCAR (val
));
471 repertory_id
= XINT (XCDR (val
));
475 val
= find_font_encoding (SYMBOL_NAME (registry
));
476 if (SYMBOLP (val
) && CHARSETP (val
))
478 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
480 else if (CONSP (val
))
482 if (! CHARSETP (XCAR (val
)))
484 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
485 if (NILP (XCDR (val
)))
489 if (! CHARSETP (XCDR (val
)))
491 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
496 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
498 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
502 *encoding
= CHARSET_FROM_ID (encoding_id
);
504 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
509 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
514 /* Font property value validators. See the comment of
515 font_property_table for the meaning of the arguments. */
517 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
518 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
519 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
520 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
521 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
522 static int get_font_prop_index (Lisp_Object
);
525 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
528 val
= Fintern (val
, Qnil
);
531 else if (EQ (prop
, QCregistry
))
532 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
538 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
540 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
541 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
545 EMACS_INT n
= XINT (val
);
546 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
548 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
552 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
555 if ((n
& 0xF) + 1 >= ASIZE (elt
))
559 CHECK_NUMBER (AREF (elt
, 0));
560 if (XINT (AREF (elt
, 0)) != (n
>> 8))
565 else if (SYMBOLP (val
))
567 int n
= font_style_to_value (prop
, val
, 0);
569 val
= n
>= 0 ? make_number (n
) : Qerror
;
577 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
579 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
584 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
586 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
588 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
590 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
592 if (spacing
== 'c' || spacing
== 'C')
593 return make_number (FONT_SPACING_CHARCELL
);
594 if (spacing
== 'm' || spacing
== 'M')
595 return make_number (FONT_SPACING_MONO
);
596 if (spacing
== 'p' || spacing
== 'P')
597 return make_number (FONT_SPACING_PROPORTIONAL
);
598 if (spacing
== 'd' || spacing
== 'D')
599 return make_number (FONT_SPACING_DUAL
);
605 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
607 Lisp_Object tail
, tmp
;
610 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
611 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
612 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
615 if (! SYMBOLP (XCAR (val
)))
620 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
622 for (i
= 0; i
< 2; i
++)
629 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
630 if (! SYMBOLP (XCAR (tmp
)))
638 /* Structure of known font property keys and validator of the
642 /* Pointer to the key symbol. */
643 struct Lisp_Symbol
*key
;
644 /* Function to validate PROP's value VAL, or NULL if any value is
645 ok. The value is VAL or its regularized value if VAL is valid,
646 and Qerror if not. */
647 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
648 } font_property_table
[] =
649 { { XSYMBOL_INIT (QCtype
), font_prop_validate_symbol
},
650 { XSYMBOL_INIT (QCfoundry
), font_prop_validate_symbol
},
651 { XSYMBOL_INIT (QCfamily
), font_prop_validate_symbol
},
652 { XSYMBOL_INIT (QCadstyle
), font_prop_validate_symbol
},
653 { XSYMBOL_INIT (QCregistry
), font_prop_validate_symbol
},
654 { XSYMBOL_INIT (QCweight
), font_prop_validate_style
},
655 { XSYMBOL_INIT (QCslant
), font_prop_validate_style
},
656 { XSYMBOL_INIT (QCwidth
), font_prop_validate_style
},
657 { XSYMBOL_INIT (QCsize
), font_prop_validate_non_neg
},
658 { XSYMBOL_INIT (QCdpi
), font_prop_validate_non_neg
},
659 { XSYMBOL_INIT (QCspacing
), font_prop_validate_spacing
},
660 { XSYMBOL_INIT (QCavgwidth
), font_prop_validate_non_neg
},
661 /* The order of the above entries must match with enum
662 font_property_index. */
663 { XSYMBOL_INIT (QClang
), font_prop_validate_symbol
},
664 { XSYMBOL_INIT (QCscript
), font_prop_validate_symbol
},
665 { XSYMBOL_INIT (QCotf
), font_prop_validate_otf
}
668 /* Return an index number of font property KEY or -1 if KEY is not an
669 already known property. */
672 get_font_prop_index (Lisp_Object key
)
676 for (i
= 0; i
< ARRAYELTS (font_property_table
); i
++)
677 if (EQ (key
, make_lisp_symbol (font_property_table
[i
].key
)))
682 /* Validate the font property. The property key is specified by the
683 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
684 signal an error. The value is VAL or the regularized one. */
687 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
689 Lisp_Object validated
;
694 prop
= make_lisp_symbol (font_property_table
[idx
].key
);
697 idx
= get_font_prop_index (prop
);
701 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
702 if (EQ (validated
, Qerror
))
703 signal_error ("invalid font property", Fcons (prop
, val
));
708 /* Store VAL as a value of extra font property PROP in FONT while
709 keeping the sorting order. Don't check the validity of VAL. */
712 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
714 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
715 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
719 Lisp_Object prev
= Qnil
;
722 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
723 prev
= extra
, extra
= XCDR (extra
);
726 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
728 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
734 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
739 /* Font name parser and unparser. */
741 static int parse_matrix (const char *);
742 static int font_expand_wildcards (Lisp_Object
*, int);
743 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
745 /* An enumerator for each field of an XLFD font name. */
746 enum xlfd_field_index
765 /* An enumerator for mask bit corresponding to each XLFD field. */
768 XLFD_FOUNDRY_MASK
= 0x0001,
769 XLFD_FAMILY_MASK
= 0x0002,
770 XLFD_WEIGHT_MASK
= 0x0004,
771 XLFD_SLANT_MASK
= 0x0008,
772 XLFD_SWIDTH_MASK
= 0x0010,
773 XLFD_ADSTYLE_MASK
= 0x0020,
774 XLFD_PIXEL_MASK
= 0x0040,
775 XLFD_POINT_MASK
= 0x0080,
776 XLFD_RESX_MASK
= 0x0100,
777 XLFD_RESY_MASK
= 0x0200,
778 XLFD_SPACING_MASK
= 0x0400,
779 XLFD_AVGWIDTH_MASK
= 0x0800,
780 XLFD_REGISTRY_MASK
= 0x1000,
781 XLFD_ENCODING_MASK
= 0x2000
785 /* Parse P pointing to the pixel/point size field of the form
786 `[A B C D]' which specifies a transformation matrix:
792 by which all glyphs of the font are transformed. The spec says
793 that scalar value N for the pixel/point size is equivalent to:
794 A = N * resx/resy, B = C = 0, D = N.
796 Return the scalar value N if the form is valid. Otherwise return
800 parse_matrix (const char *p
)
806 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
809 matrix
[i
] = - strtod (p
+ 1, &end
);
811 matrix
[i
] = strtod (p
, &end
);
814 return (i
== 4 ? (int) matrix
[3] : -1);
817 /* Expand a wildcard field in FIELD (the first N fields are filled) to
818 multiple fields to fill in all 14 XLFD fields while restricting a
819 field position by its contents. */
822 font_expand_wildcards (Lisp_Object
*field
, int n
)
825 Lisp_Object tmp
[XLFD_LAST_INDEX
];
826 /* Array of information about where this element can go. Nth
827 element is for Nth element of FIELD. */
829 /* Minimum possible field. */
831 /* Maximum possible field. */
833 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
835 } range
[XLFD_LAST_INDEX
];
837 int range_from
, range_to
;
840 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
841 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
842 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
843 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
844 | XLFD_AVGWIDTH_MASK)
845 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
847 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
848 field. The value is shifted to left one bit by one in the
850 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
851 range_mask
= (range_mask
<< 1) | 1;
853 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
854 position-based restriction for FIELD[I]. */
855 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
856 i
++, range_from
++, range_to
++, range_mask
<<= 1)
858 Lisp_Object val
= field
[i
];
864 range
[i
].from
= range_from
;
865 range
[i
].to
= range_to
;
866 range
[i
].mask
= range_mask
;
870 /* The triplet FROM, TO, and MASK is a value-based
871 restriction for FIELD[I]. */
877 EMACS_INT numeric
= XINT (val
);
880 from
= to
= XLFD_ENCODING_INDEX
,
881 mask
= XLFD_ENCODING_MASK
;
882 else if (numeric
== 0)
883 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
884 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
885 else if (numeric
<= 48)
886 from
= to
= XLFD_PIXEL_INDEX
,
887 mask
= XLFD_PIXEL_MASK
;
889 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
890 mask
= XLFD_LARGENUM_MASK
;
892 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
893 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
894 mask
= XLFD_NULL_MASK
;
896 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
899 Lisp_Object name
= SYMBOL_NAME (val
);
901 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
902 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
903 mask
= XLFD_REGENC_MASK
;
905 from
= to
= XLFD_ENCODING_INDEX
,
906 mask
= XLFD_ENCODING_MASK
;
908 else if (range_from
<= XLFD_WEIGHT_INDEX
909 && range_to
>= XLFD_WEIGHT_INDEX
910 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
911 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
912 else if (range_from
<= XLFD_SLANT_INDEX
913 && range_to
>= XLFD_SLANT_INDEX
914 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
915 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
916 else if (range_from
<= XLFD_SWIDTH_INDEX
917 && range_to
>= XLFD_SWIDTH_INDEX
918 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
919 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
922 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
923 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
925 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
926 mask
= XLFD_SYMBOL_MASK
;
929 /* Merge position-based and value-based restrictions. */
931 while (from
< range_from
)
932 mask
&= ~(1 << from
++);
933 while (from
< 14 && ! (mask
& (1 << from
)))
935 while (to
> range_to
)
936 mask
&= ~(1 << to
--);
937 while (to
>= 0 && ! (mask
& (1 << to
)))
941 range
[i
].from
= from
;
943 range
[i
].mask
= mask
;
945 if (from
> range_from
|| to
< range_to
)
947 /* The range is narrowed by value-based restrictions.
948 Reflect it to the other fields. */
950 /* Following fields should be after FROM. */
952 /* Preceding fields should be before TO. */
953 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
955 /* Check FROM for non-wildcard field. */
956 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
958 while (range
[j
].from
< from
)
959 range
[j
].mask
&= ~(1 << range
[j
].from
++);
960 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
962 range
[j
].from
= from
;
965 from
= range
[j
].from
;
966 if (range
[j
].to
> to
)
968 while (range
[j
].to
> to
)
969 range
[j
].mask
&= ~(1 << range
[j
].to
--);
970 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
983 /* Decide all fields from restrictions in RANGE. */
984 for (i
= j
= 0; i
< n
; i
++)
986 if (j
< range
[i
].from
)
988 if (i
== 0 || ! NILP (tmp
[i
- 1]))
989 /* None of TMP[X] corresponds to Jth field. */
991 for (; j
< range
[i
].from
; j
++)
996 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
998 for (; j
< XLFD_LAST_INDEX
; j
++)
1000 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1001 field
[XLFD_ENCODING_INDEX
]
1002 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1007 /* Parse NAME (null terminated) as XLFD and store information in FONT
1008 (font-spec or font-entity). Size property of FONT is set as
1010 specified XLFD fields FONT property
1011 --------------------- -------------
1012 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1013 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1014 POINT_SIZE POINT_SIZE/10 (Lisp float)
1016 If NAME is successfully parsed, return 0. Otherwise return -1.
1018 FONT is usually a font-spec, but when this function is called from
1019 X font backend driver, it is a font-entity. In that case, NAME is
1020 a fully specified XLFD. */
1023 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1026 char *f
[XLFD_LAST_INDEX
+ 1];
1030 if (len
> 255 || !len
)
1031 /* Maximum XLFD name length is 255. */
1033 /* Accept "*-.." as a fully specified XLFD. */
1034 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1035 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1038 for (p
= name
+ i
; *p
; p
++)
1042 if (i
== XLFD_LAST_INDEX
)
1047 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1048 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1050 if (i
== XLFD_LAST_INDEX
)
1052 /* Fully specified XLFD. */
1055 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1056 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1057 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1058 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1060 val
= INTERN_FIELD_SYM (i
);
1063 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1065 ASET (font
, j
, make_number (n
));
1068 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1069 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1070 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1072 ASET (font
, FONT_REGISTRY_INDEX
,
1073 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1074 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1076 p
= f
[XLFD_PIXEL_INDEX
];
1077 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1078 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1081 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1083 ASET (font
, FONT_SIZE_INDEX
, val
);
1084 else if (FONT_ENTITY_P (font
))
1088 double point_size
= -1;
1090 eassert (FONT_SPEC_P (font
));
1091 p
= f
[XLFD_POINT_INDEX
];
1093 point_size
= parse_matrix (p
);
1094 else if (c_isdigit (*p
))
1095 point_size
= atoi (p
), point_size
/= 10;
1096 if (point_size
>= 0)
1097 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1101 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1102 if (! NILP (val
) && ! INTEGERP (val
))
1104 ASET (font
, FONT_DPI_INDEX
, val
);
1105 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1108 val
= font_prop_validate_spacing (QCspacing
, val
);
1109 if (! INTEGERP (val
))
1111 ASET (font
, FONT_SPACING_INDEX
, val
);
1113 p
= f
[XLFD_AVGWIDTH_INDEX
];
1116 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1117 if (! NILP (val
) && ! INTEGERP (val
))
1119 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1123 bool wild_card_found
= 0;
1124 Lisp_Object prop
[XLFD_LAST_INDEX
];
1126 if (FONT_ENTITY_P (font
))
1128 for (j
= 0; j
< i
; j
++)
1132 if (f
[j
][1] && f
[j
][1] != '-')
1135 wild_card_found
= 1;
1138 prop
[j
] = INTERN_FIELD (j
);
1140 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1142 if (! wild_card_found
)
1144 if (font_expand_wildcards (prop
, i
) < 0)
1147 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1148 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1149 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1150 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1151 if (! NILP (prop
[i
]))
1153 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1155 ASET (font
, j
, make_number (n
));
1157 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1158 val
= prop
[XLFD_REGISTRY_INDEX
];
1161 val
= prop
[XLFD_ENCODING_INDEX
];
1164 AUTO_STRING (star_dash
, "*-");
1165 val
= concat2 (star_dash
, SYMBOL_NAME (val
));
1168 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1170 AUTO_STRING (dash_star
, "-*");
1171 val
= concat2 (SYMBOL_NAME (val
), dash_star
);
1175 AUTO_STRING (dash
, "-");
1176 val
= concat3 (SYMBOL_NAME (val
), dash
,
1177 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1180 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1182 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1183 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1184 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1186 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1188 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1191 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1192 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1193 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1195 val
= font_prop_validate_spacing (QCspacing
,
1196 prop
[XLFD_SPACING_INDEX
]);
1197 if (! INTEGERP (val
))
1199 ASET (font
, FONT_SPACING_INDEX
, val
);
1201 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1202 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1208 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1209 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1210 0, use PIXEL_SIZE instead. */
1213 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1216 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1220 eassert (FONTP (font
));
1222 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1225 if (i
== FONT_ADSTYLE_INDEX
)
1226 j
= XLFD_ADSTYLE_INDEX
;
1227 else if (i
== FONT_REGISTRY_INDEX
)
1228 j
= XLFD_REGISTRY_INDEX
;
1229 val
= AREF (font
, i
);
1232 if (j
== XLFD_REGISTRY_INDEX
)
1240 val
= SYMBOL_NAME (val
);
1241 if (j
== XLFD_REGISTRY_INDEX
1242 && ! strchr (SSDATA (val
), '-'))
1244 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1245 ptrdiff_t alloc
= SBYTES (val
) + 4;
1246 if (nbytes
<= alloc
)
1248 f
[j
] = p
= alloca (alloc
);
1249 sprintf (p
, "%s%s-*", SDATA (val
),
1250 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1253 f
[j
] = SSDATA (val
);
1257 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1260 val
= font_style_symbolic (font
, i
, 0);
1268 val
= SYMBOL_NAME (val
);
1269 alloc
= SBYTES (val
) + 1;
1270 if (nbytes
<= alloc
)
1272 f
[j
] = p
= alloca (alloc
);
1273 /* Copy the name while excluding '-', '?', ',', and '"'. */
1274 for (k
= l
= 0; k
< alloc
; k
++)
1277 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1283 val
= AREF (font
, FONT_SIZE_INDEX
);
1284 eassert (NUMBERP (val
) || NILP (val
));
1285 char font_size_index_buf
[sizeof "-*"
1286 + max (INT_STRLEN_BOUND (EMACS_INT
),
1287 1 + DBL_MAX_10_EXP
+ 1)];
1290 EMACS_INT v
= XINT (val
);
1295 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1296 sprintf (p
, "%"pI
"d-*", v
);
1299 f
[XLFD_PIXEL_INDEX
] = "*-*";
1301 else if (FLOATP (val
))
1303 double v
= XFLOAT_DATA (val
) * 10;
1304 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1305 sprintf (p
, "*-%.0f", v
);
1308 f
[XLFD_PIXEL_INDEX
] = "*-*";
1310 char dpi_index_buf
[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
)];
1311 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1313 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1314 f
[XLFD_RESX_INDEX
] = p
= dpi_index_buf
;
1315 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1318 f
[XLFD_RESX_INDEX
] = "*-*";
1320 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1322 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1324 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1325 : spacing
<= FONT_SPACING_DUAL
? "d"
1326 : spacing
<= FONT_SPACING_MONO
? "m"
1330 f
[XLFD_SPACING_INDEX
] = "*";
1332 char avgwidth_index_buf
[INT_BUFSIZE_BOUND (EMACS_INT
)];
1333 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1335 f
[XLFD_AVGWIDTH_INDEX
] = p
= avgwidth_index_buf
;
1336 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1339 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1341 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1342 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1343 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1344 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1345 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1346 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1347 f
[XLFD_REGISTRY_INDEX
]);
1348 return len
< nbytes
? len
: -1;
1351 /* Parse NAME (null terminated) and store information in FONT
1352 (font-spec or font-entity). NAME is supplied in either the
1353 Fontconfig or GTK font name format. If NAME is successfully
1354 parsed, return 0. Otherwise return -1.
1356 The fontconfig format is
1358 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1362 FAMILY [PROPS...] [SIZE]
1364 This function tries to guess which format it is. */
1367 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1370 char *size_beg
= NULL
, *size_end
= NULL
;
1371 char *props_beg
= NULL
, *family_end
= NULL
;
1376 for (p
= name
; *p
; p
++)
1378 if (*p
== '\\' && p
[1])
1382 props_beg
= family_end
= p
;
1387 bool decimal
= 0, size_found
= 1;
1388 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1389 if (! c_isdigit (*q
))
1391 if (*q
!= '.' || decimal
)
1410 Lisp_Object extra_props
= Qnil
;
1412 /* A fontconfig name with size and/or property data. */
1413 if (family_end
> name
)
1416 family
= font_intern_prop (name
, family_end
- name
, 1);
1417 ASET (font
, FONT_FAMILY_INDEX
, family
);
1421 double point_size
= strtod (size_beg
, &size_end
);
1422 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1423 if (*size_end
== ':' && size_end
[1])
1424 props_beg
= size_end
;
1428 /* Now parse ":KEY=VAL" patterns. */
1431 for (p
= props_beg
; *p
; p
= q
)
1433 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1436 /* Must be an enumerated value. */
1440 val
= font_intern_prop (p
, q
- p
, 1);
1442 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1443 && memcmp (p, STR, strlen (STR)) == 0)
1445 if (PROP_MATCH ("light")
1446 || PROP_MATCH ("medium")
1447 || PROP_MATCH ("demibold")
1448 || PROP_MATCH ("bold")
1449 || PROP_MATCH ("black"))
1450 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1451 else if (PROP_MATCH ("roman")
1452 || PROP_MATCH ("italic")
1453 || PROP_MATCH ("oblique"))
1454 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1455 else if (PROP_MATCH ("charcell"))
1456 ASET (font
, FONT_SPACING_INDEX
,
1457 make_number (FONT_SPACING_CHARCELL
));
1458 else if (PROP_MATCH ("mono"))
1459 ASET (font
, FONT_SPACING_INDEX
,
1460 make_number (FONT_SPACING_MONO
));
1461 else if (PROP_MATCH ("proportional"))
1462 ASET (font
, FONT_SPACING_INDEX
,
1463 make_number (FONT_SPACING_PROPORTIONAL
));
1472 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1473 prop
= FONT_SIZE_INDEX
;
1476 key
= font_intern_prop (p
, q
- p
, 1);
1477 prop
= get_font_prop_index (key
);
1481 for (q
= p
; *q
&& *q
!= ':'; q
++);
1482 val
= font_intern_prop (p
, q
- p
, 0);
1484 if (prop
>= FONT_FOUNDRY_INDEX
1485 && prop
< FONT_EXTRA_INDEX
)
1486 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1489 extra_props
= nconc2 (extra_props
,
1490 list1 (Fcons (key
, val
)));
1497 if (! NILP (extra_props
))
1499 struct font_driver_list
*driver_list
= font_driver_list
;
1500 for ( ; driver_list
; driver_list
= driver_list
->next
)
1501 if (driver_list
->driver
->filter_properties
)
1502 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1508 /* Either a fontconfig-style name with no size and property
1509 data, or a GTK-style name. */
1510 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1511 Lisp_Object width
= Qnil
, size
= Qnil
;
1515 /* Scan backwards from the end, looking for a size. */
1516 for (p
= name
+ len
- 1; p
>= name
; p
--)
1517 if (!c_isdigit (*p
))
1520 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1521 /* Found a font size. */
1522 size
= make_float (strtod (p
+ 1, NULL
));
1526 /* Now P points to the termination of the string, sans size.
1527 Scan backwards, looking for font properties. */
1528 for (; p
> name
; p
= q
)
1530 for (q
= p
- 1; q
>= name
; q
--)
1532 if (q
> name
&& *(q
-1) == '\\')
1533 --q
; /* Skip quoting backslashes. */
1539 word_len
= p
- word_start
;
1541 #define PROP_MATCH(STR) \
1542 (word_len == strlen (STR) \
1543 && memcmp (word_start, STR, strlen (STR)) == 0)
1544 #define PROP_SAVE(VAR, STR) \
1545 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1547 if (PROP_MATCH ("Ultra-Light"))
1548 PROP_SAVE (weight
, "ultra-light");
1549 else if (PROP_MATCH ("Light"))
1550 PROP_SAVE (weight
, "light");
1551 else if (PROP_MATCH ("Book"))
1552 PROP_SAVE (weight
, "book");
1553 else if (PROP_MATCH ("Medium"))
1554 PROP_SAVE (weight
, "medium");
1555 else if (PROP_MATCH ("Semi-Bold"))
1556 PROP_SAVE (weight
, "semi-bold");
1557 else if (PROP_MATCH ("Bold"))
1558 PROP_SAVE (weight
, "bold");
1559 else if (PROP_MATCH ("Italic"))
1560 PROP_SAVE (slant
, "italic");
1561 else if (PROP_MATCH ("Oblique"))
1562 PROP_SAVE (slant
, "oblique");
1563 else if (PROP_MATCH ("Semi-Condensed"))
1564 PROP_SAVE (width
, "semi-condensed");
1565 else if (PROP_MATCH ("Condensed"))
1566 PROP_SAVE (width
, "condensed");
1567 /* An unknown word must be part of the font name. */
1578 ASET (font
, FONT_FAMILY_INDEX
,
1579 font_intern_prop (name
, family_end
- name
, 1));
1581 ASET (font
, FONT_SIZE_INDEX
, size
);
1583 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1585 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1587 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1593 #if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
1595 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1596 NAME (NBYTES length), and return the name length. If
1597 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
1598 Return a negative value on error. */
1601 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1603 Lisp_Object family
, foundry
;
1609 Lisp_Object styles
[3];
1610 const char *style_names
[3] = { "weight", "slant", "width" };
1612 family
= AREF (font
, FONT_FAMILY_INDEX
);
1613 if (! NILP (family
))
1615 if (SYMBOLP (family
))
1616 family
= SYMBOL_NAME (family
);
1621 val
= AREF (font
, FONT_SIZE_INDEX
);
1624 if (XINT (val
) != 0)
1625 pixel_size
= XINT (val
);
1630 eassert (FLOATP (val
));
1632 point_size
= (int) XFLOAT_DATA (val
);
1635 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1636 if (! NILP (foundry
))
1638 if (SYMBOLP (foundry
))
1639 foundry
= SYMBOL_NAME (foundry
);
1644 for (i
= 0; i
< 3; i
++)
1645 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1648 lim
= name
+ nbytes
;
1649 if (! NILP (family
))
1651 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1652 if (! (0 <= len
&& len
< lim
- p
))
1658 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1659 if (! (0 <= len
&& len
< lim
- p
))
1663 else if (pixel_size
> 0)
1665 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1666 if (! (0 <= len
&& len
< lim
- p
))
1670 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1672 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1673 SSDATA (SYMBOL_NAME (AREF (font
,
1674 FONT_FOUNDRY_INDEX
))));
1675 if (! (0 <= len
&& len
< lim
- p
))
1679 for (i
= 0; i
< 3; i
++)
1680 if (! NILP (styles
[i
]))
1682 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1683 SSDATA (SYMBOL_NAME (styles
[i
])));
1684 if (! (0 <= len
&& len
< lim
- p
))
1689 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1691 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1692 XINT (AREF (font
, FONT_DPI_INDEX
)));
1693 if (! (0 <= len
&& len
< lim
- p
))
1698 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1700 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1701 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1702 if (! (0 <= len
&& len
< lim
- p
))
1707 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1709 int len
= snprintf (p
, lim
- p
,
1710 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1712 : ":scalable=false"));
1713 if (! (0 <= len
&& len
< lim
- p
))
1723 /* Parse NAME (null terminated) and store information in FONT
1724 (font-spec or font-entity). If NAME is successfully parsed, return
1725 0. Otherwise return -1. */
1728 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1730 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1731 return font_parse_xlfd (name
, namelen
, font
);
1732 return font_parse_fcname (name
, namelen
, font
);
1736 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1737 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1741 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1747 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1749 CHECK_STRING (family
);
1750 len
= SBYTES (family
);
1751 p0
= SSDATA (family
);
1752 p1
= strchr (p0
, '-');
1755 if ((*p0
!= '*' && p1
- p0
> 0)
1756 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1757 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1760 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1763 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1765 if (! NILP (registry
))
1767 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1768 CHECK_STRING (registry
);
1769 len
= SBYTES (registry
);
1770 p0
= SSDATA (registry
);
1771 p1
= strchr (p0
, '-');
1774 AUTO_STRING (extra
, ("*-*" + (len
&& p0
[len
- 1] == '*')));
1775 registry
= concat2 (registry
, extra
);
1777 registry
= Fdowncase (registry
);
1778 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1783 /* This part (through the next ^L) is still experimental and not
1784 tested much. We may drastically change codes. */
1790 #define LGSTRING_HEADER_SIZE 6
1791 #define LGSTRING_GLYPH_SIZE 8
1794 check_gstring (Lisp_Object gstring
)
1800 CHECK_VECTOR (gstring
);
1801 val
= AREF (gstring
, 0);
1803 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1805 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1806 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1807 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1808 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1809 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1810 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1811 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1812 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1813 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1814 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1815 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1817 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1819 val
= LGSTRING_GLYPH (gstring
, i
);
1821 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1823 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1825 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1826 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1827 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1828 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1829 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1830 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1831 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1832 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1834 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1836 if (ASIZE (val
) < 3)
1838 for (j
= 0; j
< 3; j
++)
1839 CHECK_NUMBER (AREF (val
, j
));
1844 error ("Invalid glyph-string format");
1849 check_otf_features (Lisp_Object otf_features
)
1853 CHECK_CONS (otf_features
);
1854 CHECK_SYMBOL (XCAR (otf_features
));
1855 otf_features
= XCDR (otf_features
);
1856 CHECK_CONS (otf_features
);
1857 CHECK_SYMBOL (XCAR (otf_features
));
1858 otf_features
= XCDR (otf_features
);
1859 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1861 CHECK_SYMBOL (XCAR (val
));
1862 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1863 error ("Invalid OTF GSUB feature: %s",
1864 SDATA (SYMBOL_NAME (XCAR (val
))));
1866 otf_features
= XCDR (otf_features
);
1867 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1869 CHECK_SYMBOL (XCAR (val
));
1870 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1871 error ("Invalid OTF GPOS feature: %s",
1872 SDATA (SYMBOL_NAME (XCAR (val
))));
1879 Lisp_Object otf_list
;
1882 otf_tag_symbol (OTF_Tag tag
)
1886 OTF_tag_name (tag
, name
);
1887 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1891 otf_open (Lisp_Object file
)
1893 Lisp_Object val
= Fassoc (file
, otf_list
);
1897 otf
= XSAVE_POINTER (XCDR (val
), 0);
1900 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1901 val
= make_save_ptr (otf
);
1902 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1908 /* Return a list describing which scripts/languages FONT supports by
1909 which GSUB/GPOS features of OpenType tables. See the comment of
1910 (struct font_driver).otf_capability. */
1913 font_otf_capability (struct font
*font
)
1916 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1919 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1922 for (i
= 0; i
< 2; i
++)
1924 OTF_GSUB_GPOS
*gsub_gpos
;
1925 Lisp_Object script_list
= Qnil
;
1928 if (OTF_get_features (otf
, i
== 0) < 0)
1930 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1931 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1933 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1934 Lisp_Object langsys_list
= Qnil
;
1935 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1938 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1940 OTF_LangSys
*langsys
;
1941 Lisp_Object feature_list
= Qnil
;
1942 Lisp_Object langsys_tag
;
1945 if (k
== script
->LangSysCount
)
1947 langsys
= &script
->DefaultLangSys
;
1952 langsys
= script
->LangSys
+ k
;
1954 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1956 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1958 OTF_Feature
*feature
1959 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1960 Lisp_Object feature_tag
1961 = otf_tag_symbol (feature
->FeatureTag
);
1963 feature_list
= Fcons (feature_tag
, feature_list
);
1965 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1968 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1973 XSETCAR (capability
, script_list
);
1975 XSETCDR (capability
, script_list
);
1981 /* Parse OTF features in SPEC and write a proper features spec string
1982 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1983 assured that the sufficient memory has already allocated for
1987 generate_otf_features (Lisp_Object spec
, char *features
)
1995 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2001 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2006 else if (! asterisk
)
2008 val
= SYMBOL_NAME (val
);
2009 p
+= esprintf (p
, "%s", SDATA (val
));
2013 val
= SYMBOL_NAME (val
);
2014 p
+= esprintf (p
, "~%s", SDATA (val
));
2018 error ("OTF spec too long");
2022 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
2024 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2026 return Fcons (make_number (len
),
2027 make_unibyte_string (device_table
->DeltaValue
, len
));
2031 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2033 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2035 if (value_format
& OTF_XPlacement
)
2036 ASET (val
, 0, make_number (value_record
->XPlacement
));
2037 if (value_format
& OTF_YPlacement
)
2038 ASET (val
, 1, make_number (value_record
->YPlacement
));
2039 if (value_format
& OTF_XAdvance
)
2040 ASET (val
, 2, make_number (value_record
->XAdvance
));
2041 if (value_format
& OTF_YAdvance
)
2042 ASET (val
, 3, make_number (value_record
->YAdvance
));
2043 if (value_format
& OTF_XPlaDevice
)
2044 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2045 if (value_format
& OTF_YPlaDevice
)
2046 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2047 if (value_format
& OTF_XAdvDevice
)
2048 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2049 if (value_format
& OTF_YAdvDevice
)
2050 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2055 font_otf_Anchor (OTF_Anchor
*anchor
)
2059 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2060 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2061 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2062 if (anchor
->AnchorFormat
== 2)
2063 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2066 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2067 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2071 #endif /* HAVE_LIBOTF */
2078 font_rescale_ratio (Lisp_Object font_entity
)
2080 Lisp_Object tail
, elt
;
2081 Lisp_Object name
= Qnil
;
2083 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2086 if (FLOATP (XCDR (elt
)))
2088 if (STRINGP (XCAR (elt
)))
2091 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2092 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2093 return XFLOAT_DATA (XCDR (elt
));
2095 else if (FONT_SPEC_P (XCAR (elt
)))
2097 if (font_match_p (XCAR (elt
), font_entity
))
2098 return XFLOAT_DATA (XCDR (elt
));
2105 /* We sort fonts by scoring each of them against a specified
2106 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2107 the value is, the closer the font is to the font-spec.
2109 The lowest 2 bits of the score are used for driver type. The font
2110 available by the most preferred font driver is 0.
2112 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2113 WEIGHT, SLANT, WIDTH, and SIZE. */
2115 /* How many bits to shift to store the difference value of each font
2116 property in a score. Note that floats for FONT_TYPE_INDEX and
2117 FONT_REGISTRY_INDEX are not used. */
2118 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2120 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2121 The return value indicates how different ENTITY is compared with
2125 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2130 /* Score three style numeric fields. Maximum difference is 127. */
2131 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2132 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2134 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2135 - (XINT (spec_prop
[i
]) >> 8));
2136 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2139 /* Score the size. Maximum difference is 127. */
2140 i
= FONT_SIZE_INDEX
;
2141 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2142 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2144 /* We use the higher 6-bit for the actual size difference. The
2145 lowest bit is set if the DPI is different. */
2147 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2148 EMACS_INT entity_size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
2150 if (CONSP (Vface_font_rescale_alist
))
2151 pixel_size
*= font_rescale_ratio (entity
);
2152 if (pixel_size
* 2 < entity_size
|| entity_size
* 2 < pixel_size
)
2153 /* This size is wrong by more than a factor 2: reject it! */
2155 diff
= eabs (pixel_size
- entity_size
) << 1;
2156 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2157 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2159 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2160 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2162 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2169 /* Concatenate all elements of LIST into one vector. LIST is a list
2170 of font-entity vectors. */
2173 font_vconcat_entity_vectors (Lisp_Object list
)
2175 EMACS_INT nargs
= XFASTINT (Flength (list
));
2178 SAFE_ALLOCA_LISP (args
, nargs
);
2181 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2182 args
[i
] = XCAR (list
);
2183 Lisp_Object result
= Fvconcat (nargs
, args
);
2189 /* The structure for elements being sorted by qsort. */
2190 struct font_sort_data
2193 int font_driver_preference
;
2198 /* The comparison function for qsort. */
2201 font_compare (const void *d1
, const void *d2
)
2203 const struct font_sort_data
*data1
= d1
;
2204 const struct font_sort_data
*data2
= d2
;
2206 if (data1
->score
< data2
->score
)
2208 else if (data1
->score
> data2
->score
)
2210 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2214 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2215 If PREFER specifies a point-size, calculate the corresponding
2216 pixel-size from QCdpi property of PREFER or from the Y-resolution
2217 of FRAME before sorting.
2219 If BEST-ONLY is nonzero, return the best matching entity (that
2220 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2221 if BEST-ONLY is negative). Otherwise, return the sorted result as
2222 a single vector of font-entities.
2224 This function does no optimization for the case that the total
2225 number of elements is 1. The caller should avoid calling this in
2229 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2230 struct frame
*f
, int best_only
)
2232 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2234 struct font_sort_data
*data
;
2235 unsigned best_score
;
2236 Lisp_Object best_entity
;
2237 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2240 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2241 prefer_prop
[i
] = AREF (prefer
, i
);
2242 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2243 prefer_prop
[FONT_SIZE_INDEX
]
2244 = make_number (font_pixel_size (f
, prefer
));
2246 if (NILP (XCDR (list
)))
2248 /* What we have to take care of is this single vector. */
2250 maxlen
= ASIZE (vec
);
2254 /* We don't have to perform sort, so there's no need of creating
2255 a single vector. But, we must find the length of the longest
2258 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2259 if (maxlen
< ASIZE (XCAR (tail
)))
2260 maxlen
= ASIZE (XCAR (tail
));
2264 /* We have to create a single vector to sort it. */
2265 vec
= font_vconcat_entity_vectors (list
);
2266 maxlen
= ASIZE (vec
);
2269 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2270 best_score
= 0xFFFFFFFF;
2273 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2275 int font_driver_preference
= 0;
2276 Lisp_Object current_font_driver
;
2282 /* We are sure that the length of VEC > 0. */
2283 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2284 /* Score the elements. */
2285 for (i
= 0; i
< len
; i
++)
2287 data
[i
].entity
= AREF (vec
, i
);
2289 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2291 ? font_score (data
[i
].entity
, prefer_prop
)
2293 if (best_only
&& best_score
> data
[i
].score
)
2295 best_score
= data
[i
].score
;
2296 best_entity
= data
[i
].entity
;
2297 if (best_score
== 0)
2300 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2302 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2303 font_driver_preference
++;
2305 data
[i
].font_driver_preference
= font_driver_preference
;
2308 /* Sort if necessary. */
2311 qsort (data
, len
, sizeof *data
, font_compare
);
2312 for (i
= 0; i
< len
; i
++)
2313 ASET (vec
, i
, data
[i
].entity
);
2322 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2327 /* API of Font Service Layer. */
2329 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2330 sort_shift_bits. Finternal_set_font_selection_order calls this
2331 function with font_sort_order after setting up it. */
2334 font_update_sort_order (int *order
)
2338 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2340 int xlfd_idx
= order
[i
];
2342 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2343 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2344 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2345 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2346 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2347 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2349 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2354 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2355 Lisp_Object features
, Lisp_Object table
)
2360 table
= assq_no_quit (script
, table
);
2363 table
= XCDR (table
);
2364 if (! NILP (langsys
))
2366 table
= assq_no_quit (langsys
, table
);
2372 val
= assq_no_quit (Qnil
, table
);
2374 table
= XCAR (table
);
2378 table
= XCDR (table
);
2379 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2381 if (NILP (XCAR (features
)))
2386 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2392 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2395 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2397 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2399 script
= XCAR (spec
);
2403 langsys
= XCAR (spec
);
2414 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2415 XCAR (otf_capability
)))
2417 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2418 XCDR (otf_capability
)))
2425 /* Check if FONT (font-entity or font-object) matches with the font
2426 specification SPEC. */
2429 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2431 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2432 Lisp_Object extra
, font_extra
;
2435 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2436 if (! NILP (AREF (spec
, i
))
2437 && ! NILP (AREF (font
, i
))
2438 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2440 props
= XFONT_SPEC (spec
)->props
;
2441 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2443 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2444 prop
[i
] = AREF (spec
, i
);
2445 prop
[FONT_SIZE_INDEX
]
2446 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2450 if (font_score (font
, props
) > 0)
2452 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2453 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2454 for (; CONSP (extra
); extra
= XCDR (extra
))
2456 Lisp_Object key
= XCAR (XCAR (extra
));
2457 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2459 if (EQ (key
, QClang
))
2461 val2
= assq_no_quit (key
, font_extra
);
2470 if (NILP (Fmemq (val
, val2
)))
2475 ? NILP (Fmemq (val
, XCDR (val2
)))
2479 else if (EQ (key
, QCscript
))
2481 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2487 /* All characters in the list must be supported. */
2488 for (; CONSP (val2
); val2
= XCDR (val2
))
2490 if (! CHARACTERP (XCAR (val2
)))
2492 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2493 == FONT_INVALID_CODE
)
2497 else if (VECTORP (val2
))
2499 /* At most one character in the vector must be supported. */
2500 for (i
= 0; i
< ASIZE (val2
); i
++)
2502 if (! CHARACTERP (AREF (val2
, i
)))
2504 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2505 != FONT_INVALID_CODE
)
2508 if (i
== ASIZE (val2
))
2513 else if (EQ (key
, QCotf
))
2517 if (! FONT_OBJECT_P (font
))
2519 fontp
= XFONT_OBJECT (font
);
2520 if (! fontp
->driver
->otf_capability
)
2522 val2
= fontp
->driver
->otf_capability (fontp
);
2523 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2534 Each font backend has the callback function get_cache, and it
2535 returns a cons cell of which cdr part can be freely used for
2536 caching fonts. The cons cell may be shared by multiple frames
2537 and/or multiple font drivers. So, we arrange the cdr part as this:
2539 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2541 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2542 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2543 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2545 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2546 static void font_finish_cache (struct frame
*, struct font_driver
*);
2547 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2548 static void font_clear_cache (struct frame
*, Lisp_Object
,
2549 struct font_driver
*);
2552 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2554 Lisp_Object cache
, val
;
2556 cache
= driver
->get_cache (f
);
2558 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2562 val
= list2 (driver
->type
, make_number (1));
2563 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2567 val
= XCDR (XCAR (val
));
2568 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2574 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2576 Lisp_Object cache
, val
, tmp
;
2579 cache
= driver
->get_cache (f
);
2581 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2582 cache
= val
, val
= XCDR (val
);
2583 eassert (! NILP (val
));
2584 tmp
= XCDR (XCAR (val
));
2585 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2586 if (XINT (XCAR (tmp
)) == 0)
2588 font_clear_cache (f
, XCAR (val
), driver
);
2589 XSETCDR (cache
, XCDR (val
));
2595 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2597 Lisp_Object val
= driver
->get_cache (f
);
2598 Lisp_Object type
= driver
->type
;
2600 eassert (CONSP (val
));
2601 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2602 eassert (CONSP (val
));
2603 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2604 val
= XCDR (XCAR (val
));
2610 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2612 Lisp_Object tail
, elt
;
2616 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2617 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2620 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2621 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2624 eassert (VECTORP (elt
));
2625 for (i
= 0; i
< ASIZE (elt
); i
++)
2627 entity
= AREF (elt
, i
);
2629 if (FONT_ENTITY_P (entity
)
2630 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2632 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2634 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2636 Lisp_Object val
= XCAR (objlist
);
2637 struct font
*font
= XFONT_OBJECT (val
);
2639 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2641 eassert (font
&& driver
== font
->driver
);
2642 driver
->close (font
);
2645 if (driver
->free_entity
)
2646 driver
->free_entity (entity
);
2651 XSETCDR (cache
, Qnil
);
2655 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2657 /* Check each font-entity in VEC, and return a list of font-entities
2658 that satisfy these conditions:
2659 (1) matches with SPEC and SIZE if SPEC is not nil, and
2660 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2664 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2666 Lisp_Object entity
, val
;
2667 enum font_property_index prop
;
2670 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2672 entity
= AREF (vec
, i
);
2673 if (! NILP (Vface_ignored_fonts
))
2677 Lisp_Object tail
, regexp
;
2679 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2682 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2684 regexp
= XCAR (tail
);
2685 if (STRINGP (regexp
)
2686 && fast_c_string_match_ignore_case (regexp
, name
,
2696 val
= Fcons (entity
, val
);
2699 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2700 if (INTEGERP (AREF (spec
, prop
))
2701 && ((XINT (AREF (spec
, prop
)) >> 8)
2702 != (XINT (AREF (entity
, prop
)) >> 8)))
2703 prop
= FONT_SPEC_MAX
;
2704 if (prop
< FONT_SPEC_MAX
2706 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2708 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2710 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2711 prop
= FONT_SPEC_MAX
;
2713 if (prop
< FONT_SPEC_MAX
2714 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2715 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2716 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2717 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2718 prop
= FONT_SPEC_MAX
;
2719 if (prop
< FONT_SPEC_MAX
2720 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2721 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2722 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2723 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2724 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2725 prop
= FONT_SPEC_MAX
;
2726 if (prop
< FONT_SPEC_MAX
)
2727 val
= Fcons (entity
, val
);
2729 return (Fvconcat (1, &val
));
2733 /* Return a list of vectors of font-entities matching with SPEC on
2734 FRAME. Each elements in the list is a vector of entities from the
2735 same font-driver. */
2738 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2740 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2741 Lisp_Object ftype
, val
;
2742 Lisp_Object list
= Qnil
;
2744 bool need_filtering
= 0;
2747 eassert (FONT_SPEC_P (spec
));
2749 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2750 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2751 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2752 size
= font_pixel_size (f
, spec
);
2756 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2757 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2758 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2759 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2760 if (i
!= FONT_SPACING_INDEX
)
2762 ASET (scratch_font_spec
, i
, Qnil
);
2763 if (! NILP (AREF (spec
, i
)))
2766 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2767 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2769 for (; driver_list
; driver_list
= driver_list
->next
)
2771 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2773 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2775 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2776 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2781 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2784 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2786 val
= Fvconcat (1, &val
);
2787 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2788 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2791 if (VECTORP (val
) && ASIZE (val
) > 0
2793 || ! NILP (Vface_ignored_fonts
)))
2794 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2795 if (VECTORP (val
) && ASIZE (val
) > 0)
2796 list
= Fcons (val
, list
);
2799 list
= Fnreverse (list
);
2800 FONT_ADD_LOG ("list", spec
, list
);
2805 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2806 nil, is an array of face's attributes, which specifies preferred
2807 font-related attributes. */
2810 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2812 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2813 Lisp_Object ftype
, size
, entity
;
2814 Lisp_Object work
= copy_font_spec (spec
);
2816 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2817 size
= AREF (spec
, FONT_SIZE_INDEX
);
2820 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2821 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2822 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2823 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2826 for (; driver_list
; driver_list
= driver_list
->next
)
2828 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2830 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2832 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2833 entity
= assoc_no_quit (work
, XCDR (cache
));
2835 entity
= AREF (XCDR (entity
), 0);
2838 entity
= driver_list
->driver
->match (f
, work
);
2841 Lisp_Object copy
= copy_font_spec (work
);
2842 Lisp_Object match
= Fvector (1, &entity
);
2844 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2845 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2848 if (! NILP (entity
))
2851 FONT_ADD_LOG ("match", work
, entity
);
2856 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2857 opened font object. */
2860 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2862 struct font_driver_list
*driver_list
;
2863 Lisp_Object objlist
, size
, val
, font_object
;
2865 int min_width
, height
, psize
;
2867 eassert (FONT_ENTITY_P (entity
));
2868 size
= AREF (entity
, FONT_SIZE_INDEX
);
2869 if (XINT (size
) != 0)
2870 pixel_size
= XINT (size
);
2872 val
= AREF (entity
, FONT_TYPE_INDEX
);
2873 for (driver_list
= f
->font_driver_list
;
2874 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2875 driver_list
= driver_list
->next
);
2879 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2880 objlist
= XCDR (objlist
))
2882 Lisp_Object fn
= XCAR (objlist
);
2883 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2884 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2886 if (driver_list
->driver
->cached_font_ok
== NULL
2887 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2892 /* We always open a font of manageable size; i.e non-zero average
2893 width and height. */
2894 for (psize
= pixel_size
; ; psize
++)
2896 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2897 if (NILP (font_object
))
2899 font
= XFONT_OBJECT (font_object
);
2900 if (font
->average_width
> 0 && font
->height
> 0)
2903 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2904 FONT_ADD_LOG ("open", entity
, font_object
);
2905 ASET (entity
, FONT_OBJLIST_INDEX
,
2906 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2908 font
= XFONT_OBJECT (font_object
);
2909 min_width
= (font
->min_width
? font
->min_width
2910 : font
->average_width
? font
->average_width
2911 : font
->space_width
? font
->space_width
2913 height
= (font
->height
? font
->height
: 1);
2914 #ifdef HAVE_WINDOW_SYSTEM
2915 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2916 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2918 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2919 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2920 f
->fonts_changed
= 1;
2924 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2925 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2926 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2927 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2935 /* Close FONT_OBJECT that is opened on frame F. */
2938 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2940 struct font
*font
= XFONT_OBJECT (font_object
);
2942 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2943 /* Already closed. */
2945 FONT_ADD_LOG ("close", font_object
, Qnil
);
2946 font
->driver
->close (font
);
2947 #ifdef HAVE_WINDOW_SYSTEM
2948 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2949 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2954 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2955 FONT is a font-entity and it must be opened to check. */
2958 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2962 if (FONT_ENTITY_P (font
))
2964 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2965 struct font_driver_list
*driver_list
;
2967 for (driver_list
= f
->font_driver_list
;
2968 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2969 driver_list
= driver_list
->next
);
2972 if (! driver_list
->driver
->has_char
)
2974 return driver_list
->driver
->has_char (font
, c
);
2977 eassert (FONT_OBJECT_P (font
));
2978 fontp
= XFONT_OBJECT (font
);
2979 if (fontp
->driver
->has_char
)
2981 int result
= fontp
->driver
->has_char (font
, c
);
2986 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2990 /* Return the glyph ID of FONT_OBJECT for character C. */
2993 font_encode_char (Lisp_Object font_object
, int c
)
2997 eassert (FONT_OBJECT_P (font_object
));
2998 font
= XFONT_OBJECT (font_object
);
2999 return font
->driver
->encode_char (font
, c
);
3003 /* Return the name of FONT_OBJECT. */
3006 font_get_name (Lisp_Object font_object
)
3008 eassert (FONT_OBJECT_P (font_object
));
3009 return AREF (font_object
, FONT_NAME_INDEX
);
3013 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3014 could not be parsed by font_parse_name, return Qnil. */
3017 font_spec_from_name (Lisp_Object font_name
)
3019 Lisp_Object spec
= Ffont_spec (0, NULL
);
3021 CHECK_STRING (font_name
);
3022 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
3024 font_put_extra (spec
, QCname
, font_name
);
3025 font_put_extra (spec
, QCuser_spec
, font_name
);
3031 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3033 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3038 if (! NILP (Ffont_get (font
, QCname
)))
3040 font
= copy_font_spec (font
);
3041 font_put_extra (font
, QCname
, Qnil
);
3044 if (NILP (AREF (font
, prop
))
3045 && prop
!= FONT_FAMILY_INDEX
3046 && prop
!= FONT_FOUNDRY_INDEX
3047 && prop
!= FONT_WIDTH_INDEX
3048 && prop
!= FONT_SIZE_INDEX
)
3050 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3051 font
= copy_font_spec (font
);
3052 ASET (font
, prop
, Qnil
);
3053 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3055 if (prop
== FONT_FAMILY_INDEX
)
3057 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3058 /* If we are setting the font family, we must also clear
3059 FONT_WIDTH_INDEX to avoid rejecting families that lack
3060 support for some widths. */
3061 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3063 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3064 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3065 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3066 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3067 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3068 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3070 else if (prop
== FONT_SIZE_INDEX
)
3072 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3073 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3074 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3076 else if (prop
== FONT_WIDTH_INDEX
)
3077 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3078 attrs
[LFACE_FONT_INDEX
] = font
;
3081 /* Select a font from ENTITIES (list of font-entity vectors) that
3082 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3085 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3086 Lisp_Object
*attrs
, int pixel_size
, int c
)
3088 Lisp_Object font_entity
;
3092 if (NILP (XCDR (entities
))
3093 && ASIZE (XCAR (entities
)) == 1)
3095 font_entity
= AREF (XCAR (entities
), 0);
3096 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3101 /* Sort fonts by properties specified in ATTRS. */
3102 prefer
= scratch_font_prefer
;
3104 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3105 ASET (prefer
, i
, Qnil
);
3106 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3108 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3110 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3111 ASET (prefer
, i
, AREF (face_font
, i
));
3113 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3114 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3115 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3116 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3117 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3118 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3119 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3121 return font_sort_entities (entities
, prefer
, f
, c
);
3124 /* Return a font-entity that satisfies SPEC and is the best match for
3125 face's font related attributes in ATTRS. C, if not negative, is a
3126 character that the entity must support. */
3129 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3132 Lisp_Object entities
, val
;
3133 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3138 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3139 if (NILP (registry
[0]))
3141 registry
[0] = DEFAULT_ENCODING
;
3142 registry
[1] = Qascii_0
;
3143 registry
[2] = zero_vector
;
3146 registry
[1] = zero_vector
;
3148 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3150 struct charset
*encoding
, *repertory
;
3152 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3153 &encoding
, &repertory
) < 0)
3156 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3158 else if (c
> encoding
->max_char
)
3162 work
= copy_font_spec (spec
);
3163 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3164 pixel_size
= font_pixel_size (f
, spec
);
3165 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3167 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3169 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3173 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3174 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3175 if (! NILP (foundry
[0]))
3176 foundry
[1] = zero_vector
;
3177 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3179 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3180 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3182 foundry
[2] = zero_vector
;
3185 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3187 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3188 if (! NILP (adstyle
[0]))
3189 adstyle
[1] = zero_vector
;
3190 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3192 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3194 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3196 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3198 adstyle
[2] = zero_vector
;
3201 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3204 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3207 val
= AREF (work
, FONT_FAMILY_INDEX
);
3208 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3210 val
= attrs
[LFACE_FAMILY_INDEX
];
3211 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3213 Lisp_Object familybuf
[3];
3218 family
[1] = zero_vector
; /* terminator. */
3223 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3225 if (! NILP (alters
))
3227 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3228 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3229 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3230 family
[i
] = XCAR (alters
);
3231 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3233 family
[i
] = zero_vector
;
3240 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3242 family
[i
] = zero_vector
;
3246 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3248 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3249 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3251 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3252 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3254 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3255 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3257 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3258 entities
= font_list_entities (f
, work
);
3259 if (! NILP (entities
))
3261 val
= font_select_entity (f
, entities
,
3262 attrs
, pixel_size
, c
);
3280 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3284 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3285 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3286 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3289 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3290 size
= font_pixel_size (f
, spec
);
3294 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3295 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3298 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3299 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3300 eassert (INTEGERP (height
));
3305 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3309 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3310 size
= (NUMBERP (ffsize
)
3311 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3315 size
*= font_rescale_ratio (entity
);
3318 return font_open_entity (f
, entity
, size
);
3322 /* Find a font that satisfies SPEC and is the best match for
3323 face's attributes in ATTRS on FRAME, and return the opened
3327 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3329 Lisp_Object entity
, name
;
3331 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3334 /* No font is listed for SPEC, but each font-backend may have
3335 different criteria about "font matching". So, try it. */
3336 entity
= font_matching_entity (f
, attrs
, spec
);
3340 /* Don't lose the original name that was put in initially. We need
3341 it to re-apply the font when font parameters (like hinting or dpi) have
3343 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3346 name
= Ffont_get (spec
, QCuser_spec
);
3347 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3353 /* Make FACE on frame F ready to use the font opened for FACE. */
3356 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3358 if (face
->font
->driver
->prepare_face
)
3359 face
->font
->driver
->prepare_face (f
, face
);
3363 /* Make FACE on frame F stop using the font opened for FACE. */
3366 font_done_for_face (struct frame
*f
, struct face
*face
)
3368 if (face
->font
->driver
->done_face
)
3369 face
->font
->driver
->done_face (f
, face
);
3373 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3374 font is found, return Qnil. */
3377 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3379 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3381 /* We set up the default font-related attributes of a face to prefer
3383 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3384 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3385 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3387 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3389 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3391 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3393 return font_load_for_lface (f
, attrs
, spec
);
3397 /* Open a font that matches NAME on frame F. If no proper font is
3398 found, return Qnil. */
3401 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3403 Lisp_Object args
[2];
3404 Lisp_Object spec
, ret
;
3408 spec
= Ffont_spec (2, args
);
3409 ret
= font_open_by_spec (f
, spec
);
3410 /* Do not lose name originally put in. */
3412 font_put_extra (ret
, QCuser_spec
, args
[1]);
3418 /* Register font-driver DRIVER. This function is used in two ways.
3420 The first is with frame F non-NULL. In this case, make DRIVER
3421 available (but not yet activated) on F. All frame creators
3422 (e.g. Fx_create_frame) must call this function at least once with
3423 an available font-driver.
3425 The second is with frame F NULL. In this case, DRIVER is globally
3426 registered in the variable `font_driver_list'. All font-driver
3427 implementations must call this function in its syms_of_XXXX
3428 (e.g. syms_of_xfont). */
3431 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3433 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3434 struct font_driver_list
*prev
, *list
;
3436 #ifdef HAVE_WINDOW_SYSTEM
3437 if (f
&& ! driver
->draw
)
3438 error ("Unusable font driver for a frame: %s",
3439 SDATA (SYMBOL_NAME (driver
->type
)));
3440 #endif /* HAVE_WINDOW_SYSTEM */
3442 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3443 if (EQ (list
->driver
->type
, driver
->type
))
3444 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3446 list
= xmalloc (sizeof *list
);
3448 list
->driver
= driver
;
3453 f
->font_driver_list
= list
;
3455 font_driver_list
= list
;
3461 free_font_driver_list (struct frame
*f
)
3463 struct font_driver_list
*list
, *next
;
3465 for (list
= f
->font_driver_list
; list
; list
= next
)
3470 f
->font_driver_list
= NULL
;
3474 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3475 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3476 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3478 A caller must free all realized faces if any in advance. The
3479 return value is a list of font backends actually made used on
3483 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3485 Lisp_Object active_drivers
= Qnil
;
3486 struct font_driver_list
*list
;
3488 /* At first, turn off non-requested drivers, and turn on requested
3490 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3492 struct font_driver
*driver
= list
->driver
;
3493 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3498 if (driver
->end_for_frame
)
3499 driver
->end_for_frame (f
);
3500 font_finish_cache (f
, driver
);
3505 if (! driver
->start_for_frame
3506 || driver
->start_for_frame (f
) == 0)
3508 font_prepare_cache (f
, driver
);
3515 if (NILP (new_drivers
))
3518 if (! EQ (new_drivers
, Qt
))
3520 /* Re-order the driver list according to new_drivers. */
3521 struct font_driver_list
**list_table
, **next
;
3526 SAFE_NALLOCA (list_table
, 1, num_font_drivers
+ 1);
3527 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3529 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3530 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3533 list_table
[i
++] = list
;
3535 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3537 list_table
[i
++] = list
;
3538 list_table
[i
] = NULL
;
3540 next
= &f
->font_driver_list
;
3541 for (i
= 0; list_table
[i
]; i
++)
3543 *next
= list_table
[i
];
3544 next
= &(*next
)->next
;
3549 if (! f
->font_driver_list
->on
)
3550 { /* None of the drivers is enabled: enable them all.
3551 Happens if you set the list of drivers to (xft x) in your .emacs
3552 and then use it under w32 or ns. */
3553 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3555 struct font_driver
*driver
= list
->driver
;
3556 eassert (! list
->on
);
3557 if (! driver
->start_for_frame
3558 || driver
->start_for_frame (f
) == 0)
3560 font_prepare_cache (f
, driver
);
3567 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3569 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3570 return active_drivers
;
3573 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
3576 fset_font_data (struct frame
*f
, Lisp_Object val
)
3582 font_put_frame_data (struct frame
*f
, Lisp_Object driver
, void *data
)
3584 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3587 fset_font_data (f
, Fdelq (val
, f
->font_data
));
3591 fset_font_data (f
, Fcons (Fcons (driver
, make_save_ptr (data
)),
3594 XSETCDR (val
, make_save_ptr (data
));
3599 font_get_frame_data (struct frame
*f
, Lisp_Object driver
)
3601 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3603 return NILP (val
) ? NULL
: XSAVE_POINTER (XCDR (val
), 0);
3606 #endif /* HAVE_XFT || HAVE_FREETYPE */
3608 /* Sets attributes on a font. Any properties that appear in ALIST and
3609 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3610 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3611 arrays of strings. This function is intended for use by the font
3612 drivers to implement their specific font_filter_properties. */
3614 font_filter_properties (Lisp_Object font
,
3616 const char *const boolean_properties
[],
3617 const char *const non_boolean_properties
[])
3622 /* Set boolean values to Qt or Qnil. */
3623 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3624 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3626 Lisp_Object key
= XCAR (XCAR (it
));
3627 Lisp_Object val
= XCDR (XCAR (it
));
3628 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3630 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3632 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3633 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3636 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3637 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3638 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3639 || strcmp ("Off", str
) == 0)
3644 Ffont_put (font
, key
, val
);
3648 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3649 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3651 Lisp_Object key
= XCAR (XCAR (it
));
3652 Lisp_Object val
= XCDR (XCAR (it
));
3653 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3654 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3655 Ffont_put (font
, key
, val
);
3660 /* Return the font used to draw character C by FACE at buffer position
3661 POS in window W. If STRING is non-nil, it is a string containing C
3662 at index POS. If C is negative, get C from the current buffer or
3666 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3671 Lisp_Object font_object
;
3673 multibyte
= (NILP (string
)
3674 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3675 : STRING_MULTIBYTE (string
));
3682 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3684 c
= FETCH_CHAR (pos_byte
);
3687 c
= FETCH_BYTE (pos
);
3693 multibyte
= STRING_MULTIBYTE (string
);
3696 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3698 str
= SDATA (string
) + pos_byte
;
3699 c
= STRING_CHAR (str
);
3702 c
= SDATA (string
)[pos
];
3706 f
= XFRAME (w
->frame
);
3707 if (! FRAME_WINDOW_P (f
))
3714 if (STRINGP (string
))
3715 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3716 DEFAULT_FACE_ID
, 0);
3718 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3720 face
= FACE_FROM_ID (f
, face_id
);
3724 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3725 face
= FACE_FROM_ID (f
, face_id
);
3730 XSETFONT (font_object
, face
->font
);
3735 #ifdef HAVE_WINDOW_SYSTEM
3737 /* Check how many characters after character/byte position POS/POS_BYTE
3738 (at most to *LIMIT) can be displayed by the same font in the window W.
3739 FACE, if non-NULL, is the face selected for the character at POS.
3740 If STRING is not nil, it is the string to check instead of the current
3741 buffer. In that case, FACE must be not NULL.
3743 The return value is the font-object for the character at POS.
3744 *LIMIT is set to the position where that font can't be used.
3746 It is assured that the current buffer (or STRING) is multibyte. */
3749 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3750 struct window
*w
, struct face
*face
, Lisp_Object string
)
3754 Lisp_Object font_object
= Qnil
;
3762 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3764 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3770 while (pos
< *limit
)
3772 Lisp_Object category
;
3775 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3777 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3778 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3779 if (INTEGERP (category
)
3780 && (XINT (category
) == UNICODE_CATEGORY_Cf
3781 || CHAR_VARIATION_SELECTOR_P (c
)))
3783 if (NILP (font_object
))
3785 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3786 if (NILP (font_object
))
3790 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3800 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3801 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3802 Return nil otherwise.
3803 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3804 which kind of font it is. It must be one of `font-spec', `font-entity',
3806 (Lisp_Object object
, Lisp_Object extra_type
)
3808 if (NILP (extra_type
))
3809 return (FONTP (object
) ? Qt
: Qnil
);
3810 if (EQ (extra_type
, Qfont_spec
))
3811 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3812 if (EQ (extra_type
, Qfont_entity
))
3813 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3814 if (EQ (extra_type
, Qfont_object
))
3815 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3816 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3819 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3820 doc
: /* Return a newly created font-spec with arguments as properties.
3822 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3823 valid font property name listed below:
3825 `:family', `:weight', `:slant', `:width'
3827 They are the same as face attributes of the same name. See
3828 `set-face-attribute'.
3832 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3836 VALUE must be a string or a symbol specifying the additional
3837 typographic style information of a font, e.g. ``sans''.
3841 VALUE must be a string or a symbol specifying the charset registry and
3842 encoding of a font, e.g. ``iso8859-1''.
3846 VALUE must be a non-negative integer or a floating point number
3847 specifying the font size. It specifies the font size in pixels (if
3848 VALUE is an integer), or in points (if VALUE is a float).
3852 VALUE must be a string of XLFD-style or fontconfig-style font name.
3856 VALUE must be a symbol representing a script that the font must
3857 support. It may be a symbol representing a subgroup of a script
3858 listed in the variable `script-representative-chars'.
3862 VALUE must be a symbol of two-letter ISO-639 language names,
3867 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3868 required OpenType features.
3870 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3871 LANGSYS-TAG: OpenType language system tag symbol,
3872 or nil for the default language system.
3873 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3874 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3876 GSUB and GPOS may contain `nil' element. In such a case, the font
3877 must not have any of the remaining elements.
3879 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3880 be an OpenType font whose GPOS table of `thai' script's default
3881 language system must contain `mark' feature.
3883 usage: (font-spec ARGS...) */)
3884 (ptrdiff_t nargs
, Lisp_Object
*args
)
3886 Lisp_Object spec
= font_make_spec ();
3889 for (i
= 0; i
< nargs
; i
+= 2)
3891 Lisp_Object key
= args
[i
], val
;
3895 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3898 if (EQ (key
, QCname
))
3901 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3902 error ("Invalid font name: %s", SSDATA (val
));
3903 font_put_extra (spec
, key
, val
);
3907 int idx
= get_font_prop_index (key
);
3911 val
= font_prop_validate (idx
, Qnil
, val
);
3912 if (idx
< FONT_EXTRA_INDEX
)
3913 ASET (spec
, idx
, val
);
3915 font_put_extra (spec
, key
, val
);
3918 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3924 /* Return a copy of FONT as a font-spec. For the sake of speed, this code
3925 relies on an internal stuff exposed from alloc.c and should be handled
3929 copy_font_spec (Lisp_Object font
)
3931 enum { font_spec_size
= VECSIZE (struct font_spec
) };
3932 Lisp_Object new_spec
, tail
, *pcdr
;
3933 struct font_spec
*spec
;
3937 /* Make an uninitialized font-spec object. */
3938 spec
= (struct font_spec
*) allocate_vector (font_spec_size
);
3939 XSETPVECTYPESIZE (spec
, PVEC_FONT
, FONT_SPEC_MAX
,
3940 font_spec_size
- FONT_SPEC_MAX
);
3942 spec
->props
[FONT_TYPE_INDEX
] = spec
->props
[FONT_EXTRA_INDEX
] = Qnil
;
3944 /* Copy basic properties FONT_FOUNDRY_INDEX..FONT_AVGWIDTH_INDEX. */
3945 memcpy (spec
->props
+ 1, XVECTOR (font
)->contents
+ 1,
3946 (FONT_EXTRA_INDEX
- 1) * word_size
);
3948 /* Copy an alist of extra information but discard :font-entity property. */
3949 pcdr
= spec
->props
+ FONT_EXTRA_INDEX
;
3950 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3951 if (!EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3952 *pcdr
= Fcons (XCAR (tail
), Qnil
), pcdr
= xcdr_addr (*pcdr
);
3954 XSETFONT (new_spec
, spec
);
3958 /* Merge font-specs FROM and TO, and return a new font-spec.
3959 Every specified property in FROM overrides the corresponding
3962 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3964 Lisp_Object extra
, tail
;
3969 to
= copy_font_spec (to
);
3970 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3971 ASET (to
, i
, AREF (from
, i
));
3972 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3973 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3974 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3976 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3979 XSETCDR (slot
, XCDR (XCAR (tail
)));
3981 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3983 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3987 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3988 doc
: /* Return the value of FONT's property KEY.
3989 FONT is a font-spec, a font-entity, or a font-object.
3990 KEY is any symbol, but these are reserved for specific meanings:
3991 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3992 :size, :name, :script, :otf
3993 See the documentation of `font-spec' for their meanings.
3994 In addition, if FONT is a font-entity or a font-object, values of
3995 :script and :otf are different from those of a font-spec as below:
3997 The value of :script may be a list of scripts that are supported by the font.
3999 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
4000 representing the OpenType features supported by the font by this form:
4001 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4002 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
4004 (Lisp_Object font
, Lisp_Object key
)
4012 idx
= get_font_prop_index (key
);
4013 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4014 return font_style_symbolic (font
, idx
, 0);
4015 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4016 return AREF (font
, idx
);
4017 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4018 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4020 struct font
*fontp
= XFONT_OBJECT (font
);
4022 if (fontp
->driver
->otf_capability
)
4023 val
= fontp
->driver
->otf_capability (fontp
);
4025 val
= Fcons (Qnil
, Qnil
);
4032 #ifdef HAVE_WINDOW_SYSTEM
4034 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4035 doc
: /* Return a plist of face attributes generated by FONT.
4036 FONT is a font name, a font-spec, a font-entity, or a font-object.
4037 The return value is a list of the form
4039 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4041 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4042 compatible with `set-face-attribute'. Some of these key-attribute pairs
4043 may be omitted from the list if they are not specified by FONT.
4045 The optional argument FRAME specifies the frame that the face attributes
4046 are to be displayed on. If omitted, the selected frame is used. */)
4047 (Lisp_Object font
, Lisp_Object frame
)
4049 struct frame
*f
= decode_live_frame (frame
);
4050 Lisp_Object plist
[10];
4056 int fontset
= fs_query_fontset (font
, 0);
4057 Lisp_Object name
= font
;
4059 font
= fontset_ascii (fontset
);
4060 font
= font_spec_from_name (name
);
4062 signal_error ("Invalid font name", name
);
4064 else if (! FONTP (font
))
4065 signal_error ("Invalid font object", font
);
4067 val
= AREF (font
, FONT_FAMILY_INDEX
);
4070 plist
[n
++] = QCfamily
;
4071 plist
[n
++] = SYMBOL_NAME (val
);
4074 val
= AREF (font
, FONT_SIZE_INDEX
);
4077 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4078 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4079 plist
[n
++] = QCheight
;
4080 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4082 else if (FLOATP (val
))
4084 plist
[n
++] = QCheight
;
4085 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4088 val
= FONT_WEIGHT_FOR_FACE (font
);
4091 plist
[n
++] = QCweight
;
4095 val
= FONT_SLANT_FOR_FACE (font
);
4098 plist
[n
++] = QCslant
;
4102 val
= FONT_WIDTH_FOR_FACE (font
);
4105 plist
[n
++] = QCwidth
;
4109 return Flist (n
, plist
);
4114 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4115 doc
: /* Set one property of FONT: give property KEY value VAL.
4116 FONT is a font-spec, a font-entity, or a font-object.
4118 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4119 accepted by the function `font-spec' (which see), VAL must be what
4120 allowed in `font-spec'.
4122 If FONT is a font-entity or a font-object, KEY must not be the one
4123 accepted by `font-spec'. */)
4124 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4128 idx
= get_font_prop_index (prop
);
4129 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4131 CHECK_FONT_SPEC (font
);
4132 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4136 if (EQ (prop
, QCname
)
4137 || EQ (prop
, QCscript
)
4138 || EQ (prop
, QClang
)
4139 || EQ (prop
, QCotf
))
4140 CHECK_FONT_SPEC (font
);
4143 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4148 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4149 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4150 Optional 2nd argument FRAME specifies the target frame.
4151 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4152 Optional 4th argument PREFER, if non-nil, is a font-spec to
4153 control the order of the returned list. Fonts are sorted by
4154 how close they are to PREFER. */)
4155 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4157 struct frame
*f
= decode_live_frame (frame
);
4158 Lisp_Object vec
, list
;
4161 CHECK_FONT_SPEC (font_spec
);
4169 if (! NILP (prefer
))
4170 CHECK_FONT_SPEC (prefer
);
4172 list
= font_list_entities (f
, font_spec
);
4175 if (NILP (XCDR (list
))
4176 && ASIZE (XCAR (list
)) == 1)
4177 return list1 (AREF (XCAR (list
), 0));
4179 if (! NILP (prefer
))
4180 vec
= font_sort_entities (list
, prefer
, f
, 0);
4182 vec
= font_vconcat_entity_vectors (list
);
4183 if (n
== 0 || n
>= ASIZE (vec
))
4185 Lisp_Object args
[2];
4189 list
= Fappend (2, args
);
4193 for (list
= Qnil
, n
--; n
>= 0; n
--)
4194 list
= Fcons (AREF (vec
, n
), list
);
4199 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4200 doc
: /* List available font families on the current frame.
4201 If FRAME is omitted or nil, the selected frame is used. */)
4204 struct frame
*f
= decode_live_frame (frame
);
4205 struct font_driver_list
*driver_list
;
4206 Lisp_Object list
= Qnil
;
4208 for (driver_list
= f
->font_driver_list
; driver_list
;
4209 driver_list
= driver_list
->next
)
4210 if (driver_list
->driver
->list_family
)
4212 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4213 Lisp_Object tail
= list
;
4215 for (; CONSP (val
); val
= XCDR (val
))
4216 if (NILP (Fmemq (XCAR (val
), tail
))
4217 && SYMBOLP (XCAR (val
)))
4218 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4223 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4224 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4225 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4226 (Lisp_Object font_spec
, Lisp_Object frame
)
4228 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4235 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4236 doc
: /* Return XLFD name of FONT.
4237 FONT is a font-spec, font-entity, or font-object.
4238 If the name is too long for XLFD (maximum 255 chars), return nil.
4239 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4240 the consecutive wildcards are folded into one. */)
4241 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4244 int namelen
, pixel_size
= 0;
4248 if (FONT_OBJECT_P (font
))
4250 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4252 if (STRINGP (font_name
)
4253 && SDATA (font_name
)[0] == '-')
4255 if (NILP (fold_wildcards
))
4257 lispstpcpy (name
, font_name
);
4258 namelen
= SBYTES (font_name
);
4261 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4263 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4267 if (! NILP (fold_wildcards
))
4269 char *p0
= name
, *p1
;
4271 while ((p1
= strstr (p0
, "-*-*")))
4273 strcpy (p1
, p1
+ 2);
4279 return make_string (name
, namelen
);
4283 clear_font_cache (struct frame
*f
)
4285 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4287 for (; driver_list
; driver_list
= driver_list
->next
)
4288 if (driver_list
->on
)
4290 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4294 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4296 eassert (! NILP (val
));
4297 tmp
= XCDR (XCAR (val
));
4298 if (XINT (XCAR (tmp
)) == 0)
4300 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4301 XSETCDR (cache
, XCDR (val
));
4306 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4307 doc
: /* Clear font cache of each frame. */)
4310 Lisp_Object list
, frame
;
4312 FOR_EACH_FRAME (list
, frame
)
4313 clear_font_cache (XFRAME (frame
));
4320 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4322 struct font
*font
= XFONT_OBJECT (font_object
);
4323 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4324 struct font_metrics metrics
;
4326 LGLYPH_SET_CODE (glyph
, code
);
4327 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4328 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4329 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4330 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4331 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4332 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4336 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4337 doc
: /* Shape the glyph-string GSTRING.
4338 Shaping means substituting glyphs and/or adjusting positions of glyphs
4339 to get the correct visual image of character sequences set in the
4340 header of the glyph-string.
4342 If the shaping was successful, the value is GSTRING itself or a newly
4343 created glyph-string. Otherwise, the value is nil.
4345 See the documentation of `composition-get-gstring' for the format of
4347 (Lisp_Object gstring
)
4350 Lisp_Object font_object
, n
, glyph
;
4351 ptrdiff_t i
, from
, to
;
4353 if (! composition_gstring_p (gstring
))
4354 signal_error ("Invalid glyph-string: ", gstring
);
4355 if (! NILP (LGSTRING_ID (gstring
)))
4357 font_object
= LGSTRING_FONT (gstring
);
4358 CHECK_FONT_OBJECT (font_object
);
4359 font
= XFONT_OBJECT (font_object
);
4360 if (! font
->driver
->shape
)
4363 /* Try at most three times with larger gstring each time. */
4364 for (i
= 0; i
< 3; i
++)
4366 n
= font
->driver
->shape (gstring
);
4369 gstring
= larger_vector (gstring
,
4370 LGSTRING_GLYPH_LEN (gstring
), -1);
4372 if (i
== 3 || XINT (n
) == 0)
4374 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4375 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4377 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4378 GLYPHS covers all characters (except for the last few ones) in
4379 GSTRING. More formally, provided that NCHARS is the number of
4380 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4381 and TO_IDX of each glyph must satisfy these conditions:
4383 GLYPHS[0].FROM_IDX == 0
4384 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4385 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4386 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4387 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4389 ;; Be sure to cover all characters.
4390 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4391 glyph
= LGSTRING_GLYPH (gstring
, 0);
4392 from
= LGLYPH_FROM (glyph
);
4393 to
= LGLYPH_TO (glyph
);
4394 if (from
!= 0 || to
< from
)
4396 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4398 glyph
= LGSTRING_GLYPH (gstring
, i
);
4401 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4402 && (LGLYPH_FROM (glyph
) == from
4403 ? LGLYPH_TO (glyph
) == to
4404 : LGLYPH_FROM (glyph
) == to
+ 1)))
4406 from
= LGLYPH_FROM (glyph
);
4407 to
= LGLYPH_TO (glyph
);
4409 return composition_gstring_put_cache (gstring
, XINT (n
));
4415 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4417 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4418 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4420 VARIATION-SELECTOR is a character code of variation selection
4421 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4422 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4423 (Lisp_Object font_object
, Lisp_Object character
)
4425 unsigned variations
[256];
4430 CHECK_FONT_OBJECT (font_object
);
4431 CHECK_CHARACTER (character
);
4432 font
= XFONT_OBJECT (font_object
);
4433 if (! font
->driver
->get_variation_glyphs
)
4435 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4439 for (i
= 0; i
< 255; i
++)
4442 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4443 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4444 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4451 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4452 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4453 OTF-FEATURES specifies which features to apply in this format:
4454 (SCRIPT LANGSYS GSUB GPOS)
4456 SCRIPT is a symbol specifying a script tag of OpenType,
4457 LANGSYS is a symbol specifying a langsys tag of OpenType,
4458 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4460 If LANGSYS is nil, the default langsys is selected.
4462 The features are applied in the order they appear in the list. The
4463 symbol `*' means to apply all available features not present in this
4464 list, and the remaining features are ignored. For instance, (vatu
4465 pstf * haln) is to apply vatu and pstf in this order, then to apply
4466 all available features other than vatu, pstf, and haln.
4468 The features are applied to the glyphs in the range FROM and TO of
4469 the glyph-string GSTRING-IN.
4471 If some feature is actually applicable, the resulting glyphs are
4472 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4473 this case, the value is the number of produced glyphs.
4475 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4478 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4479 produced in GSTRING-OUT, and the value is nil.
4481 See the documentation of `composition-get-gstring' for the format of
4483 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4485 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4490 check_otf_features (otf_features
);
4491 CHECK_FONT_OBJECT (font_object
);
4492 font
= XFONT_OBJECT (font_object
);
4493 if (! font
->driver
->otf_drive
)
4494 error ("Font backend %s can't drive OpenType GSUB table",
4495 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4496 CHECK_CONS (otf_features
);
4497 CHECK_SYMBOL (XCAR (otf_features
));
4498 val
= XCDR (otf_features
);
4499 CHECK_SYMBOL (XCAR (val
));
4500 val
= XCDR (otf_features
);
4503 len
= check_gstring (gstring_in
);
4504 CHECK_VECTOR (gstring_out
);
4505 CHECK_NATNUM (from
);
4507 CHECK_NATNUM (index
);
4509 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4510 args_out_of_range_3 (from
, to
, make_number (len
));
4511 if (XINT (index
) >= ASIZE (gstring_out
))
4512 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4513 num
= font
->driver
->otf_drive (font
, otf_features
,
4514 gstring_in
, XINT (from
), XINT (to
),
4515 gstring_out
, XINT (index
), 0);
4518 return make_number (num
);
4521 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4523 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4524 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4526 (SCRIPT LANGSYS FEATURE ...)
4527 See the documentation of `font-drive-otf' for more detail.
4529 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4530 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4531 character code corresponding to the glyph or nil if there's no
4532 corresponding character. */)
4533 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4536 Lisp_Object gstring_in
, gstring_out
, g
;
4537 Lisp_Object alternates
;
4540 CHECK_FONT_GET_OBJECT (font_object
, font
);
4541 if (! font
->driver
->otf_drive
)
4542 error ("Font backend %s can't drive OpenType GSUB table",
4543 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4544 CHECK_CHARACTER (character
);
4545 CHECK_CONS (otf_features
);
4547 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4548 g
= LGSTRING_GLYPH (gstring_in
, 0);
4549 LGLYPH_SET_CHAR (g
, XINT (character
));
4550 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4551 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4552 gstring_out
, 0, 1)) < 0)
4553 gstring_out
= Ffont_make_gstring (font_object
,
4554 make_number (ASIZE (gstring_out
) * 2));
4556 for (i
= 0; i
< num
; i
++)
4558 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4559 int c
= LGLYPH_CHAR (g
);
4560 unsigned code
= LGLYPH_CODE (g
);
4562 alternates
= Fcons (Fcons (make_number (code
),
4563 c
> 0 ? make_number (c
) : Qnil
),
4566 return Fnreverse (alternates
);
4572 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4573 doc
: /* Open FONT-ENTITY. */)
4574 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4577 struct frame
*f
= decode_live_frame (frame
);
4579 CHECK_FONT_ENTITY (font_entity
);
4582 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4585 CHECK_NUMBER_OR_FLOAT (size
);
4587 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4589 isize
= XINT (size
);
4590 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4591 args_out_of_range (font_entity
, size
);
4595 return font_open_entity (f
, font_entity
, isize
);
4598 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4599 doc
: /* Close FONT-OBJECT. */)
4600 (Lisp_Object font_object
, Lisp_Object frame
)
4602 CHECK_FONT_OBJECT (font_object
);
4603 font_close_object (decode_live_frame (frame
), font_object
);
4607 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4608 doc
: /* Return information about FONT-OBJECT.
4609 The value is a vector:
4610 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4613 NAME is the font name, a string (or nil if the font backend doesn't
4616 FILENAME is the font file name, a string (or nil if the font backend
4617 doesn't provide a file name).
4619 PIXEL-SIZE is a pixel size by which the font is opened.
4621 SIZE is a maximum advance width of the font in pixels.
4623 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4626 CAPABILITY is a list whose first element is a symbol representing the
4627 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4628 remaining elements describe the details of the font capability.
4630 If the font is OpenType font, the form of the list is
4631 \(opentype GSUB GPOS)
4632 where GSUB shows which "GSUB" features the font supports, and GPOS
4633 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4634 lists of the format:
4635 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4637 If the font is not OpenType font, currently the length of the form is
4640 SCRIPT is a symbol representing OpenType script tag.
4642 LANGSYS is a symbol representing OpenType langsys tag, or nil
4643 representing the default langsys.
4645 FEATURE is a symbol representing OpenType feature tag.
4647 If the font is not OpenType font, CAPABILITY is nil. */)
4648 (Lisp_Object font_object
)
4653 CHECK_FONT_GET_OBJECT (font_object
, font
);
4655 val
= make_uninit_vector (9);
4656 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4657 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4658 ASET (val
, 2, make_number (font
->pixel_size
));
4659 ASET (val
, 3, make_number (font
->max_width
));
4660 ASET (val
, 4, make_number (font
->ascent
));
4661 ASET (val
, 5, make_number (font
->descent
));
4662 ASET (val
, 6, make_number (font
->space_width
));
4663 ASET (val
, 7, make_number (font
->average_width
));
4664 if (font
->driver
->otf_capability
)
4665 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4667 ASET (val
, 8, Qnil
);
4671 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4673 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4674 FROM and TO are positions (integers or markers) specifying a region
4675 of the current buffer, and can be in either order. If the optional
4676 fourth arg OBJECT is not nil, it is a string or a vector containing
4677 the target characters between indices FROM and TO, which are treated
4680 Each element is a vector containing information of a glyph in this format:
4681 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4683 FROM is an index numbers of a character the glyph corresponds to.
4684 TO is the same as FROM.
4685 C is the character of the glyph.
4686 CODE is the glyph-code of C in FONT-OBJECT.
4687 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4688 ADJUSTMENT is always nil.
4689 If FONT-OBJECT doesn't have a glyph for a character,
4690 the corresponding element is nil. */)
4691 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4696 Lisp_Object
*chars
, vec
;
4699 CHECK_FONT_GET_OBJECT (font_object
, font
);
4702 ptrdiff_t charpos
, bytepos
;
4704 validate_region (&from
, &to
);
4707 len
= XFASTINT (to
) - XFASTINT (from
);
4708 SAFE_ALLOCA_LISP (chars
, len
);
4709 charpos
= XFASTINT (from
);
4710 bytepos
= CHAR_TO_BYTE (charpos
);
4711 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4714 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4715 chars
[i
] = make_number (c
);
4718 else if (STRINGP (object
))
4720 const unsigned char *p
;
4721 ptrdiff_t ifrom
, ito
;
4723 validate_subarray (object
, from
, to
, SCHARS (object
), &ifrom
, &ito
);
4727 SAFE_ALLOCA_LISP (chars
, len
);
4729 if (STRING_MULTIBYTE (object
))
4733 /* Skip IFROM characters from the beginning. */
4734 for (i
= 0; i
< ifrom
; i
++)
4735 c
= STRING_CHAR_ADVANCE (p
);
4737 /* Now fetch an interesting characters. */
4738 for (i
= 0; i
< len
; i
++)
4740 c
= STRING_CHAR_ADVANCE (p
);
4741 chars
[i
] = make_number (c
);
4745 for (i
= 0; i
< len
; i
++)
4746 chars
[i
] = make_number (p
[ifrom
+ i
]);
4748 else if (VECTORP (object
))
4750 ptrdiff_t ifrom
, ito
;
4752 validate_subarray (object
, from
, to
, ASIZE (object
), &ifrom
, &ito
);
4756 for (i
= 0; i
< len
; i
++)
4758 Lisp_Object elt
= AREF (object
, ifrom
+ i
);
4759 CHECK_CHARACTER (elt
);
4761 chars
= aref_addr (object
, ifrom
);
4764 wrong_type_argument (Qarrayp
, object
);
4766 vec
= make_uninit_vector (len
);
4767 for (i
= 0; i
< len
; i
++)
4770 int c
= XFASTINT (chars
[i
]);
4772 struct font_metrics metrics
;
4774 code
= font
->driver
->encode_char (font
, c
);
4775 if (code
== FONT_INVALID_CODE
)
4777 ASET (vec
, i
, Qnil
);
4781 LGLYPH_SET_FROM (g
, i
);
4782 LGLYPH_SET_TO (g
, i
);
4783 LGLYPH_SET_CHAR (g
, c
);
4784 LGLYPH_SET_CODE (g
, code
);
4785 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4786 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4787 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4788 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4789 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4790 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4793 if (! VECTORP (object
))
4798 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4799 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4800 FONT is a font-spec, font-entity, or font-object. */)
4801 (Lisp_Object spec
, Lisp_Object font
)
4803 CHECK_FONT_SPEC (spec
);
4806 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4809 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4810 doc
: /* Return a font-object for displaying a character at POSITION.
4811 Optional second arg WINDOW, if non-nil, is a window displaying
4812 the current buffer. It defaults to the currently selected window.
4813 Optional third arg STRING, if non-nil, is a string containing the target
4814 character at index specified by POSITION. */)
4815 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4817 struct window
*w
= decode_live_window (window
);
4821 if (XBUFFER (w
->contents
) != current_buffer
)
4822 error ("Specified window is not displaying the current buffer");
4823 CHECK_NUMBER_COERCE_MARKER (position
);
4824 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4825 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4829 CHECK_NUMBER (position
);
4830 CHECK_STRING (string
);
4831 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4832 args_out_of_range (string
, position
);
4835 return font_at (-1, XINT (position
), NULL
, w
, string
);
4839 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4840 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4841 The value is a number of glyphs drawn.
4842 Type C-l to recover what previously shown. */)
4843 (Lisp_Object font_object
, Lisp_Object string
)
4845 Lisp_Object frame
= selected_frame
;
4846 struct frame
*f
= XFRAME (frame
);
4852 CHECK_FONT_GET_OBJECT (font_object
, font
);
4853 CHECK_STRING (string
);
4854 len
= SCHARS (string
);
4855 code
= alloca (sizeof (unsigned) * len
);
4856 for (i
= 0; i
< len
; i
++)
4858 Lisp_Object ch
= Faref (string
, make_number (i
));
4862 code
[i
] = font
->driver
->encode_char (font
, c
);
4863 if (code
[i
] == FONT_INVALID_CODE
)
4866 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4868 if (font
->driver
->prepare_face
)
4869 font
->driver
->prepare_face (f
, face
);
4870 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4871 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4872 if (font
->driver
->done_face
)
4873 font
->driver
->done_face (f
, face
);
4875 return make_number (len
);
4879 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4880 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4881 If FRAME is omitted or nil, use the selected frame. */)
4884 #ifdef HAVE_WINDOW_SYSTEM
4885 struct frame
*f
= decode_live_frame (frame
);
4887 if (FRAME_WINDOW_P (f
))
4888 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4894 #endif /* FONT_DEBUG */
4896 #ifdef HAVE_WINDOW_SYSTEM
4898 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4899 doc
: /* Return information about a font named NAME on frame FRAME.
4900 If FRAME is omitted or nil, use the selected frame.
4902 The returned value is a vector:
4903 [ OPENED-NAME FULL-NAME SIZE HEIGHT BASELINE-OFFSET RELATIVE-COMPOSE
4904 DEFAULT-ASCENT MAX-WIDTH ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4907 OPENED-NAME is the name used for opening the font,
4908 FULL-NAME is the full name of the font,
4909 SIZE is the pixelsize of the font,
4910 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4911 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4912 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4913 how to compose characters,
4914 MAX-WIDTH is the maximum advance width of the font,
4915 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font
4917 FILENAME is the font file name, a string (or nil if the font backend
4918 doesn't provide a file name).
4919 CAPABILITY is a list whose first element is a symbol representing the
4920 font format, one of x, opentype, truetype, type1, pcf, or bdf.
4921 The remaining elements describe the details of the font capabilities,
4924 If the font is OpenType font, the form of the list is
4925 \(opentype GSUB GPOS)
4926 where GSUB shows which "GSUB" features the font supports, and GPOS
4927 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4929 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4932 SCRIPT is a symbol representing OpenType script tag.
4933 LANGSYS is a symbol representing OpenType langsys tag, or nil
4934 representing the default langsys.
4935 FEATURE is a symbol representing OpenType feature tag.
4937 If the font is not an OpenType font, there are no elements
4938 in CAPABILITY except the font format symbol.
4940 If the named font is not yet loaded, return nil. */)
4941 (Lisp_Object name
, Lisp_Object frame
)
4946 Lisp_Object font_object
;
4949 CHECK_STRING (name
);
4950 f
= decode_window_system_frame (frame
);
4954 int fontset
= fs_query_fontset (name
, 0);
4957 name
= fontset_ascii (fontset
);
4958 font_object
= font_open_by_name (f
, name
);
4960 else if (FONT_OBJECT_P (name
))
4962 else if (FONT_ENTITY_P (name
))
4963 font_object
= font_open_entity (f
, name
, 0);
4966 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4967 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4969 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4971 if (NILP (font_object
))
4973 font
= XFONT_OBJECT (font_object
);
4975 info
= make_uninit_vector (14);
4976 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4977 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4978 ASET (info
, 2, make_number (font
->pixel_size
));
4979 ASET (info
, 3, make_number (font
->height
));
4980 ASET (info
, 4, make_number (font
->baseline_offset
));
4981 ASET (info
, 5, make_number (font
->relative_compose
));
4982 ASET (info
, 6, make_number (font
->default_ascent
));
4983 ASET (info
, 7, make_number (font
->max_width
));
4984 ASET (info
, 8, make_number (font
->ascent
));
4985 ASET (info
, 9, make_number (font
->descent
));
4986 ASET (info
, 10, make_number (font
->space_width
));
4987 ASET (info
, 11, make_number (font
->average_width
));
4988 ASET (info
, 12, AREF (font_object
, FONT_FILE_INDEX
));
4989 if (font
->driver
->otf_capability
)
4990 ASET (info
, 13, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4992 ASET (info
, 13, Qnil
);
4995 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4996 close it now. Perhaps, we should manage font-objects
4997 by `reference-count'. */
4998 font_close_object (f
, font_object
);
5005 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
5008 build_style_table (const struct table_entry
*entry
, int nelement
)
5011 Lisp_Object table
, elt
;
5013 table
= make_uninit_vector (nelement
);
5014 for (i
= 0; i
< nelement
; i
++)
5016 for (j
= 0; entry
[i
].names
[j
]; j
++);
5017 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5018 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5019 for (j
= 0; entry
[i
].names
[j
]; j
++)
5020 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5021 ASET (table
, i
, elt
);
5026 /* The deferred font-log data of the form [ACTION ARG RESULT].
5027 If ACTION is not nil, that is added to the log when font_add_log is
5028 called next time. At that time, ACTION is set back to nil. */
5029 static Lisp_Object Vfont_log_deferred
;
5031 /* Prepend the font-related logging data in Vfont_log if it is not
5032 `t'. ACTION describes a kind of font-related action (e.g. listing,
5033 opening), ARG is the argument for the action, and RESULT is the
5034 result of the action. */
5036 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5041 if (EQ (Vfont_log
, Qt
))
5043 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5045 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
5047 ASET (Vfont_log_deferred
, 0, Qnil
);
5048 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5049 AREF (Vfont_log_deferred
, 2));
5054 Lisp_Object tail
, elt
;
5055 AUTO_STRING (equal
, "=");
5057 val
= Ffont_xlfd_name (arg
, Qt
);
5058 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5062 if (EQ (XCAR (elt
), QCscript
)
5063 && SYMBOLP (XCDR (elt
)))
5064 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5065 concat2 (equal
, SYMBOL_NAME (XCDR (elt
))));
5066 else if (EQ (XCAR (elt
), QClang
)
5067 && SYMBOLP (XCDR (elt
)))
5068 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5069 concat2 (equal
, SYMBOL_NAME (XCDR (elt
))));
5070 else if (EQ (XCAR (elt
), QCotf
)
5071 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5072 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5073 concat2 (equal
, SYMBOL_NAME (XCAR (XCDR (elt
)))));
5079 && VECTORP (XCAR (result
))
5080 && ASIZE (XCAR (result
)) > 0
5081 && FONTP (AREF (XCAR (result
), 0)))
5082 result
= font_vconcat_entity_vectors (result
);
5085 val
= Ffont_xlfd_name (result
, Qt
);
5086 if (! FONT_SPEC_P (result
))
5088 AUTO_STRING (colon
, ":");
5089 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5094 else if (CONSP (result
))
5097 result
= Fcopy_sequence (result
);
5098 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5102 val
= Ffont_xlfd_name (val
, Qt
);
5103 XSETCAR (tail
, val
);
5106 else if (VECTORP (result
))
5108 result
= Fcopy_sequence (result
);
5109 for (i
= 0; i
< ASIZE (result
); i
++)
5111 val
= AREF (result
, i
);
5113 val
= Ffont_xlfd_name (val
, Qt
);
5114 ASET (result
, i
, val
);
5117 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5120 /* Record a font-related logging data to be added to Vfont_log when
5121 font_add_log is called next time. ACTION, ARG, RESULT are the same
5125 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5127 if (EQ (Vfont_log
, Qt
))
5129 ASET (Vfont_log_deferred
, 0, build_string (action
));
5130 ASET (Vfont_log_deferred
, 1, arg
);
5131 ASET (Vfont_log_deferred
, 2, result
);
5137 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5138 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5139 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5140 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5141 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5142 /* Note that the other elements in sort_shift_bits are not used. */
5144 staticpro (&font_charset_alist
);
5145 font_charset_alist
= Qnil
;
5147 DEFSYM (Qopentype
, "opentype");
5149 /* Important character set symbols. */
5150 DEFSYM (Qascii_0
, "ascii-0");
5151 DEFSYM (Qiso8859_1
, "iso8859-1");
5152 DEFSYM (Qiso10646_1
, "iso10646-1");
5153 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5154 DEFSYM (Qunicode_sip
, "unicode-sip");
5156 /* Unicode category `Cf'. */
5159 /* Symbols representing keys of font extra info. */
5160 DEFSYM (QCotf
, ":otf");
5161 DEFSYM (QClang
, ":lang");
5162 DEFSYM (QCscript
, ":script");
5163 DEFSYM (QCantialias
, ":antialias");
5164 DEFSYM (QCfoundry
, ":foundry");
5165 DEFSYM (QCadstyle
, ":adstyle");
5166 DEFSYM (QCregistry
, ":registry");
5167 DEFSYM (QCspacing
, ":spacing");
5168 DEFSYM (QCdpi
, ":dpi");
5169 DEFSYM (QCscalable
, ":scalable");
5170 DEFSYM (QCavgwidth
, ":avgwidth");
5171 DEFSYM (QCfont_entity
, ":font-entity");
5172 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5174 /* Symbols representing values of font spacing property. */
5180 /* Special ADSTYLE properties to avoid fonts used for Latin
5181 characters; used in xfont.c and ftfont.c. */
5185 DEFSYM (QCuser_spec
, "user-spec");
5187 staticpro (&scratch_font_spec
);
5188 scratch_font_spec
= Ffont_spec (0, NULL
);
5189 staticpro (&scratch_font_prefer
);
5190 scratch_font_prefer
= Ffont_spec (0, NULL
);
5192 staticpro (&Vfont_log_deferred
);
5193 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5197 staticpro (&otf_list
);
5199 #endif /* HAVE_LIBOTF */
5203 defsubr (&Sfont_spec
);
5204 defsubr (&Sfont_get
);
5205 #ifdef HAVE_WINDOW_SYSTEM
5206 defsubr (&Sfont_face_attributes
);
5208 defsubr (&Sfont_put
);
5209 defsubr (&Slist_fonts
);
5210 defsubr (&Sfont_family_list
);
5211 defsubr (&Sfind_font
);
5212 defsubr (&Sfont_xlfd_name
);
5213 defsubr (&Sclear_font_cache
);
5214 defsubr (&Sfont_shape_gstring
);
5215 defsubr (&Sfont_variation_glyphs
);
5217 defsubr (&Sfont_drive_otf
);
5218 defsubr (&Sfont_otf_alternates
);
5222 defsubr (&Sopen_font
);
5223 defsubr (&Sclose_font
);
5224 defsubr (&Squery_font
);
5225 defsubr (&Sfont_get_glyphs
);
5226 defsubr (&Sfont_match_p
);
5227 defsubr (&Sfont_at
);
5229 defsubr (&Sdraw_string
);
5231 defsubr (&Sframe_font_cache
);
5232 #endif /* FONT_DEBUG */
5233 #ifdef HAVE_WINDOW_SYSTEM
5234 defsubr (&Sfont_info
);
5237 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5239 Alist of fontname patterns vs the corresponding encoding and repertory info.
5240 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5241 where ENCODING is a charset or a char-table,
5242 and REPERTORY is a charset, a char-table, or nil.
5244 If ENCODING and REPERTORY are the same, the element can have the form
5245 \(REGEXP . ENCODING).
5247 ENCODING is for converting a character to a glyph code of the font.
5248 If ENCODING is a charset, encoding a character by the charset gives
5249 the corresponding glyph code. If ENCODING is a char-table, looking up
5250 the table by a character gives the corresponding glyph code.
5252 REPERTORY specifies a repertory of characters supported by the font.
5253 If REPERTORY is a charset, all characters belonging to the charset are
5254 supported. If REPERTORY is a char-table, all characters who have a
5255 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5256 gets the repertory information by an opened font and ENCODING. */);
5257 Vfont_encoding_alist
= Qnil
;
5259 /* FIXME: These 3 vars are not quite what they appear: setq on them
5260 won't have any effect other than disconnect them from the style
5261 table used by the font display code. So we make them read-only,
5262 to avoid this confusing situation. */
5264 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5265 doc
: /* Vector of valid font weight values.
5266 Each element has the form:
5267 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5268 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5269 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5270 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5272 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5273 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5274 See `font-weight-table' for the format of the vector. */);
5275 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5276 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5278 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5279 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5280 See `font-weight-table' for the format of the vector. */);
5281 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5282 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5284 staticpro (&font_style_table
);
5285 font_style_table
= make_uninit_vector (3);
5286 ASET (font_style_table
, 0, Vfont_weight_table
);
5287 ASET (font_style_table
, 1, Vfont_slant_table
);
5288 ASET (font_style_table
, 2, Vfont_width_table
);
5290 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5291 *Logging list of font related actions and results.
5292 The value t means to suppress the logging.
5293 The initial value is set to nil if the environment variable
5294 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5297 #ifdef HAVE_WINDOW_SYSTEM
5298 #ifdef HAVE_FREETYPE
5300 #ifdef HAVE_X_WINDOWS
5305 #endif /* HAVE_XFT */
5306 #endif /* HAVE_X_WINDOWS */
5307 #else /* not HAVE_FREETYPE */
5308 #ifdef HAVE_X_WINDOWS
5310 #endif /* HAVE_X_WINDOWS */
5311 #endif /* not HAVE_FREETYPE */
5314 #endif /* HAVE_BDFFONT */
5317 #endif /* HAVE_NTGUI */
5318 #endif /* HAVE_WINDOW_SYSTEM */
5324 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;