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
, 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
, 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
,
185 FONT_OBJECT_MAX
, PVEC_FONT
);
188 /* GC can happen before the driver is set up,
189 so avoid dangling pointer here (Bug#17771). */
191 XSETFONT (font_object
, font
);
195 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
196 font
->props
[i
] = AREF (entity
, i
);
197 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
198 font
->props
[FONT_EXTRA_INDEX
]
199 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
202 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
206 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
208 static int font_unparse_fcname (Lisp_Object
, int, char *, int);
210 /* Like above, but also set `type', `name' and `fullname' properties
214 font_build_object (int vectorsize
, Lisp_Object type
,
215 Lisp_Object entity
, double pixelsize
)
219 Lisp_Object font_object
= font_make_object (vectorsize
, entity
, pixelsize
);
221 ASET (font_object
, FONT_TYPE_INDEX
, type
);
222 len
= font_unparse_xlfd (entity
, pixelsize
, name
, sizeof name
);
224 ASET (font_object
, FONT_NAME_INDEX
, make_string (name
, len
));
225 len
= font_unparse_fcname (entity
, pixelsize
, name
, sizeof name
);
227 ASET (font_object
, FONT_FULLNAME_INDEX
, make_string (name
, len
));
229 ASET (font_object
, FONT_FULLNAME_INDEX
,
230 AREF (font_object
, FONT_NAME_INDEX
));
234 #endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */
236 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
237 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
238 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
240 static unsigned font_encode_char (Lisp_Object
, int);
242 /* Number of registered font drivers. */
243 static int num_font_drivers
;
246 /* Return a Lispy value of a font property value at STR and LEN bytes.
247 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
248 consist entirely of one or more digits, return a symbol interned
249 from STR. Otherwise, return an integer. */
252 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
254 ptrdiff_t i
, nbytes
, nchars
;
255 Lisp_Object tem
, name
, obarray
;
257 if (len
== 1 && *str
== '*')
259 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
261 for (i
= 1; i
< len
; i
++)
262 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
269 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
272 return make_number (n
);
273 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
277 xsignal1 (Qoverflow_error
, make_string (str
, len
));
281 /* This code is similar to intern function from lread.c. */
282 obarray
= check_obarray (Vobarray
);
283 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
284 tem
= oblookup (obarray
, str
,
285 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
288 name
= make_specified_string (str
, nchars
, len
,
289 len
!= nchars
&& len
== nbytes
);
290 return intern_driver (name
, obarray
, tem
);
293 /* Return a pixel size of font-spec SPEC on frame F. */
296 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
298 #ifdef HAVE_WINDOW_SYSTEM
299 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
308 eassert (FLOATP (size
));
309 point_size
= XFLOAT_DATA (size
);
310 val
= AREF (spec
, FONT_DPI_INDEX
);
314 dpi
= FRAME_RES_Y (f
);
315 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
323 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
324 font vector. If VAL is not valid (i.e. not registered in
325 font_style_table), return -1 if NOERROR is zero, and return a
326 proper index if NOERROR is nonzero. In that case, register VAL in
327 font_style_table if VAL is a symbol, and return the closest index if
328 VAL is an integer. */
331 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
334 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
337 CHECK_VECTOR (table
);
346 /* At first try exact match. */
347 for (i
= 0; i
< len
; i
++)
349 CHECK_VECTOR (AREF (table
, i
));
350 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
351 if (EQ (val
, AREF (AREF (table
, i
), j
)))
353 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
354 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
355 | (i
<< 4) | (j
- 1));
358 /* Try also with case-folding match. */
359 s
= SSDATA (SYMBOL_NAME (val
));
360 for (i
= 0; i
< len
; i
++)
361 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
363 elt
= AREF (AREF (table
, i
), j
);
364 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
366 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
367 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
368 | (i
<< 4) | (j
- 1));
374 elt
= Fmake_vector (make_number (2), make_number (100));
376 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
,
377 CALLN (Fvconcat
, 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 /* Index of the key symbol. */
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 { { SYMBOL_INDEX (QCtype
), font_prop_validate_symbol
},
650 { SYMBOL_INDEX (QCfoundry
), font_prop_validate_symbol
},
651 { SYMBOL_INDEX (QCfamily
), font_prop_validate_symbol
},
652 { SYMBOL_INDEX (QCadstyle
), font_prop_validate_symbol
},
653 { SYMBOL_INDEX (QCregistry
), font_prop_validate_symbol
},
654 { SYMBOL_INDEX (QCweight
), font_prop_validate_style
},
655 { SYMBOL_INDEX (QCslant
), font_prop_validate_style
},
656 { SYMBOL_INDEX (QCwidth
), font_prop_validate_style
},
657 { SYMBOL_INDEX (QCsize
), font_prop_validate_non_neg
},
658 { SYMBOL_INDEX (QCdpi
), font_prop_validate_non_neg
},
659 { SYMBOL_INDEX (QCspacing
), font_prop_validate_spacing
},
660 { SYMBOL_INDEX (QCavgwidth
), font_prop_validate_non_neg
},
661 /* The order of the above entries must match with enum
662 font_property_index. */
663 { SYMBOL_INDEX (QClang
), font_prop_validate_symbol
},
664 { SYMBOL_INDEX (QCscript
), font_prop_validate_symbol
},
665 { SYMBOL_INDEX (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
, builtin_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
= builtin_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 memclear (field
+ j
, (range
[i
].from
- j
) * word_size
);
996 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
998 memclear (field
+ j
, (XLFD_LAST_INDEX
- j
) * word_size
);
999 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1000 field
[XLFD_ENCODING_INDEX
]
1001 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1006 /* Parse NAME (null terminated) as XLFD and store information in FONT
1007 (font-spec or font-entity). Size property of FONT is set as
1009 specified XLFD fields FONT property
1010 --------------------- -------------
1011 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1012 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1013 POINT_SIZE POINT_SIZE/10 (Lisp float)
1015 If NAME is successfully parsed, return 0. Otherwise return -1.
1017 FONT is usually a font-spec, but when this function is called from
1018 X font backend driver, it is a font-entity. In that case, NAME is
1019 a fully specified XLFD. */
1022 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1025 char *f
[XLFD_LAST_INDEX
+ 1];
1029 if (len
> 255 || !len
)
1030 /* Maximum XLFD name length is 255. */
1032 /* Accept "*-.." as a fully specified XLFD. */
1033 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1034 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1037 for (p
= name
+ i
; *p
; p
++)
1041 if (i
== XLFD_LAST_INDEX
)
1046 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1047 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1049 if (i
== XLFD_LAST_INDEX
)
1051 /* Fully specified XLFD. */
1054 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1055 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1056 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1057 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1059 val
= INTERN_FIELD_SYM (i
);
1062 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1064 ASET (font
, j
, make_number (n
));
1067 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1068 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1069 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1071 ASET (font
, FONT_REGISTRY_INDEX
,
1072 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1073 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1075 p
= f
[XLFD_PIXEL_INDEX
];
1076 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1077 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1080 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1082 ASET (font
, FONT_SIZE_INDEX
, val
);
1083 else if (FONT_ENTITY_P (font
))
1087 double point_size
= -1;
1089 eassert (FONT_SPEC_P (font
));
1090 p
= f
[XLFD_POINT_INDEX
];
1092 point_size
= parse_matrix (p
);
1093 else if (c_isdigit (*p
))
1094 point_size
= atoi (p
), point_size
/= 10;
1095 if (point_size
>= 0)
1096 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1100 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1101 if (! NILP (val
) && ! INTEGERP (val
))
1103 ASET (font
, FONT_DPI_INDEX
, val
);
1104 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1107 val
= font_prop_validate_spacing (QCspacing
, val
);
1108 if (! INTEGERP (val
))
1110 ASET (font
, FONT_SPACING_INDEX
, val
);
1112 p
= f
[XLFD_AVGWIDTH_INDEX
];
1115 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1116 if (! NILP (val
) && ! INTEGERP (val
))
1118 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1122 bool wild_card_found
= 0;
1123 Lisp_Object prop
[XLFD_LAST_INDEX
];
1125 if (FONT_ENTITY_P (font
))
1127 for (j
= 0; j
< i
; j
++)
1131 if (f
[j
][1] && f
[j
][1] != '-')
1134 wild_card_found
= 1;
1137 prop
[j
] = INTERN_FIELD (j
);
1139 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1141 if (! wild_card_found
)
1143 if (font_expand_wildcards (prop
, i
) < 0)
1146 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1147 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1148 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1149 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1150 if (! NILP (prop
[i
]))
1152 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1154 ASET (font
, j
, make_number (n
));
1156 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1157 val
= prop
[XLFD_REGISTRY_INDEX
];
1160 val
= prop
[XLFD_ENCODING_INDEX
];
1163 AUTO_STRING (star_dash
, "*-");
1164 val
= concat2 (star_dash
, SYMBOL_NAME (val
));
1167 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1169 AUTO_STRING (dash_star
, "-*");
1170 val
= concat2 (SYMBOL_NAME (val
), dash_star
);
1174 AUTO_STRING (dash
, "-");
1175 val
= concat3 (SYMBOL_NAME (val
), dash
,
1176 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1179 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1181 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1182 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1183 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1185 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1187 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1190 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1191 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1192 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1194 val
= font_prop_validate_spacing (QCspacing
,
1195 prop
[XLFD_SPACING_INDEX
]);
1196 if (! INTEGERP (val
))
1198 ASET (font
, FONT_SPACING_INDEX
, val
);
1200 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1201 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1207 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1208 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1209 0, use PIXEL_SIZE instead. */
1212 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1215 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1219 eassert (FONTP (font
));
1221 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1224 if (i
== FONT_ADSTYLE_INDEX
)
1225 j
= XLFD_ADSTYLE_INDEX
;
1226 else if (i
== FONT_REGISTRY_INDEX
)
1227 j
= XLFD_REGISTRY_INDEX
;
1228 val
= AREF (font
, i
);
1231 if (j
== XLFD_REGISTRY_INDEX
)
1239 val
= SYMBOL_NAME (val
);
1240 if (j
== XLFD_REGISTRY_INDEX
1241 && ! strchr (SSDATA (val
), '-'))
1243 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1244 ptrdiff_t alloc
= SBYTES (val
) + 4;
1245 if (nbytes
<= alloc
)
1247 f
[j
] = p
= alloca (alloc
);
1248 sprintf (p
, "%s%s-*", SDATA (val
),
1249 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1252 f
[j
] = SSDATA (val
);
1256 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1259 val
= font_style_symbolic (font
, i
, 0);
1267 val
= SYMBOL_NAME (val
);
1268 alloc
= SBYTES (val
) + 1;
1269 if (nbytes
<= alloc
)
1271 f
[j
] = p
= alloca (alloc
);
1272 /* Copy the name while excluding '-', '?', ',', and '"'. */
1273 for (k
= l
= 0; k
< alloc
; k
++)
1276 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1282 val
= AREF (font
, FONT_SIZE_INDEX
);
1283 eassert (NUMBERP (val
) || NILP (val
));
1284 char font_size_index_buf
[sizeof "-*"
1285 + max (INT_STRLEN_BOUND (EMACS_INT
),
1286 1 + DBL_MAX_10_EXP
+ 1)];
1289 EMACS_INT v
= XINT (val
);
1294 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1295 sprintf (p
, "%"pI
"d-*", v
);
1298 f
[XLFD_PIXEL_INDEX
] = "*-*";
1300 else if (FLOATP (val
))
1302 double v
= XFLOAT_DATA (val
) * 10;
1303 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1304 sprintf (p
, "*-%.0f", v
);
1307 f
[XLFD_PIXEL_INDEX
] = "*-*";
1309 char dpi_index_buf
[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
)];
1310 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1312 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1313 f
[XLFD_RESX_INDEX
] = p
= dpi_index_buf
;
1314 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1317 f
[XLFD_RESX_INDEX
] = "*-*";
1319 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1321 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1323 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1324 : spacing
<= FONT_SPACING_DUAL
? "d"
1325 : spacing
<= FONT_SPACING_MONO
? "m"
1329 f
[XLFD_SPACING_INDEX
] = "*";
1331 char avgwidth_index_buf
[INT_BUFSIZE_BOUND (EMACS_INT
)];
1332 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1334 f
[XLFD_AVGWIDTH_INDEX
] = p
= avgwidth_index_buf
;
1335 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1338 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1340 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1341 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1342 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1343 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1344 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1345 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1346 f
[XLFD_REGISTRY_INDEX
]);
1347 return len
< nbytes
? len
: -1;
1350 /* Parse NAME (null terminated) and store information in FONT
1351 (font-spec or font-entity). NAME is supplied in either the
1352 Fontconfig or GTK font name format. If NAME is successfully
1353 parsed, return 0. Otherwise return -1.
1355 The fontconfig format is
1357 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1361 FAMILY [PROPS...] [SIZE]
1363 This function tries to guess which format it is. */
1366 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1369 char *size_beg
= NULL
, *size_end
= NULL
;
1370 char *props_beg
= NULL
, *family_end
= NULL
;
1375 for (p
= name
; *p
; p
++)
1377 if (*p
== '\\' && p
[1])
1381 props_beg
= family_end
= p
;
1386 bool decimal
= 0, size_found
= 1;
1387 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1388 if (! c_isdigit (*q
))
1390 if (*q
!= '.' || decimal
)
1409 Lisp_Object extra_props
= Qnil
;
1411 /* A fontconfig name with size and/or property data. */
1412 if (family_end
> name
)
1415 family
= font_intern_prop (name
, family_end
- name
, 1);
1416 ASET (font
, FONT_FAMILY_INDEX
, family
);
1420 double point_size
= strtod (size_beg
, &size_end
);
1421 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1422 if (*size_end
== ':' && size_end
[1])
1423 props_beg
= size_end
;
1427 /* Now parse ":KEY=VAL" patterns. */
1430 for (p
= props_beg
; *p
; p
= q
)
1432 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1435 /* Must be an enumerated value. */
1439 val
= font_intern_prop (p
, q
- p
, 1);
1441 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1442 && memcmp (p, STR, strlen (STR)) == 0)
1444 if (PROP_MATCH ("light")
1445 || PROP_MATCH ("medium")
1446 || PROP_MATCH ("demibold")
1447 || PROP_MATCH ("bold")
1448 || PROP_MATCH ("black"))
1449 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1450 else if (PROP_MATCH ("roman")
1451 || PROP_MATCH ("italic")
1452 || PROP_MATCH ("oblique"))
1453 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1454 else if (PROP_MATCH ("charcell"))
1455 ASET (font
, FONT_SPACING_INDEX
,
1456 make_number (FONT_SPACING_CHARCELL
));
1457 else if (PROP_MATCH ("mono"))
1458 ASET (font
, FONT_SPACING_INDEX
,
1459 make_number (FONT_SPACING_MONO
));
1460 else if (PROP_MATCH ("proportional"))
1461 ASET (font
, FONT_SPACING_INDEX
,
1462 make_number (FONT_SPACING_PROPORTIONAL
));
1471 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1472 prop
= FONT_SIZE_INDEX
;
1475 key
= font_intern_prop (p
, q
- p
, 1);
1476 prop
= get_font_prop_index (key
);
1480 for (q
= p
; *q
&& *q
!= ':'; q
++);
1481 val
= font_intern_prop (p
, q
- p
, 0);
1483 if (prop
>= FONT_FOUNDRY_INDEX
1484 && prop
< FONT_EXTRA_INDEX
)
1485 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1488 extra_props
= nconc2 (extra_props
,
1489 list1 (Fcons (key
, val
)));
1496 if (! NILP (extra_props
))
1498 struct font_driver_list
*driver_list
= font_driver_list
;
1499 for ( ; driver_list
; driver_list
= driver_list
->next
)
1500 if (driver_list
->driver
->filter_properties
)
1501 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1507 /* Either a fontconfig-style name with no size and property
1508 data, or a GTK-style name. */
1509 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1510 Lisp_Object width
= Qnil
, size
= Qnil
;
1514 /* Scan backwards from the end, looking for a size. */
1515 for (p
= name
+ len
- 1; p
>= name
; p
--)
1516 if (!c_isdigit (*p
))
1519 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1520 /* Found a font size. */
1521 size
= make_float (strtod (p
+ 1, NULL
));
1525 /* Now P points to the termination of the string, sans size.
1526 Scan backwards, looking for font properties. */
1527 for (; p
> name
; p
= q
)
1529 for (q
= p
- 1; q
>= name
; q
--)
1531 if (q
> name
&& *(q
-1) == '\\')
1532 --q
; /* Skip quoting backslashes. */
1538 word_len
= p
- word_start
;
1540 #define PROP_MATCH(STR) \
1541 (word_len == strlen (STR) \
1542 && memcmp (word_start, STR, strlen (STR)) == 0)
1543 #define PROP_SAVE(VAR, STR) \
1544 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1546 if (PROP_MATCH ("Ultra-Light"))
1547 PROP_SAVE (weight
, "ultra-light");
1548 else if (PROP_MATCH ("Light"))
1549 PROP_SAVE (weight
, "light");
1550 else if (PROP_MATCH ("Book"))
1551 PROP_SAVE (weight
, "book");
1552 else if (PROP_MATCH ("Medium"))
1553 PROP_SAVE (weight
, "medium");
1554 else if (PROP_MATCH ("Semi-Bold"))
1555 PROP_SAVE (weight
, "semi-bold");
1556 else if (PROP_MATCH ("Bold"))
1557 PROP_SAVE (weight
, "bold");
1558 else if (PROP_MATCH ("Italic"))
1559 PROP_SAVE (slant
, "italic");
1560 else if (PROP_MATCH ("Oblique"))
1561 PROP_SAVE (slant
, "oblique");
1562 else if (PROP_MATCH ("Semi-Condensed"))
1563 PROP_SAVE (width
, "semi-condensed");
1564 else if (PROP_MATCH ("Condensed"))
1565 PROP_SAVE (width
, "condensed");
1566 /* An unknown word must be part of the font name. */
1577 ASET (font
, FONT_FAMILY_INDEX
,
1578 font_intern_prop (name
, family_end
- name
, 1));
1580 ASET (font
, FONT_SIZE_INDEX
, size
);
1582 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1584 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1586 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1592 #if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
1594 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1595 NAME (NBYTES length), and return the name length. If
1596 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
1597 Return a negative value on error. */
1600 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1602 Lisp_Object family
, foundry
;
1608 Lisp_Object styles
[3];
1609 const char *style_names
[3] = { "weight", "slant", "width" };
1611 family
= AREF (font
, FONT_FAMILY_INDEX
);
1612 if (! NILP (family
))
1614 if (SYMBOLP (family
))
1615 family
= SYMBOL_NAME (family
);
1620 val
= AREF (font
, FONT_SIZE_INDEX
);
1623 if (XINT (val
) != 0)
1624 pixel_size
= XINT (val
);
1629 eassert (FLOATP (val
));
1631 point_size
= (int) XFLOAT_DATA (val
);
1634 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1635 if (! NILP (foundry
))
1637 if (SYMBOLP (foundry
))
1638 foundry
= SYMBOL_NAME (foundry
);
1643 for (i
= 0; i
< 3; i
++)
1644 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1647 lim
= name
+ nbytes
;
1648 if (! NILP (family
))
1650 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1651 if (! (0 <= len
&& len
< lim
- p
))
1657 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1658 if (! (0 <= len
&& len
< lim
- p
))
1662 else if (pixel_size
> 0)
1664 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1665 if (! (0 <= len
&& len
< lim
- p
))
1669 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1671 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1672 SSDATA (SYMBOL_NAME (AREF (font
,
1673 FONT_FOUNDRY_INDEX
))));
1674 if (! (0 <= len
&& len
< lim
- p
))
1678 for (i
= 0; i
< 3; i
++)
1679 if (! NILP (styles
[i
]))
1681 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1682 SSDATA (SYMBOL_NAME (styles
[i
])));
1683 if (! (0 <= len
&& len
< lim
- p
))
1688 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1690 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1691 XINT (AREF (font
, FONT_DPI_INDEX
)));
1692 if (! (0 <= len
&& len
< lim
- p
))
1697 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1699 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1700 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1701 if (! (0 <= len
&& len
< lim
- p
))
1706 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1708 int len
= snprintf (p
, lim
- p
,
1709 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1711 : ":scalable=false"));
1712 if (! (0 <= len
&& len
< lim
- p
))
1722 /* Parse NAME (null terminated) and store information in FONT
1723 (font-spec or font-entity). If NAME is successfully parsed, return
1724 0. Otherwise return -1. */
1727 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1729 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1730 return font_parse_xlfd (name
, namelen
, font
);
1731 return font_parse_fcname (name
, namelen
, font
);
1735 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1736 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1740 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1746 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1748 CHECK_STRING (family
);
1749 len
= SBYTES (family
);
1750 p0
= SSDATA (family
);
1751 p1
= strchr (p0
, '-');
1754 if ((*p0
!= '*' && p1
- p0
> 0)
1755 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1756 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1759 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1762 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1764 if (! NILP (registry
))
1766 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1767 CHECK_STRING (registry
);
1768 len
= SBYTES (registry
);
1769 p0
= SSDATA (registry
);
1770 p1
= strchr (p0
, '-');
1773 AUTO_STRING (extra
, ("*-*" + (len
&& p0
[len
- 1] == '*')));
1774 registry
= concat2 (registry
, extra
);
1776 registry
= Fdowncase (registry
);
1777 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1782 /* This part (through the next ^L) is still experimental and not
1783 tested much. We may drastically change codes. */
1789 #define LGSTRING_HEADER_SIZE 6
1790 #define LGSTRING_GLYPH_SIZE 8
1793 check_gstring (Lisp_Object gstring
)
1799 CHECK_VECTOR (gstring
);
1800 val
= AREF (gstring
, 0);
1802 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1804 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1805 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1806 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1807 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1808 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1809 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1810 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1811 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1812 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1813 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1814 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1816 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1818 val
= LGSTRING_GLYPH (gstring
, i
);
1820 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1822 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1824 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1825 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1826 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1827 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1828 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1829 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1830 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1831 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1833 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1835 if (ASIZE (val
) < 3)
1837 for (j
= 0; j
< 3; j
++)
1838 CHECK_NUMBER (AREF (val
, j
));
1843 error ("Invalid glyph-string format");
1848 check_otf_features (Lisp_Object otf_features
)
1852 CHECK_CONS (otf_features
);
1853 CHECK_SYMBOL (XCAR (otf_features
));
1854 otf_features
= XCDR (otf_features
);
1855 CHECK_CONS (otf_features
);
1856 CHECK_SYMBOL (XCAR (otf_features
));
1857 otf_features
= XCDR (otf_features
);
1858 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1860 CHECK_SYMBOL (XCAR (val
));
1861 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1862 error ("Invalid OTF GSUB feature: %s",
1863 SDATA (SYMBOL_NAME (XCAR (val
))));
1865 otf_features
= XCDR (otf_features
);
1866 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1868 CHECK_SYMBOL (XCAR (val
));
1869 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1870 error ("Invalid OTF GPOS feature: %s",
1871 SDATA (SYMBOL_NAME (XCAR (val
))));
1878 Lisp_Object otf_list
;
1881 otf_tag_symbol (OTF_Tag tag
)
1885 OTF_tag_name (tag
, name
);
1886 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1890 otf_open (Lisp_Object file
)
1892 Lisp_Object val
= Fassoc (file
, otf_list
);
1896 otf
= XSAVE_POINTER (XCDR (val
), 0);
1899 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1900 val
= make_save_ptr (otf
);
1901 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1907 /* Return a list describing which scripts/languages FONT supports by
1908 which GSUB/GPOS features of OpenType tables. See the comment of
1909 (struct font_driver).otf_capability. */
1912 font_otf_capability (struct font
*font
)
1915 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1918 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1921 for (i
= 0; i
< 2; i
++)
1923 OTF_GSUB_GPOS
*gsub_gpos
;
1924 Lisp_Object script_list
= Qnil
;
1927 if (OTF_get_features (otf
, i
== 0) < 0)
1929 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1930 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1932 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1933 Lisp_Object langsys_list
= Qnil
;
1934 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1937 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1939 OTF_LangSys
*langsys
;
1940 Lisp_Object feature_list
= Qnil
;
1941 Lisp_Object langsys_tag
;
1944 if (k
== script
->LangSysCount
)
1946 langsys
= &script
->DefaultLangSys
;
1951 langsys
= script
->LangSys
+ k
;
1953 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1955 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1957 OTF_Feature
*feature
1958 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1959 Lisp_Object feature_tag
1960 = otf_tag_symbol (feature
->FeatureTag
);
1962 feature_list
= Fcons (feature_tag
, feature_list
);
1964 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1967 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1972 XSETCAR (capability
, script_list
);
1974 XSETCDR (capability
, script_list
);
1980 /* Parse OTF features in SPEC and write a proper features spec string
1981 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1982 assured that the sufficient memory has already allocated for
1986 generate_otf_features (Lisp_Object spec
, char *features
)
1994 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2000 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2005 else if (! asterisk
)
2007 val
= SYMBOL_NAME (val
);
2008 p
+= esprintf (p
, "%s", SDATA (val
));
2012 val
= SYMBOL_NAME (val
);
2013 p
+= esprintf (p
, "~%s", SDATA (val
));
2017 error ("OTF spec too long");
2021 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
2023 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2025 return Fcons (make_number (len
),
2026 make_unibyte_string (device_table
->DeltaValue
, len
));
2030 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2032 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2034 if (value_format
& OTF_XPlacement
)
2035 ASET (val
, 0, make_number (value_record
->XPlacement
));
2036 if (value_format
& OTF_YPlacement
)
2037 ASET (val
, 1, make_number (value_record
->YPlacement
));
2038 if (value_format
& OTF_XAdvance
)
2039 ASET (val
, 2, make_number (value_record
->XAdvance
));
2040 if (value_format
& OTF_YAdvance
)
2041 ASET (val
, 3, make_number (value_record
->YAdvance
));
2042 if (value_format
& OTF_XPlaDevice
)
2043 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2044 if (value_format
& OTF_YPlaDevice
)
2045 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2046 if (value_format
& OTF_XAdvDevice
)
2047 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2048 if (value_format
& OTF_YAdvDevice
)
2049 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2054 font_otf_Anchor (OTF_Anchor
*anchor
)
2058 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2059 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2060 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2061 if (anchor
->AnchorFormat
== 2)
2062 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2065 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2066 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2070 #endif /* HAVE_LIBOTF */
2077 font_rescale_ratio (Lisp_Object font_entity
)
2079 Lisp_Object tail
, elt
;
2080 Lisp_Object name
= Qnil
;
2082 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2085 if (FLOATP (XCDR (elt
)))
2087 if (STRINGP (XCAR (elt
)))
2090 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2091 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2092 return XFLOAT_DATA (XCDR (elt
));
2094 else if (FONT_SPEC_P (XCAR (elt
)))
2096 if (font_match_p (XCAR (elt
), font_entity
))
2097 return XFLOAT_DATA (XCDR (elt
));
2104 /* We sort fonts by scoring each of them against a specified
2105 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2106 the value is, the closer the font is to the font-spec.
2108 The lowest 2 bits of the score are used for driver type. The font
2109 available by the most preferred font driver is 0.
2111 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2112 WEIGHT, SLANT, WIDTH, and SIZE. */
2114 /* How many bits to shift to store the difference value of each font
2115 property in a score. Note that floats for FONT_TYPE_INDEX and
2116 FONT_REGISTRY_INDEX are not used. */
2117 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2119 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2120 The return value indicates how different ENTITY is compared with
2124 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2129 /* Score three style numeric fields. Maximum difference is 127. */
2130 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2131 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2133 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2134 - (XINT (spec_prop
[i
]) >> 8));
2135 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2138 /* Score the size. Maximum difference is 127. */
2139 i
= FONT_SIZE_INDEX
;
2140 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2141 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2143 /* We use the higher 6-bit for the actual size difference. The
2144 lowest bit is set if the DPI is different. */
2146 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2147 EMACS_INT entity_size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
2149 if (CONSP (Vface_font_rescale_alist
))
2150 pixel_size
*= font_rescale_ratio (entity
);
2151 if (pixel_size
* 2 < entity_size
|| entity_size
* 2 < pixel_size
)
2152 /* This size is wrong by more than a factor 2: reject it! */
2154 diff
= eabs (pixel_size
- entity_size
) << 1;
2155 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2156 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2158 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2159 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2161 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2168 /* Concatenate all elements of LIST into one vector. LIST is a list
2169 of font-entity vectors. */
2172 font_vconcat_entity_vectors (Lisp_Object list
)
2174 EMACS_INT nargs
= XFASTINT (Flength (list
));
2177 SAFE_ALLOCA_LISP (args
, nargs
);
2180 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2181 args
[i
] = XCAR (list
);
2182 Lisp_Object result
= Fvconcat (nargs
, args
);
2188 /* The structure for elements being sorted by qsort. */
2189 struct font_sort_data
2192 int font_driver_preference
;
2197 /* The comparison function for qsort. */
2200 font_compare (const void *d1
, const void *d2
)
2202 const struct font_sort_data
*data1
= d1
;
2203 const struct font_sort_data
*data2
= d2
;
2205 if (data1
->score
< data2
->score
)
2207 else if (data1
->score
> data2
->score
)
2209 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2213 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2214 If PREFER specifies a point-size, calculate the corresponding
2215 pixel-size from QCdpi property of PREFER or from the Y-resolution
2216 of FRAME before sorting.
2218 If BEST-ONLY is nonzero, return the best matching entity (that
2219 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2220 if BEST-ONLY is negative). Otherwise, return the sorted result as
2221 a single vector of font-entities.
2223 This function does no optimization for the case that the total
2224 number of elements is 1. The caller should avoid calling this in
2228 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2229 struct frame
*f
, int best_only
)
2231 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2233 struct font_sort_data
*data
;
2234 unsigned best_score
;
2235 Lisp_Object best_entity
;
2236 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2239 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2240 prefer_prop
[i
] = AREF (prefer
, i
);
2241 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2242 prefer_prop
[FONT_SIZE_INDEX
]
2243 = make_number (font_pixel_size (f
, prefer
));
2245 if (NILP (XCDR (list
)))
2247 /* What we have to take care of is this single vector. */
2249 maxlen
= ASIZE (vec
);
2253 /* We don't have to perform sort, so there's no need of creating
2254 a single vector. But, we must find the length of the longest
2257 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2258 if (maxlen
< ASIZE (XCAR (tail
)))
2259 maxlen
= ASIZE (XCAR (tail
));
2263 /* We have to create a single vector to sort it. */
2264 vec
= font_vconcat_entity_vectors (list
);
2265 maxlen
= ASIZE (vec
);
2268 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2269 best_score
= 0xFFFFFFFF;
2272 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2274 int font_driver_preference
= 0;
2275 Lisp_Object current_font_driver
;
2281 /* We are sure that the length of VEC > 0. */
2282 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2283 /* Score the elements. */
2284 for (i
= 0; i
< len
; i
++)
2286 data
[i
].entity
= AREF (vec
, i
);
2288 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2290 ? font_score (data
[i
].entity
, prefer_prop
)
2292 if (best_only
&& best_score
> data
[i
].score
)
2294 best_score
= data
[i
].score
;
2295 best_entity
= data
[i
].entity
;
2296 if (best_score
== 0)
2299 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2301 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2302 font_driver_preference
++;
2304 data
[i
].font_driver_preference
= font_driver_preference
;
2307 /* Sort if necessary. */
2310 qsort (data
, len
, sizeof *data
, font_compare
);
2311 for (i
= 0; i
< len
; i
++)
2312 ASET (vec
, i
, data
[i
].entity
);
2321 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2326 /* API of Font Service Layer. */
2328 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2329 sort_shift_bits. Finternal_set_font_selection_order calls this
2330 function with font_sort_order after setting up it. */
2333 font_update_sort_order (int *order
)
2337 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2339 int xlfd_idx
= order
[i
];
2341 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2342 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2343 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2344 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2345 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2346 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2348 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2353 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2354 Lisp_Object features
, Lisp_Object table
)
2359 table
= assq_no_quit (script
, table
);
2362 table
= XCDR (table
);
2363 if (! NILP (langsys
))
2365 table
= assq_no_quit (langsys
, table
);
2371 val
= assq_no_quit (Qnil
, table
);
2373 table
= XCAR (table
);
2377 table
= XCDR (table
);
2378 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2380 if (NILP (XCAR (features
)))
2385 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2391 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2394 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2396 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2398 script
= XCAR (spec
);
2402 langsys
= XCAR (spec
);
2413 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2414 XCAR (otf_capability
)))
2416 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2417 XCDR (otf_capability
)))
2424 /* Check if FONT (font-entity or font-object) matches with the font
2425 specification SPEC. */
2428 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2430 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2431 Lisp_Object extra
, font_extra
;
2434 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2435 if (! NILP (AREF (spec
, i
))
2436 && ! NILP (AREF (font
, i
))
2437 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2439 props
= XFONT_SPEC (spec
)->props
;
2440 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2442 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2443 prop
[i
] = AREF (spec
, i
);
2444 prop
[FONT_SIZE_INDEX
]
2445 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2449 if (font_score (font
, props
) > 0)
2451 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2452 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2453 for (; CONSP (extra
); extra
= XCDR (extra
))
2455 Lisp_Object key
= XCAR (XCAR (extra
));
2456 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2458 if (EQ (key
, QClang
))
2460 val2
= assq_no_quit (key
, font_extra
);
2469 if (NILP (Fmemq (val
, val2
)))
2474 ? NILP (Fmemq (val
, XCDR (val2
)))
2478 else if (EQ (key
, QCscript
))
2480 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2486 /* All characters in the list must be supported. */
2487 for (; CONSP (val2
); val2
= XCDR (val2
))
2489 if (! CHARACTERP (XCAR (val2
)))
2491 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2492 == FONT_INVALID_CODE
)
2496 else if (VECTORP (val2
))
2498 /* At most one character in the vector must be supported. */
2499 for (i
= 0; i
< ASIZE (val2
); i
++)
2501 if (! CHARACTERP (AREF (val2
, i
)))
2503 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2504 != FONT_INVALID_CODE
)
2507 if (i
== ASIZE (val2
))
2512 else if (EQ (key
, QCotf
))
2516 if (! FONT_OBJECT_P (font
))
2518 fontp
= XFONT_OBJECT (font
);
2519 if (! fontp
->driver
->otf_capability
)
2521 val2
= fontp
->driver
->otf_capability (fontp
);
2522 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2533 Each font backend has the callback function get_cache, and it
2534 returns a cons cell of which cdr part can be freely used for
2535 caching fonts. The cons cell may be shared by multiple frames
2536 and/or multiple font drivers. So, we arrange the cdr part as this:
2538 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2540 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2541 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2542 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2544 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2545 static void font_finish_cache (struct frame
*, struct font_driver
*);
2546 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2547 static void font_clear_cache (struct frame
*, Lisp_Object
,
2548 struct font_driver
*);
2551 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2553 Lisp_Object cache
, val
;
2555 cache
= driver
->get_cache (f
);
2557 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2561 val
= list2 (driver
->type
, make_number (1));
2562 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2566 val
= XCDR (XCAR (val
));
2567 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2573 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2575 Lisp_Object cache
, val
, tmp
;
2578 cache
= driver
->get_cache (f
);
2580 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2581 cache
= val
, val
= XCDR (val
);
2582 eassert (! NILP (val
));
2583 tmp
= XCDR (XCAR (val
));
2584 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2585 if (XINT (XCAR (tmp
)) == 0)
2587 font_clear_cache (f
, XCAR (val
), driver
);
2588 XSETCDR (cache
, XCDR (val
));
2594 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2596 Lisp_Object val
= driver
->get_cache (f
);
2597 Lisp_Object type
= driver
->type
;
2599 eassert (CONSP (val
));
2600 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2601 eassert (CONSP (val
));
2602 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2603 val
= XCDR (XCAR (val
));
2609 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2611 Lisp_Object tail
, elt
;
2615 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2616 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2619 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2620 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2623 eassert (VECTORP (elt
));
2624 for (i
= 0; i
< ASIZE (elt
); i
++)
2626 entity
= AREF (elt
, i
);
2628 if (FONT_ENTITY_P (entity
)
2629 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2631 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2633 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2635 Lisp_Object val
= XCAR (objlist
);
2636 struct font
*font
= XFONT_OBJECT (val
);
2638 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2640 eassert (font
&& driver
== font
->driver
);
2641 driver
->close (font
);
2644 if (driver
->free_entity
)
2645 driver
->free_entity (entity
);
2650 XSETCDR (cache
, Qnil
);
2654 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2656 /* Check each font-entity in VEC, and return a list of font-entities
2657 that satisfy these conditions:
2658 (1) matches with SPEC and SIZE if SPEC is not nil, and
2659 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2663 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2665 Lisp_Object entity
, val
;
2666 enum font_property_index prop
;
2669 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2671 entity
= AREF (vec
, i
);
2672 if (! NILP (Vface_ignored_fonts
))
2676 Lisp_Object tail
, regexp
;
2678 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2681 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2683 regexp
= XCAR (tail
);
2684 if (STRINGP (regexp
)
2685 && fast_c_string_match_ignore_case (regexp
, name
,
2695 val
= Fcons (entity
, val
);
2698 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2699 if (INTEGERP (AREF (spec
, prop
))
2700 && ((XINT (AREF (spec
, prop
)) >> 8)
2701 != (XINT (AREF (entity
, prop
)) >> 8)))
2702 prop
= FONT_SPEC_MAX
;
2703 if (prop
< FONT_SPEC_MAX
2705 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2707 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2709 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2710 prop
= FONT_SPEC_MAX
;
2712 if (prop
< FONT_SPEC_MAX
2713 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2714 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2715 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2716 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2717 prop
= FONT_SPEC_MAX
;
2718 if (prop
< FONT_SPEC_MAX
2719 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2720 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2721 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2722 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2723 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2724 prop
= FONT_SPEC_MAX
;
2725 if (prop
< FONT_SPEC_MAX
)
2726 val
= Fcons (entity
, val
);
2728 return (Fvconcat (1, &val
));
2732 /* Return a list of vectors of font-entities matching with SPEC on
2733 FRAME. Each elements in the list is a vector of entities from the
2734 same font-driver. */
2737 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2739 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2740 Lisp_Object ftype
, val
;
2741 Lisp_Object list
= Qnil
;
2743 bool need_filtering
= 0;
2746 eassert (FONT_SPEC_P (spec
));
2748 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2749 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2750 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2751 size
= font_pixel_size (f
, spec
);
2755 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2756 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2757 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2758 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2759 if (i
!= FONT_SPACING_INDEX
)
2761 ASET (scratch_font_spec
, i
, Qnil
);
2762 if (! NILP (AREF (spec
, i
)))
2765 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2766 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2768 for (; driver_list
; driver_list
= driver_list
->next
)
2770 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2772 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2774 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2775 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2780 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2783 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2785 val
= Fvconcat (1, &val
);
2786 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2787 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2790 if (VECTORP (val
) && ASIZE (val
) > 0
2792 || ! NILP (Vface_ignored_fonts
)))
2793 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2794 if (VECTORP (val
) && ASIZE (val
) > 0)
2795 list
= Fcons (val
, list
);
2798 list
= Fnreverse (list
);
2799 FONT_ADD_LOG ("list", spec
, list
);
2804 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2805 nil, is an array of face's attributes, which specifies preferred
2806 font-related attributes. */
2809 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2811 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2812 Lisp_Object ftype
, size
, entity
;
2813 Lisp_Object work
= copy_font_spec (spec
);
2815 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2816 size
= AREF (spec
, FONT_SIZE_INDEX
);
2819 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2820 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2821 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2822 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2825 for (; driver_list
; driver_list
= driver_list
->next
)
2827 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2829 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2831 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2832 entity
= assoc_no_quit (work
, XCDR (cache
));
2834 entity
= AREF (XCDR (entity
), 0);
2837 entity
= driver_list
->driver
->match (f
, work
);
2840 Lisp_Object copy
= copy_font_spec (work
);
2841 Lisp_Object match
= Fvector (1, &entity
);
2843 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2844 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2847 if (! NILP (entity
))
2850 FONT_ADD_LOG ("match", work
, entity
);
2855 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2856 opened font object. */
2859 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2861 struct font_driver_list
*driver_list
;
2862 Lisp_Object objlist
, size
, val
, font_object
;
2864 int min_width
, height
, psize
;
2866 eassert (FONT_ENTITY_P (entity
));
2867 size
= AREF (entity
, FONT_SIZE_INDEX
);
2868 if (XINT (size
) != 0)
2869 pixel_size
= XINT (size
);
2871 val
= AREF (entity
, FONT_TYPE_INDEX
);
2872 for (driver_list
= f
->font_driver_list
;
2873 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2874 driver_list
= driver_list
->next
);
2878 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2879 objlist
= XCDR (objlist
))
2881 Lisp_Object fn
= XCAR (objlist
);
2882 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2883 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2885 if (driver_list
->driver
->cached_font_ok
== NULL
2886 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2891 /* We always open a font of manageable size; i.e non-zero average
2892 width and height. */
2893 for (psize
= pixel_size
; ; psize
++)
2895 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2896 if (NILP (font_object
))
2898 font
= XFONT_OBJECT (font_object
);
2899 if (font
->average_width
> 0 && font
->height
> 0)
2902 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2903 FONT_ADD_LOG ("open", entity
, font_object
);
2904 ASET (entity
, FONT_OBJLIST_INDEX
,
2905 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2907 font
= XFONT_OBJECT (font_object
);
2908 min_width
= (font
->min_width
? font
->min_width
2909 : font
->average_width
? font
->average_width
2910 : font
->space_width
? font
->space_width
2912 height
= (font
->height
? font
->height
: 1);
2913 #ifdef HAVE_WINDOW_SYSTEM
2914 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2915 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2917 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2918 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2919 f
->fonts_changed
= 1;
2923 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2924 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2925 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2926 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2934 /* Close FONT_OBJECT that is opened on frame F. */
2937 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2939 struct font
*font
= XFONT_OBJECT (font_object
);
2941 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2942 /* Already closed. */
2944 FONT_ADD_LOG ("close", font_object
, Qnil
);
2945 font
->driver
->close (font
);
2946 #ifdef HAVE_WINDOW_SYSTEM
2947 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2948 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2953 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2954 FONT is a font-entity and it must be opened to check. */
2957 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2961 if (FONT_ENTITY_P (font
))
2963 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2964 struct font_driver_list
*driver_list
;
2966 for (driver_list
= f
->font_driver_list
;
2967 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2968 driver_list
= driver_list
->next
);
2971 if (! driver_list
->driver
->has_char
)
2973 return driver_list
->driver
->has_char (font
, c
);
2976 eassert (FONT_OBJECT_P (font
));
2977 fontp
= XFONT_OBJECT (font
);
2978 if (fontp
->driver
->has_char
)
2980 int result
= fontp
->driver
->has_char (font
, c
);
2985 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2989 /* Return the glyph ID of FONT_OBJECT for character C. */
2992 font_encode_char (Lisp_Object font_object
, int c
)
2996 eassert (FONT_OBJECT_P (font_object
));
2997 font
= XFONT_OBJECT (font_object
);
2998 return font
->driver
->encode_char (font
, c
);
3002 /* Return the name of FONT_OBJECT. */
3005 font_get_name (Lisp_Object font_object
)
3007 eassert (FONT_OBJECT_P (font_object
));
3008 return AREF (font_object
, FONT_NAME_INDEX
);
3012 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3013 could not be parsed by font_parse_name, return Qnil. */
3016 font_spec_from_name (Lisp_Object font_name
)
3018 Lisp_Object spec
= Ffont_spec (0, NULL
);
3020 CHECK_STRING (font_name
);
3021 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
3023 font_put_extra (spec
, QCname
, font_name
);
3024 font_put_extra (spec
, QCuser_spec
, font_name
);
3030 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3032 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3037 if (! NILP (Ffont_get (font
, QCname
)))
3039 font
= copy_font_spec (font
);
3040 font_put_extra (font
, QCname
, Qnil
);
3043 if (NILP (AREF (font
, prop
))
3044 && prop
!= FONT_FAMILY_INDEX
3045 && prop
!= FONT_FOUNDRY_INDEX
3046 && prop
!= FONT_WIDTH_INDEX
3047 && prop
!= FONT_SIZE_INDEX
)
3049 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3050 font
= copy_font_spec (font
);
3051 ASET (font
, prop
, Qnil
);
3052 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3054 if (prop
== FONT_FAMILY_INDEX
)
3056 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3057 /* If we are setting the font family, we must also clear
3058 FONT_WIDTH_INDEX to avoid rejecting families that lack
3059 support for some widths. */
3060 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3062 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3063 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3064 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3065 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3066 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3067 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3069 else if (prop
== FONT_SIZE_INDEX
)
3071 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3072 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3073 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3075 else if (prop
== FONT_WIDTH_INDEX
)
3076 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3077 attrs
[LFACE_FONT_INDEX
] = font
;
3080 /* Select a font from ENTITIES (list of font-entity vectors) that
3081 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3084 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3085 Lisp_Object
*attrs
, int pixel_size
, int c
)
3087 Lisp_Object font_entity
;
3091 if (NILP (XCDR (entities
))
3092 && ASIZE (XCAR (entities
)) == 1)
3094 font_entity
= AREF (XCAR (entities
), 0);
3095 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3100 /* Sort fonts by properties specified in ATTRS. */
3101 prefer
= scratch_font_prefer
;
3103 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3104 ASET (prefer
, i
, Qnil
);
3105 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3107 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3109 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3110 ASET (prefer
, i
, AREF (face_font
, i
));
3112 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3113 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3114 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3115 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3116 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3117 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3118 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3120 return font_sort_entities (entities
, prefer
, f
, c
);
3123 /* Return a font-entity that satisfies SPEC and is the best match for
3124 face's font related attributes in ATTRS. C, if not negative, is a
3125 character that the entity must support. */
3128 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3131 Lisp_Object entities
, val
;
3132 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3137 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3138 if (NILP (registry
[0]))
3140 registry
[0] = DEFAULT_ENCODING
;
3141 registry
[1] = Qascii_0
;
3142 registry
[2] = zero_vector
;
3145 registry
[1] = zero_vector
;
3147 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3149 struct charset
*encoding
, *repertory
;
3151 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3152 &encoding
, &repertory
) < 0)
3155 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3157 else if (c
> encoding
->max_char
)
3161 work
= copy_font_spec (spec
);
3162 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3163 pixel_size
= font_pixel_size (f
, spec
);
3164 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3166 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3168 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3172 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3173 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3174 if (! NILP (foundry
[0]))
3175 foundry
[1] = zero_vector
;
3176 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3178 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3179 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3181 foundry
[2] = zero_vector
;
3184 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3186 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3187 if (! NILP (adstyle
[0]))
3188 adstyle
[1] = zero_vector
;
3189 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3191 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3193 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3195 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3197 adstyle
[2] = zero_vector
;
3200 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3203 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3206 val
= AREF (work
, FONT_FAMILY_INDEX
);
3207 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3209 val
= attrs
[LFACE_FAMILY_INDEX
];
3210 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3212 Lisp_Object familybuf
[3];
3217 family
[1] = zero_vector
; /* terminator. */
3222 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3224 if (! NILP (alters
))
3226 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3227 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3228 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3229 family
[i
] = XCAR (alters
);
3230 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3232 family
[i
] = zero_vector
;
3239 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3241 family
[i
] = zero_vector
;
3245 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3247 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3248 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3250 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3251 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3253 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3254 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3256 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3257 entities
= font_list_entities (f
, work
);
3258 if (! NILP (entities
))
3260 val
= font_select_entity (f
, entities
,
3261 attrs
, pixel_size
, c
);
3279 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3283 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3284 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3285 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3288 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3289 size
= font_pixel_size (f
, spec
);
3293 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3294 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3297 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3298 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3299 eassert (INTEGERP (height
));
3304 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3308 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3309 size
= (NUMBERP (ffsize
)
3310 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3314 size
*= font_rescale_ratio (entity
);
3317 return font_open_entity (f
, entity
, size
);
3321 /* Find a font that satisfies SPEC and is the best match for
3322 face's attributes in ATTRS on FRAME, and return the opened
3326 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3328 Lisp_Object entity
, name
;
3330 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3333 /* No font is listed for SPEC, but each font-backend may have
3334 different criteria about "font matching". So, try it. */
3335 entity
= font_matching_entity (f
, attrs
, spec
);
3339 /* Don't lose the original name that was put in initially. We need
3340 it to re-apply the font when font parameters (like hinting or dpi) have
3342 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3345 name
= Ffont_get (spec
, QCuser_spec
);
3346 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3352 /* Make FACE on frame F ready to use the font opened for FACE. */
3355 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3357 if (face
->font
->driver
->prepare_face
)
3358 face
->font
->driver
->prepare_face (f
, face
);
3362 /* Make FACE on frame F stop using the font opened for FACE. */
3365 font_done_for_face (struct frame
*f
, struct face
*face
)
3367 if (face
->font
->driver
->done_face
)
3368 face
->font
->driver
->done_face (f
, face
);
3372 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3373 font is found, return Qnil. */
3376 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3378 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3380 /* We set up the default font-related attributes of a face to prefer
3382 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3383 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3384 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3386 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3388 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3390 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3392 return font_load_for_lface (f
, attrs
, spec
);
3396 /* Open a font that matches NAME on frame F. If no proper font is
3397 found, return Qnil. */
3400 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3402 Lisp_Object spec
= CALLN (Ffont_spec
, QCname
, name
);
3403 Lisp_Object ret
= font_open_by_spec (f
, spec
);
3404 /* Do not lose name originally put in. */
3406 font_put_extra (ret
, QCuser_spec
, name
);
3412 /* Register font-driver DRIVER. This function is used in two ways.
3414 The first is with frame F non-NULL. In this case, make DRIVER
3415 available (but not yet activated) on F. All frame creators
3416 (e.g. Fx_create_frame) must call this function at least once with
3417 an available font-driver.
3419 The second is with frame F NULL. In this case, DRIVER is globally
3420 registered in the variable `font_driver_list'. All font-driver
3421 implementations must call this function in its syms_of_XXXX
3422 (e.g. syms_of_xfont). */
3425 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3427 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3428 struct font_driver_list
*prev
, *list
;
3430 #ifdef HAVE_WINDOW_SYSTEM
3431 if (f
&& ! driver
->draw
)
3432 error ("Unusable font driver for a frame: %s",
3433 SDATA (SYMBOL_NAME (driver
->type
)));
3434 #endif /* HAVE_WINDOW_SYSTEM */
3436 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3437 if (EQ (list
->driver
->type
, driver
->type
))
3438 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3440 list
= xmalloc (sizeof *list
);
3442 list
->driver
= driver
;
3447 f
->font_driver_list
= list
;
3449 font_driver_list
= list
;
3455 free_font_driver_list (struct frame
*f
)
3457 struct font_driver_list
*list
, *next
;
3459 for (list
= f
->font_driver_list
; list
; list
= next
)
3464 f
->font_driver_list
= NULL
;
3468 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3469 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3470 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3472 A caller must free all realized faces if any in advance. The
3473 return value is a list of font backends actually made used on
3477 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3479 Lisp_Object active_drivers
= Qnil
;
3480 struct font_driver_list
*list
;
3482 /* At first, turn off non-requested drivers, and turn on requested
3484 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3486 struct font_driver
*driver
= list
->driver
;
3487 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3492 if (driver
->end_for_frame
)
3493 driver
->end_for_frame (f
);
3494 font_finish_cache (f
, driver
);
3499 if (! driver
->start_for_frame
3500 || driver
->start_for_frame (f
) == 0)
3502 font_prepare_cache (f
, driver
);
3509 if (NILP (new_drivers
))
3512 if (! EQ (new_drivers
, Qt
))
3514 /* Re-order the driver list according to new_drivers. */
3515 struct font_driver_list
**list_table
, **next
;
3520 SAFE_NALLOCA (list_table
, 1, num_font_drivers
+ 1);
3521 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3523 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3524 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3527 list_table
[i
++] = list
;
3529 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3531 list_table
[i
++] = list
;
3532 list_table
[i
] = NULL
;
3534 next
= &f
->font_driver_list
;
3535 for (i
= 0; list_table
[i
]; i
++)
3537 *next
= list_table
[i
];
3538 next
= &(*next
)->next
;
3543 if (! f
->font_driver_list
->on
)
3544 { /* None of the drivers is enabled: enable them all.
3545 Happens if you set the list of drivers to (xft x) in your .emacs
3546 and then use it under w32 or ns. */
3547 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3549 struct font_driver
*driver
= list
->driver
;
3550 eassert (! list
->on
);
3551 if (! driver
->start_for_frame
3552 || driver
->start_for_frame (f
) == 0)
3554 font_prepare_cache (f
, driver
);
3561 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3563 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3564 return active_drivers
;
3567 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
3570 fset_font_data (struct frame
*f
, Lisp_Object val
)
3576 font_put_frame_data (struct frame
*f
, Lisp_Object driver
, void *data
)
3578 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3581 fset_font_data (f
, Fdelq (val
, f
->font_data
));
3585 fset_font_data (f
, Fcons (Fcons (driver
, make_save_ptr (data
)),
3588 XSETCDR (val
, make_save_ptr (data
));
3593 font_get_frame_data (struct frame
*f
, Lisp_Object driver
)
3595 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3597 return NILP (val
) ? NULL
: XSAVE_POINTER (XCDR (val
), 0);
3600 #endif /* HAVE_XFT || HAVE_FREETYPE */
3602 /* Sets attributes on a font. Any properties that appear in ALIST and
3603 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3604 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3605 arrays of strings. This function is intended for use by the font
3606 drivers to implement their specific font_filter_properties. */
3608 font_filter_properties (Lisp_Object font
,
3610 const char *const boolean_properties
[],
3611 const char *const non_boolean_properties
[])
3616 /* Set boolean values to Qt or Qnil. */
3617 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3618 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3620 Lisp_Object key
= XCAR (XCAR (it
));
3621 Lisp_Object val
= XCDR (XCAR (it
));
3622 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3624 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3626 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3627 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3630 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3631 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3632 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3633 || strcmp ("Off", str
) == 0)
3638 Ffont_put (font
, key
, val
);
3642 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3643 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3645 Lisp_Object key
= XCAR (XCAR (it
));
3646 Lisp_Object val
= XCDR (XCAR (it
));
3647 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3648 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3649 Ffont_put (font
, key
, val
);
3654 /* Return the font used to draw character C by FACE at buffer position
3655 POS in window W. If STRING is non-nil, it is a string containing C
3656 at index POS. If C is negative, get C from the current buffer or
3660 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3665 Lisp_Object font_object
;
3667 multibyte
= (NILP (string
)
3668 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3669 : STRING_MULTIBYTE (string
));
3676 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3678 c
= FETCH_CHAR (pos_byte
);
3681 c
= FETCH_BYTE (pos
);
3687 multibyte
= STRING_MULTIBYTE (string
);
3690 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3692 str
= SDATA (string
) + pos_byte
;
3693 c
= STRING_CHAR (str
);
3696 c
= SDATA (string
)[pos
];
3700 f
= XFRAME (w
->frame
);
3701 if (! FRAME_WINDOW_P (f
))
3708 if (STRINGP (string
))
3709 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3710 DEFAULT_FACE_ID
, false);
3712 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3713 pos
+ 100, false, -1);
3714 face
= FACE_FROM_ID (f
, face_id
);
3718 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3719 face
= FACE_FROM_ID (f
, face_id
);
3724 XSETFONT (font_object
, face
->font
);
3729 #ifdef HAVE_WINDOW_SYSTEM
3731 /* Check how many characters after character/byte position POS/POS_BYTE
3732 (at most to *LIMIT) can be displayed by the same font in the window W.
3733 FACE, if non-NULL, is the face selected for the character at POS.
3734 If STRING is not nil, it is the string to check instead of the current
3735 buffer. In that case, FACE must be not NULL.
3737 The return value is the font-object for the character at POS.
3738 *LIMIT is set to the position where that font can't be used.
3740 It is assured that the current buffer (or STRING) is multibyte. */
3743 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3744 struct window
*w
, struct face
*face
, Lisp_Object string
)
3748 Lisp_Object font_object
= Qnil
;
3756 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3758 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3764 while (pos
< *limit
)
3766 Lisp_Object category
;
3769 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3771 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3772 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3773 if (INTEGERP (category
)
3774 && (XINT (category
) == UNICODE_CATEGORY_Cf
3775 || CHAR_VARIATION_SELECTOR_P (c
)))
3777 if (NILP (font_object
))
3779 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3780 if (NILP (font_object
))
3784 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3794 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3795 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3796 Return nil otherwise.
3797 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3798 which kind of font it is. It must be one of `font-spec', `font-entity',
3800 (Lisp_Object object
, Lisp_Object extra_type
)
3802 if (NILP (extra_type
))
3803 return (FONTP (object
) ? Qt
: Qnil
);
3804 if (EQ (extra_type
, Qfont_spec
))
3805 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3806 if (EQ (extra_type
, Qfont_entity
))
3807 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3808 if (EQ (extra_type
, Qfont_object
))
3809 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3810 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3813 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3814 doc
: /* Return a newly created font-spec with arguments as properties.
3816 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3817 valid font property name listed below:
3819 `:family', `:weight', `:slant', `:width'
3821 They are the same as face attributes of the same name. See
3822 `set-face-attribute'.
3826 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3830 VALUE must be a string or a symbol specifying the additional
3831 typographic style information of a font, e.g. ``sans''.
3835 VALUE must be a string or a symbol specifying the charset registry and
3836 encoding of a font, e.g. ``iso8859-1''.
3840 VALUE must be a non-negative integer or a floating point number
3841 specifying the font size. It specifies the font size in pixels (if
3842 VALUE is an integer), or in points (if VALUE is a float).
3846 VALUE must be a string of XLFD-style or fontconfig-style font name.
3850 VALUE must be a symbol representing a script that the font must
3851 support. It may be a symbol representing a subgroup of a script
3852 listed in the variable `script-representative-chars'.
3856 VALUE must be a symbol of two-letter ISO-639 language names,
3861 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3862 required OpenType features.
3864 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3865 LANGSYS-TAG: OpenType language system tag symbol,
3866 or nil for the default language system.
3867 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3868 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3870 GSUB and GPOS may contain `nil' element. In such a case, the font
3871 must not have any of the remaining elements.
3873 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3874 be an OpenType font whose GPOS table of `thai' script's default
3875 language system must contain `mark' feature.
3877 usage: (font-spec ARGS...) */)
3878 (ptrdiff_t nargs
, Lisp_Object
*args
)
3880 Lisp_Object spec
= font_make_spec ();
3883 for (i
= 0; i
< nargs
; i
+= 2)
3885 Lisp_Object key
= args
[i
], val
;
3889 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3892 if (EQ (key
, QCname
))
3895 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3896 error ("Invalid font name: %s", SSDATA (val
));
3897 font_put_extra (spec
, key
, val
);
3901 int idx
= get_font_prop_index (key
);
3905 val
= font_prop_validate (idx
, Qnil
, val
);
3906 if (idx
< FONT_EXTRA_INDEX
)
3907 ASET (spec
, idx
, val
);
3909 font_put_extra (spec
, key
, val
);
3912 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3918 /* Return a copy of FONT as a font-spec. For the sake of speed, this code
3919 relies on an internal stuff exposed from alloc.c and should be handled
3923 copy_font_spec (Lisp_Object font
)
3925 enum { font_spec_size
= VECSIZE (struct font_spec
) };
3926 Lisp_Object new_spec
, tail
, *pcdr
;
3927 struct font_spec
*spec
;
3931 /* Make an uninitialized font-spec object. */
3932 spec
= (struct font_spec
*) allocate_vector (font_spec_size
);
3933 XSETPVECTYPESIZE (spec
, PVEC_FONT
, FONT_SPEC_MAX
,
3934 font_spec_size
- FONT_SPEC_MAX
);
3936 spec
->props
[FONT_TYPE_INDEX
] = spec
->props
[FONT_EXTRA_INDEX
] = Qnil
;
3938 /* Copy basic properties FONT_FOUNDRY_INDEX..FONT_AVGWIDTH_INDEX. */
3939 memcpy (spec
->props
+ 1, XVECTOR (font
)->contents
+ 1,
3940 (FONT_EXTRA_INDEX
- 1) * word_size
);
3942 /* Copy an alist of extra information but discard :font-entity property. */
3943 pcdr
= spec
->props
+ FONT_EXTRA_INDEX
;
3944 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3945 if (!EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3946 *pcdr
= Fcons (XCAR (tail
), Qnil
), pcdr
= xcdr_addr (*pcdr
);
3948 XSETFONT (new_spec
, spec
);
3952 /* Merge font-specs FROM and TO, and return a new font-spec.
3953 Every specified property in FROM overrides the corresponding
3956 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3958 Lisp_Object extra
, tail
;
3963 to
= copy_font_spec (to
);
3964 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3965 ASET (to
, i
, AREF (from
, i
));
3966 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3967 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3968 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3970 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3973 XSETCDR (slot
, XCDR (XCAR (tail
)));
3975 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3977 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3981 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3982 doc
: /* Return the value of FONT's property KEY.
3983 FONT is a font-spec, a font-entity, or a font-object.
3984 KEY is any symbol, but these are reserved for specific meanings:
3985 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3986 :size, :name, :script, :otf
3987 See the documentation of `font-spec' for their meanings.
3988 In addition, if FONT is a font-entity or a font-object, values of
3989 :script and :otf are different from those of a font-spec as below:
3991 The value of :script may be a list of scripts that are supported by the font.
3993 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3994 representing the OpenType features supported by the font by this form:
3995 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3996 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3998 (Lisp_Object font
, Lisp_Object key
)
4006 idx
= get_font_prop_index (key
);
4007 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4008 return font_style_symbolic (font
, idx
, 0);
4009 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4010 return AREF (font
, idx
);
4011 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4012 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4014 struct font
*fontp
= XFONT_OBJECT (font
);
4016 if (fontp
->driver
->otf_capability
)
4017 val
= fontp
->driver
->otf_capability (fontp
);
4019 val
= Fcons (Qnil
, Qnil
);
4026 #ifdef HAVE_WINDOW_SYSTEM
4028 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4029 doc
: /* Return a plist of face attributes generated by FONT.
4030 FONT is a font name, a font-spec, a font-entity, or a font-object.
4031 The return value is a list of the form
4033 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4035 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4036 compatible with `set-face-attribute'. Some of these key-attribute pairs
4037 may be omitted from the list if they are not specified by FONT.
4039 The optional argument FRAME specifies the frame that the face attributes
4040 are to be displayed on. If omitted, the selected frame is used. */)
4041 (Lisp_Object font
, Lisp_Object frame
)
4043 struct frame
*f
= decode_live_frame (frame
);
4044 Lisp_Object plist
[10];
4050 int fontset
= fs_query_fontset (font
, 0);
4051 Lisp_Object name
= font
;
4053 font
= fontset_ascii (fontset
);
4054 font
= font_spec_from_name (name
);
4056 signal_error ("Invalid font name", name
);
4058 else if (! FONTP (font
))
4059 signal_error ("Invalid font object", font
);
4061 val
= AREF (font
, FONT_FAMILY_INDEX
);
4064 plist
[n
++] = QCfamily
;
4065 plist
[n
++] = SYMBOL_NAME (val
);
4068 val
= AREF (font
, FONT_SIZE_INDEX
);
4071 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4072 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4073 plist
[n
++] = QCheight
;
4074 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4076 else if (FLOATP (val
))
4078 plist
[n
++] = QCheight
;
4079 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4082 val
= FONT_WEIGHT_FOR_FACE (font
);
4085 plist
[n
++] = QCweight
;
4089 val
= FONT_SLANT_FOR_FACE (font
);
4092 plist
[n
++] = QCslant
;
4096 val
= FONT_WIDTH_FOR_FACE (font
);
4099 plist
[n
++] = QCwidth
;
4103 return Flist (n
, plist
);
4108 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4109 doc
: /* Set one property of FONT: give property KEY value VAL.
4110 FONT is a font-spec, a font-entity, or a font-object.
4112 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4113 accepted by the function `font-spec' (which see), VAL must be what
4114 allowed in `font-spec'.
4116 If FONT is a font-entity or a font-object, KEY must not be the one
4117 accepted by `font-spec'. */)
4118 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4122 idx
= get_font_prop_index (prop
);
4123 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4125 CHECK_FONT_SPEC (font
);
4126 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4130 if (EQ (prop
, QCname
)
4131 || EQ (prop
, QCscript
)
4132 || EQ (prop
, QClang
)
4133 || EQ (prop
, QCotf
))
4134 CHECK_FONT_SPEC (font
);
4137 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4142 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4143 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4144 Optional 2nd argument FRAME specifies the target frame.
4145 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4146 Optional 4th argument PREFER, if non-nil, is a font-spec to
4147 control the order of the returned list. Fonts are sorted by
4148 how close they are to PREFER. */)
4149 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4151 struct frame
*f
= decode_live_frame (frame
);
4152 Lisp_Object vec
, list
;
4155 CHECK_FONT_SPEC (font_spec
);
4163 if (! NILP (prefer
))
4164 CHECK_FONT_SPEC (prefer
);
4166 list
= font_list_entities (f
, font_spec
);
4169 if (NILP (XCDR (list
))
4170 && ASIZE (XCAR (list
)) == 1)
4171 return list1 (AREF (XCAR (list
), 0));
4173 if (! NILP (prefer
))
4174 vec
= font_sort_entities (list
, prefer
, f
, 0);
4176 vec
= font_vconcat_entity_vectors (list
);
4177 if (n
== 0 || n
>= ASIZE (vec
))
4178 list
= CALLN (Fappend
, vec
, Qnil
);
4181 for (list
= Qnil
, n
--; n
>= 0; n
--)
4182 list
= Fcons (AREF (vec
, n
), list
);
4187 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4188 doc
: /* List available font families on the current frame.
4189 If FRAME is omitted or nil, the selected frame is used. */)
4192 struct frame
*f
= decode_live_frame (frame
);
4193 struct font_driver_list
*driver_list
;
4194 Lisp_Object list
= Qnil
;
4196 for (driver_list
= f
->font_driver_list
; driver_list
;
4197 driver_list
= driver_list
->next
)
4198 if (driver_list
->driver
->list_family
)
4200 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4201 Lisp_Object tail
= list
;
4203 for (; CONSP (val
); val
= XCDR (val
))
4204 if (NILP (Fmemq (XCAR (val
), tail
))
4205 && SYMBOLP (XCAR (val
)))
4206 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4211 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4212 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4213 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4214 (Lisp_Object font_spec
, Lisp_Object frame
)
4216 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4223 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4224 doc
: /* Return XLFD name of FONT.
4225 FONT is a font-spec, font-entity, or font-object.
4226 If the name is too long for XLFD (maximum 255 chars), return nil.
4227 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4228 the consecutive wildcards are folded into one. */)
4229 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4232 int namelen
, pixel_size
= 0;
4236 if (FONT_OBJECT_P (font
))
4238 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4240 if (STRINGP (font_name
)
4241 && SDATA (font_name
)[0] == '-')
4243 if (NILP (fold_wildcards
))
4245 lispstpcpy (name
, font_name
);
4246 namelen
= SBYTES (font_name
);
4249 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4251 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4255 if (! NILP (fold_wildcards
))
4257 char *p0
= name
, *p1
;
4259 while ((p1
= strstr (p0
, "-*-*")))
4261 strcpy (p1
, p1
+ 2);
4267 return make_string (name
, namelen
);
4271 clear_font_cache (struct frame
*f
)
4273 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4275 for (; driver_list
; driver_list
= driver_list
->next
)
4276 if (driver_list
->on
)
4278 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4282 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4284 eassert (! NILP (val
));
4285 tmp
= XCDR (XCAR (val
));
4286 if (XINT (XCAR (tmp
)) == 0)
4288 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4289 XSETCDR (cache
, XCDR (val
));
4294 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4295 doc
: /* Clear font cache of each frame. */)
4298 Lisp_Object list
, frame
;
4300 FOR_EACH_FRAME (list
, frame
)
4301 clear_font_cache (XFRAME (frame
));
4308 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4310 struct font
*font
= XFONT_OBJECT (font_object
);
4311 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4312 struct font_metrics metrics
;
4314 LGLYPH_SET_CODE (glyph
, code
);
4315 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4316 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4317 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4318 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4319 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4320 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4324 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4325 doc
: /* Shape the glyph-string GSTRING.
4326 Shaping means substituting glyphs and/or adjusting positions of glyphs
4327 to get the correct visual image of character sequences set in the
4328 header of the glyph-string.
4330 If the shaping was successful, the value is GSTRING itself or a newly
4331 created glyph-string. Otherwise, the value is nil.
4333 See the documentation of `composition-get-gstring' for the format of
4335 (Lisp_Object gstring
)
4338 Lisp_Object font_object
, n
, glyph
;
4339 ptrdiff_t i
, from
, to
;
4341 if (! composition_gstring_p (gstring
))
4342 signal_error ("Invalid glyph-string: ", gstring
);
4343 if (! NILP (LGSTRING_ID (gstring
)))
4345 font_object
= LGSTRING_FONT (gstring
);
4346 CHECK_FONT_OBJECT (font_object
);
4347 font
= XFONT_OBJECT (font_object
);
4348 if (! font
->driver
->shape
)
4351 /* Try at most three times with larger gstring each time. */
4352 for (i
= 0; i
< 3; i
++)
4354 n
= font
->driver
->shape (gstring
);
4357 gstring
= larger_vector (gstring
,
4358 LGSTRING_GLYPH_LEN (gstring
), -1);
4360 if (i
== 3 || XINT (n
) == 0)
4362 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4363 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4365 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4366 GLYPHS covers all characters (except for the last few ones) in
4367 GSTRING. More formally, provided that NCHARS is the number of
4368 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4369 and TO_IDX of each glyph must satisfy these conditions:
4371 GLYPHS[0].FROM_IDX == 0
4372 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4373 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4374 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4375 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4377 ;; Be sure to cover all characters.
4378 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4379 glyph
= LGSTRING_GLYPH (gstring
, 0);
4380 from
= LGLYPH_FROM (glyph
);
4381 to
= LGLYPH_TO (glyph
);
4382 if (from
!= 0 || to
< from
)
4384 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4386 glyph
= LGSTRING_GLYPH (gstring
, i
);
4389 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4390 && (LGLYPH_FROM (glyph
) == from
4391 ? LGLYPH_TO (glyph
) == to
4392 : LGLYPH_FROM (glyph
) == to
+ 1)))
4394 from
= LGLYPH_FROM (glyph
);
4395 to
= LGLYPH_TO (glyph
);
4397 return composition_gstring_put_cache (gstring
, XINT (n
));
4403 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4405 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4406 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4408 VARIATION-SELECTOR is a character code of variation selection
4409 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4410 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4411 (Lisp_Object font_object
, Lisp_Object character
)
4413 unsigned variations
[256];
4418 CHECK_FONT_OBJECT (font_object
);
4419 CHECK_CHARACTER (character
);
4420 font
= XFONT_OBJECT (font_object
);
4421 if (! font
->driver
->get_variation_glyphs
)
4423 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4427 for (i
= 0; i
< 255; i
++)
4430 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4431 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4432 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4439 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4440 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4441 OTF-FEATURES specifies which features to apply in this format:
4442 (SCRIPT LANGSYS GSUB GPOS)
4444 SCRIPT is a symbol specifying a script tag of OpenType,
4445 LANGSYS is a symbol specifying a langsys tag of OpenType,
4446 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4448 If LANGSYS is nil, the default langsys is selected.
4450 The features are applied in the order they appear in the list. The
4451 symbol `*' means to apply all available features not present in this
4452 list, and the remaining features are ignored. For instance, (vatu
4453 pstf * haln) is to apply vatu and pstf in this order, then to apply
4454 all available features other than vatu, pstf, and haln.
4456 The features are applied to the glyphs in the range FROM and TO of
4457 the glyph-string GSTRING-IN.
4459 If some feature is actually applicable, the resulting glyphs are
4460 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4461 this case, the value is the number of produced glyphs.
4463 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4466 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4467 produced in GSTRING-OUT, and the value is nil.
4469 See the documentation of `composition-get-gstring' for the format of
4471 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4473 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4478 check_otf_features (otf_features
);
4479 CHECK_FONT_OBJECT (font_object
);
4480 font
= XFONT_OBJECT (font_object
);
4481 if (! font
->driver
->otf_drive
)
4482 error ("Font backend %s can't drive OpenType GSUB table",
4483 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4484 CHECK_CONS (otf_features
);
4485 CHECK_SYMBOL (XCAR (otf_features
));
4486 val
= XCDR (otf_features
);
4487 CHECK_SYMBOL (XCAR (val
));
4488 val
= XCDR (otf_features
);
4491 len
= check_gstring (gstring_in
);
4492 CHECK_VECTOR (gstring_out
);
4493 CHECK_NATNUM (from
);
4495 CHECK_NATNUM (index
);
4497 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4498 args_out_of_range_3 (from
, to
, make_number (len
));
4499 if (XINT (index
) >= ASIZE (gstring_out
))
4500 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4501 num
= font
->driver
->otf_drive (font
, otf_features
,
4502 gstring_in
, XINT (from
), XINT (to
),
4503 gstring_out
, XINT (index
), 0);
4506 return make_number (num
);
4509 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4511 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4512 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4514 (SCRIPT LANGSYS FEATURE ...)
4515 See the documentation of `font-drive-otf' for more detail.
4517 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4518 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4519 character code corresponding to the glyph or nil if there's no
4520 corresponding character. */)
4521 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4523 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4524 Lisp_Object gstring_in
, gstring_out
, g
;
4525 Lisp_Object alternates
;
4528 if (! font
->driver
->otf_drive
)
4529 error ("Font backend %s can't drive OpenType GSUB table",
4530 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4531 CHECK_CHARACTER (character
);
4532 CHECK_CONS (otf_features
);
4534 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4535 g
= LGSTRING_GLYPH (gstring_in
, 0);
4536 LGLYPH_SET_CHAR (g
, XINT (character
));
4537 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4538 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4539 gstring_out
, 0, 1)) < 0)
4540 gstring_out
= Ffont_make_gstring (font_object
,
4541 make_number (ASIZE (gstring_out
) * 2));
4543 for (i
= 0; i
< num
; i
++)
4545 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4546 int c
= LGLYPH_CHAR (g
);
4547 unsigned code
= LGLYPH_CODE (g
);
4549 alternates
= Fcons (Fcons (make_number (code
),
4550 c
> 0 ? make_number (c
) : Qnil
),
4553 return Fnreverse (alternates
);
4559 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4560 doc
: /* Open FONT-ENTITY. */)
4561 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4564 struct frame
*f
= decode_live_frame (frame
);
4566 CHECK_FONT_ENTITY (font_entity
);
4569 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4572 CHECK_NUMBER_OR_FLOAT (size
);
4574 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4576 isize
= XINT (size
);
4577 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4578 args_out_of_range (font_entity
, size
);
4582 return font_open_entity (f
, font_entity
, isize
);
4585 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4586 doc
: /* Close FONT-OBJECT. */)
4587 (Lisp_Object font_object
, Lisp_Object frame
)
4589 CHECK_FONT_OBJECT (font_object
);
4590 font_close_object (decode_live_frame (frame
), font_object
);
4594 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4595 doc
: /* Return information about FONT-OBJECT.
4596 The value is a vector:
4597 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4600 NAME is the font name, a string (or nil if the font backend doesn't
4603 FILENAME is the font file name, a string (or nil if the font backend
4604 doesn't provide a file name).
4606 PIXEL-SIZE is a pixel size by which the font is opened.
4608 SIZE is a maximum advance width of the font in pixels.
4610 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4613 CAPABILITY is a list whose first element is a symbol representing the
4614 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4615 remaining elements describe the details of the font capability.
4617 If the font is OpenType font, the form of the list is
4618 \(opentype GSUB GPOS)
4619 where GSUB shows which "GSUB" features the font supports, and GPOS
4620 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4621 lists of the format:
4622 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4624 If the font is not OpenType font, currently the length of the form is
4627 SCRIPT is a symbol representing OpenType script tag.
4629 LANGSYS is a symbol representing OpenType langsys tag, or nil
4630 representing the default langsys.
4632 FEATURE is a symbol representing OpenType feature tag.
4634 If the font is not OpenType font, CAPABILITY is nil. */)
4635 (Lisp_Object font_object
)
4637 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4638 Lisp_Object val
= make_uninit_vector (9);
4640 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4641 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4642 ASET (val
, 2, make_number (font
->pixel_size
));
4643 ASET (val
, 3, make_number (font
->max_width
));
4644 ASET (val
, 4, make_number (font
->ascent
));
4645 ASET (val
, 5, make_number (font
->descent
));
4646 ASET (val
, 6, make_number (font
->space_width
));
4647 ASET (val
, 7, make_number (font
->average_width
));
4648 if (font
->driver
->otf_capability
)
4649 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4651 ASET (val
, 8, Qnil
);
4655 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4657 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4658 FROM and TO are positions (integers or markers) specifying a region
4659 of the current buffer, and can be in either order. If the optional
4660 fourth arg OBJECT is not nil, it is a string or a vector containing
4661 the target characters between indices FROM and TO, which are treated
4664 Each element is a vector containing information of a glyph in this format:
4665 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4667 FROM is an index numbers of a character the glyph corresponds to.
4668 TO is the same as FROM.
4669 C is the character of the glyph.
4670 CODE is the glyph-code of C in FONT-OBJECT.
4671 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4672 ADJUSTMENT is always nil.
4673 If FONT-OBJECT doesn't have a glyph for a character,
4674 the corresponding element is nil. */)
4675 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4678 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4680 Lisp_Object
*chars
, vec
;
4685 ptrdiff_t charpos
, bytepos
;
4687 validate_region (&from
, &to
);
4690 len
= XFASTINT (to
) - XFASTINT (from
);
4691 SAFE_ALLOCA_LISP (chars
, len
);
4692 charpos
= XFASTINT (from
);
4693 bytepos
= CHAR_TO_BYTE (charpos
);
4694 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4697 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4698 chars
[i
] = make_number (c
);
4701 else if (STRINGP (object
))
4703 const unsigned char *p
;
4704 ptrdiff_t ifrom
, ito
;
4706 validate_subarray (object
, from
, to
, SCHARS (object
), &ifrom
, &ito
);
4710 SAFE_ALLOCA_LISP (chars
, len
);
4712 if (STRING_MULTIBYTE (object
))
4716 /* Skip IFROM characters from the beginning. */
4717 for (i
= 0; i
< ifrom
; i
++)
4718 c
= STRING_CHAR_ADVANCE (p
);
4720 /* Now fetch an interesting characters. */
4721 for (i
= 0; i
< len
; i
++)
4723 c
= STRING_CHAR_ADVANCE (p
);
4724 chars
[i
] = make_number (c
);
4728 for (i
= 0; i
< len
; i
++)
4729 chars
[i
] = make_number (p
[ifrom
+ i
]);
4731 else if (VECTORP (object
))
4733 ptrdiff_t ifrom
, ito
;
4735 validate_subarray (object
, from
, to
, ASIZE (object
), &ifrom
, &ito
);
4739 for (i
= 0; i
< len
; i
++)
4741 Lisp_Object elt
= AREF (object
, ifrom
+ i
);
4742 CHECK_CHARACTER (elt
);
4744 chars
= aref_addr (object
, ifrom
);
4747 wrong_type_argument (Qarrayp
, object
);
4749 vec
= make_uninit_vector (len
);
4750 for (i
= 0; i
< len
; i
++)
4753 int c
= XFASTINT (chars
[i
]);
4755 struct font_metrics metrics
;
4757 code
= font
->driver
->encode_char (font
, c
);
4758 if (code
== FONT_INVALID_CODE
)
4760 ASET (vec
, i
, Qnil
);
4764 LGLYPH_SET_FROM (g
, i
);
4765 LGLYPH_SET_TO (g
, i
);
4766 LGLYPH_SET_CHAR (g
, c
);
4767 LGLYPH_SET_CODE (g
, code
);
4768 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4769 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4770 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4771 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4772 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4773 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4776 if (! VECTORP (object
))
4781 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4782 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4783 FONT is a font-spec, font-entity, or font-object. */)
4784 (Lisp_Object spec
, Lisp_Object font
)
4786 CHECK_FONT_SPEC (spec
);
4789 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4792 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4793 doc
: /* Return a font-object for displaying a character at POSITION.
4794 Optional second arg WINDOW, if non-nil, is a window displaying
4795 the current buffer. It defaults to the currently selected window.
4796 Optional third arg STRING, if non-nil, is a string containing the target
4797 character at index specified by POSITION. */)
4798 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4800 struct window
*w
= decode_live_window (window
);
4804 if (XBUFFER (w
->contents
) != current_buffer
)
4805 error ("Specified window is not displaying the current buffer");
4806 CHECK_NUMBER_COERCE_MARKER (position
);
4807 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4808 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4812 CHECK_NUMBER (position
);
4813 CHECK_STRING (string
);
4814 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4815 args_out_of_range (string
, position
);
4818 return font_at (-1, XINT (position
), NULL
, w
, string
);
4822 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4823 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4824 The value is a number of glyphs drawn.
4825 Type C-l to recover what previously shown. */)
4826 (Lisp_Object font_object
, Lisp_Object string
)
4828 Lisp_Object frame
= selected_frame
;
4829 struct frame
*f
= XFRAME (frame
);
4835 CHECK_FONT_GET_OBJECT (font_object
, font
);
4836 CHECK_STRING (string
);
4837 len
= SCHARS (string
);
4838 code
= alloca (sizeof (unsigned) * len
);
4839 for (i
= 0; i
< len
; i
++)
4841 Lisp_Object ch
= Faref (string
, make_number (i
));
4845 code
[i
] = font
->driver
->encode_char (font
, c
);
4846 if (code
[i
] == FONT_INVALID_CODE
)
4849 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4851 if (font
->driver
->prepare_face
)
4852 font
->driver
->prepare_face (f
, face
);
4853 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4854 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4855 if (font
->driver
->done_face
)
4856 font
->driver
->done_face (f
, face
);
4858 return make_number (len
);
4862 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4863 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4864 If FRAME is omitted or nil, use the selected frame. */)
4867 #ifdef HAVE_WINDOW_SYSTEM
4868 struct frame
*f
= decode_live_frame (frame
);
4870 if (FRAME_WINDOW_P (f
))
4871 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4877 #endif /* FONT_DEBUG */
4879 #ifdef HAVE_WINDOW_SYSTEM
4881 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4882 doc
: /* Return information about a font named NAME on frame FRAME.
4883 If FRAME is omitted or nil, use the selected frame.
4885 The returned value is a vector:
4886 [ OPENED-NAME FULL-NAME SIZE HEIGHT BASELINE-OFFSET RELATIVE-COMPOSE
4887 DEFAULT-ASCENT MAX-WIDTH ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4890 OPENED-NAME is the name used for opening the font,
4891 FULL-NAME is the full name of the font,
4892 SIZE is the pixelsize of the font,
4893 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4894 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4895 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4896 how to compose characters,
4897 MAX-WIDTH is the maximum advance width of the font,
4898 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font
4900 FILENAME is the font file name, a string (or nil if the font backend
4901 doesn't provide a file name).
4902 CAPABILITY is a list whose first element is a symbol representing the
4903 font format, one of x, opentype, truetype, type1, pcf, or bdf.
4904 The remaining elements describe the details of the font capabilities,
4907 If the font is OpenType font, the form of the list is
4908 \(opentype GSUB GPOS)
4909 where GSUB shows which "GSUB" features the font supports, and GPOS
4910 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4912 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4915 SCRIPT is a symbol representing OpenType script tag.
4916 LANGSYS is a symbol representing OpenType langsys tag, or nil
4917 representing the default langsys.
4918 FEATURE is a symbol representing OpenType feature tag.
4920 If the font is not an OpenType font, there are no elements
4921 in CAPABILITY except the font format symbol.
4923 If the named font is not yet loaded, return nil. */)
4924 (Lisp_Object name
, Lisp_Object frame
)
4929 Lisp_Object font_object
;
4932 CHECK_STRING (name
);
4933 f
= decode_window_system_frame (frame
);
4937 int fontset
= fs_query_fontset (name
, 0);
4940 name
= fontset_ascii (fontset
);
4941 font_object
= font_open_by_name (f
, name
);
4943 else if (FONT_OBJECT_P (name
))
4945 else if (FONT_ENTITY_P (name
))
4946 font_object
= font_open_entity (f
, name
, 0);
4949 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4950 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4952 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4954 if (NILP (font_object
))
4956 font
= XFONT_OBJECT (font_object
);
4958 info
= make_uninit_vector (14);
4959 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4960 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4961 ASET (info
, 2, make_number (font
->pixel_size
));
4962 ASET (info
, 3, make_number (font
->height
));
4963 ASET (info
, 4, make_number (font
->baseline_offset
));
4964 ASET (info
, 5, make_number (font
->relative_compose
));
4965 ASET (info
, 6, make_number (font
->default_ascent
));
4966 ASET (info
, 7, make_number (font
->max_width
));
4967 ASET (info
, 8, make_number (font
->ascent
));
4968 ASET (info
, 9, make_number (font
->descent
));
4969 ASET (info
, 10, make_number (font
->space_width
));
4970 ASET (info
, 11, make_number (font
->average_width
));
4971 ASET (info
, 12, AREF (font_object
, FONT_FILE_INDEX
));
4972 if (font
->driver
->otf_capability
)
4973 ASET (info
, 13, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4975 ASET (info
, 13, Qnil
);
4978 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4979 close it now. Perhaps, we should manage font-objects
4980 by `reference-count'. */
4981 font_close_object (f
, font_object
);
4988 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
4991 build_style_table (const struct table_entry
*entry
, int nelement
)
4994 Lisp_Object table
, elt
;
4996 table
= make_uninit_vector (nelement
);
4997 for (i
= 0; i
< nelement
; i
++)
4999 for (j
= 0; entry
[i
].names
[j
]; j
++);
5000 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5001 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5002 for (j
= 0; entry
[i
].names
[j
]; j
++)
5003 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5004 ASET (table
, i
, elt
);
5009 /* The deferred font-log data of the form [ACTION ARG RESULT].
5010 If ACTION is not nil, that is added to the log when font_add_log is
5011 called next time. At that time, ACTION is set back to nil. */
5012 static Lisp_Object Vfont_log_deferred
;
5014 /* Prepend the font-related logging data in Vfont_log if it is not
5015 `t'. ACTION describes a kind of font-related action (e.g. listing,
5016 opening), ARG is the argument for the action, and RESULT is the
5017 result of the action. */
5019 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5024 if (EQ (Vfont_log
, Qt
))
5026 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5028 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
5030 ASET (Vfont_log_deferred
, 0, Qnil
);
5031 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5032 AREF (Vfont_log_deferred
, 2));
5037 Lisp_Object tail
, elt
;
5038 AUTO_STRING (equal
, "=");
5040 val
= Ffont_xlfd_name (arg
, Qt
);
5041 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5045 if (EQ (XCAR (elt
), QCscript
)
5046 && SYMBOLP (XCDR (elt
)))
5047 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5048 concat2 (equal
, SYMBOL_NAME (XCDR (elt
))));
5049 else if (EQ (XCAR (elt
), QClang
)
5050 && SYMBOLP (XCDR (elt
)))
5051 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5052 concat2 (equal
, SYMBOL_NAME (XCDR (elt
))));
5053 else if (EQ (XCAR (elt
), QCotf
)
5054 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5055 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5056 concat2 (equal
, SYMBOL_NAME (XCAR (XCDR (elt
)))));
5062 && VECTORP (XCAR (result
))
5063 && ASIZE (XCAR (result
)) > 0
5064 && FONTP (AREF (XCAR (result
), 0)))
5065 result
= font_vconcat_entity_vectors (result
);
5068 val
= Ffont_xlfd_name (result
, Qt
);
5069 if (! FONT_SPEC_P (result
))
5071 AUTO_STRING (colon
, ":");
5072 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5077 else if (CONSP (result
))
5080 result
= Fcopy_sequence (result
);
5081 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5085 val
= Ffont_xlfd_name (val
, Qt
);
5086 XSETCAR (tail
, val
);
5089 else if (VECTORP (result
))
5091 result
= Fcopy_sequence (result
);
5092 for (i
= 0; i
< ASIZE (result
); i
++)
5094 val
= AREF (result
, i
);
5096 val
= Ffont_xlfd_name (val
, Qt
);
5097 ASET (result
, i
, val
);
5100 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5103 /* Record a font-related logging data to be added to Vfont_log when
5104 font_add_log is called next time. ACTION, ARG, RESULT are the same
5108 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5110 if (EQ (Vfont_log
, Qt
))
5112 ASET (Vfont_log_deferred
, 0, build_string (action
));
5113 ASET (Vfont_log_deferred
, 1, arg
);
5114 ASET (Vfont_log_deferred
, 2, result
);
5120 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5121 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5122 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5123 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5124 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5125 /* Note that the other elements in sort_shift_bits are not used. */
5127 staticpro (&font_charset_alist
);
5128 font_charset_alist
= Qnil
;
5130 DEFSYM (Qopentype
, "opentype");
5132 /* Important character set symbols. */
5133 DEFSYM (Qascii_0
, "ascii-0");
5134 DEFSYM (Qiso8859_1
, "iso8859-1");
5135 DEFSYM (Qiso10646_1
, "iso10646-1");
5136 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5137 DEFSYM (Qunicode_sip
, "unicode-sip");
5139 /* Unicode category `Cf'. */
5142 /* Symbols representing keys of font extra info. */
5143 DEFSYM (QCotf
, ":otf");
5144 DEFSYM (QClang
, ":lang");
5145 DEFSYM (QCscript
, ":script");
5146 DEFSYM (QCantialias
, ":antialias");
5147 DEFSYM (QCfoundry
, ":foundry");
5148 DEFSYM (QCadstyle
, ":adstyle");
5149 DEFSYM (QCregistry
, ":registry");
5150 DEFSYM (QCspacing
, ":spacing");
5151 DEFSYM (QCdpi
, ":dpi");
5152 DEFSYM (QCscalable
, ":scalable");
5153 DEFSYM (QCavgwidth
, ":avgwidth");
5154 DEFSYM (QCfont_entity
, ":font-entity");
5155 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5157 /* Symbols representing values of font spacing property. */
5163 /* Special ADSTYLE properties to avoid fonts used for Latin
5164 characters; used in xfont.c and ftfont.c. */
5168 DEFSYM (QCuser_spec
, "user-spec");
5170 staticpro (&scratch_font_spec
);
5171 scratch_font_spec
= Ffont_spec (0, NULL
);
5172 staticpro (&scratch_font_prefer
);
5173 scratch_font_prefer
= Ffont_spec (0, NULL
);
5175 staticpro (&Vfont_log_deferred
);
5176 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5180 staticpro (&otf_list
);
5182 #endif /* HAVE_LIBOTF */
5186 defsubr (&Sfont_spec
);
5187 defsubr (&Sfont_get
);
5188 #ifdef HAVE_WINDOW_SYSTEM
5189 defsubr (&Sfont_face_attributes
);
5191 defsubr (&Sfont_put
);
5192 defsubr (&Slist_fonts
);
5193 defsubr (&Sfont_family_list
);
5194 defsubr (&Sfind_font
);
5195 defsubr (&Sfont_xlfd_name
);
5196 defsubr (&Sclear_font_cache
);
5197 defsubr (&Sfont_shape_gstring
);
5198 defsubr (&Sfont_variation_glyphs
);
5200 defsubr (&Sfont_drive_otf
);
5201 defsubr (&Sfont_otf_alternates
);
5205 defsubr (&Sopen_font
);
5206 defsubr (&Sclose_font
);
5207 defsubr (&Squery_font
);
5208 defsubr (&Sfont_get_glyphs
);
5209 defsubr (&Sfont_match_p
);
5210 defsubr (&Sfont_at
);
5212 defsubr (&Sdraw_string
);
5214 defsubr (&Sframe_font_cache
);
5215 #endif /* FONT_DEBUG */
5216 #ifdef HAVE_WINDOW_SYSTEM
5217 defsubr (&Sfont_info
);
5220 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5222 Alist of fontname patterns vs the corresponding encoding and repertory info.
5223 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5224 where ENCODING is a charset or a char-table,
5225 and REPERTORY is a charset, a char-table, or nil.
5227 If ENCODING and REPERTORY are the same, the element can have the form
5228 \(REGEXP . ENCODING).
5230 ENCODING is for converting a character to a glyph code of the font.
5231 If ENCODING is a charset, encoding a character by the charset gives
5232 the corresponding glyph code. If ENCODING is a char-table, looking up
5233 the table by a character gives the corresponding glyph code.
5235 REPERTORY specifies a repertory of characters supported by the font.
5236 If REPERTORY is a charset, all characters belonging to the charset are
5237 supported. If REPERTORY is a char-table, all characters who have a
5238 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5239 gets the repertory information by an opened font and ENCODING. */);
5240 Vfont_encoding_alist
= Qnil
;
5242 /* FIXME: These 3 vars are not quite what they appear: setq on them
5243 won't have any effect other than disconnect them from the style
5244 table used by the font display code. So we make them read-only,
5245 to avoid this confusing situation. */
5247 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5248 doc
: /* Vector of valid font weight values.
5249 Each element has the form:
5250 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5251 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5252 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5253 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5255 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5256 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5257 See `font-weight-table' for the format of the vector. */);
5258 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5259 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5261 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5262 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5263 See `font-weight-table' for the format of the vector. */);
5264 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5265 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5267 staticpro (&font_style_table
);
5268 font_style_table
= make_uninit_vector (3);
5269 ASET (font_style_table
, 0, Vfont_weight_table
);
5270 ASET (font_style_table
, 1, Vfont_slant_table
);
5271 ASET (font_style_table
, 2, Vfont_width_table
);
5273 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5274 *Logging list of font related actions and results.
5275 The value t means to suppress the logging.
5276 The initial value is set to nil if the environment variable
5277 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5280 #ifdef HAVE_WINDOW_SYSTEM
5281 #ifdef HAVE_FREETYPE
5283 #ifdef HAVE_X_WINDOWS
5288 #endif /* HAVE_XFT */
5289 #endif /* HAVE_X_WINDOWS */
5290 #else /* not HAVE_FREETYPE */
5291 #ifdef HAVE_X_WINDOWS
5293 #endif /* HAVE_X_WINDOWS */
5294 #endif /* not HAVE_FREETYPE */
5297 #endif /* HAVE_BDFFONT */
5300 #endif /* HAVE_NTGUI */
5301 #endif /* HAVE_WINDOW_SYSTEM */
5307 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;