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 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2140 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2142 /* We use the higher 6-bit for the actual size difference. The
2143 lowest bit is set if the DPI is different. */
2145 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2146 EMACS_INT entity_size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
2148 if (CONSP (Vface_font_rescale_alist
))
2149 pixel_size
*= font_rescale_ratio (entity
);
2150 if (pixel_size
* 2 < entity_size
|| entity_size
* 2 < pixel_size
)
2151 /* This size is wrong by more than a factor 2: reject it! */
2153 diff
= eabs (pixel_size
- entity_size
) << 1;
2154 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2155 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2157 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2158 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2160 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2167 /* Concatenate all elements of LIST into one vector. LIST is a list
2168 of font-entity vectors. */
2171 font_vconcat_entity_vectors (Lisp_Object list
)
2173 EMACS_INT nargs
= XFASTINT (Flength (list
));
2176 SAFE_ALLOCA_LISP (args
, nargs
);
2179 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2180 args
[i
] = XCAR (list
);
2181 Lisp_Object result
= Fvconcat (nargs
, args
);
2187 /* The structure for elements being sorted by qsort. */
2188 struct font_sort_data
2191 int font_driver_preference
;
2196 /* The comparison function for qsort. */
2199 font_compare (const void *d1
, const void *d2
)
2201 const struct font_sort_data
*data1
= d1
;
2202 const struct font_sort_data
*data2
= d2
;
2204 if (data1
->score
< data2
->score
)
2206 else if (data1
->score
> data2
->score
)
2208 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2212 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2213 If PREFER specifies a point-size, calculate the corresponding
2214 pixel-size from QCdpi property of PREFER or from the Y-resolution
2215 of FRAME before sorting.
2217 If BEST-ONLY is nonzero, return the best matching entity (that
2218 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2219 if BEST-ONLY is negative). Otherwise, return the sorted result as
2220 a single vector of font-entities.
2222 This function does no optimization for the case that the total
2223 number of elements is 1. The caller should avoid calling this in
2227 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2228 struct frame
*f
, int best_only
)
2230 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2232 struct font_sort_data
*data
;
2233 unsigned best_score
;
2234 Lisp_Object best_entity
;
2235 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2238 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2239 prefer_prop
[i
] = AREF (prefer
, i
);
2240 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2241 prefer_prop
[FONT_SIZE_INDEX
]
2242 = make_number (font_pixel_size (f
, prefer
));
2244 if (NILP (XCDR (list
)))
2246 /* What we have to take care of is this single vector. */
2248 maxlen
= ASIZE (vec
);
2252 /* We don't have to perform sort, so there's no need of creating
2253 a single vector. But, we must find the length of the longest
2256 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2257 if (maxlen
< ASIZE (XCAR (tail
)))
2258 maxlen
= ASIZE (XCAR (tail
));
2262 /* We have to create a single vector to sort it. */
2263 vec
= font_vconcat_entity_vectors (list
);
2264 maxlen
= ASIZE (vec
);
2267 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2268 best_score
= 0xFFFFFFFF;
2271 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2273 int font_driver_preference
= 0;
2274 Lisp_Object current_font_driver
;
2280 /* We are sure that the length of VEC > 0. */
2281 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2282 /* Score the elements. */
2283 for (i
= 0; i
< len
; i
++)
2285 data
[i
].entity
= AREF (vec
, i
);
2287 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2289 ? font_score (data
[i
].entity
, prefer_prop
)
2291 if (best_only
&& best_score
> data
[i
].score
)
2293 best_score
= data
[i
].score
;
2294 best_entity
= data
[i
].entity
;
2295 if (best_score
== 0)
2298 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2300 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2301 font_driver_preference
++;
2303 data
[i
].font_driver_preference
= font_driver_preference
;
2306 /* Sort if necessary. */
2309 qsort (data
, len
, sizeof *data
, font_compare
);
2310 for (i
= 0; i
< len
; i
++)
2311 ASET (vec
, i
, data
[i
].entity
);
2320 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2325 /* API of Font Service Layer. */
2327 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2328 sort_shift_bits. Finternal_set_font_selection_order calls this
2329 function with font_sort_order after setting up it. */
2332 font_update_sort_order (int *order
)
2336 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2338 int xlfd_idx
= order
[i
];
2340 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2341 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2342 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2343 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2344 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2345 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2347 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2352 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2353 Lisp_Object features
, Lisp_Object table
)
2358 table
= assq_no_quit (script
, table
);
2361 table
= XCDR (table
);
2362 if (! NILP (langsys
))
2364 table
= assq_no_quit (langsys
, table
);
2370 val
= assq_no_quit (Qnil
, table
);
2372 table
= XCAR (table
);
2376 table
= XCDR (table
);
2377 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2379 if (NILP (XCAR (features
)))
2384 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2390 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2393 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2395 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2397 script
= XCAR (spec
);
2401 langsys
= XCAR (spec
);
2412 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2413 XCAR (otf_capability
)))
2415 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2416 XCDR (otf_capability
)))
2423 /* Check if FONT (font-entity or font-object) matches with the font
2424 specification SPEC. */
2427 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2429 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2430 Lisp_Object extra
, font_extra
;
2433 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2434 if (! NILP (AREF (spec
, i
))
2435 && ! NILP (AREF (font
, i
))
2436 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2438 props
= XFONT_SPEC (spec
)->props
;
2439 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2441 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2442 prop
[i
] = AREF (spec
, i
);
2443 prop
[FONT_SIZE_INDEX
]
2444 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2448 if (font_score (font
, props
) > 0)
2450 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2451 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2452 for (; CONSP (extra
); extra
= XCDR (extra
))
2454 Lisp_Object key
= XCAR (XCAR (extra
));
2455 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2457 if (EQ (key
, QClang
))
2459 val2
= assq_no_quit (key
, font_extra
);
2468 if (NILP (Fmemq (val
, val2
)))
2473 ? NILP (Fmemq (val
, XCDR (val2
)))
2477 else if (EQ (key
, QCscript
))
2479 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2485 /* All characters in the list must be supported. */
2486 for (; CONSP (val2
); val2
= XCDR (val2
))
2488 if (! CHARACTERP (XCAR (val2
)))
2490 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2491 == FONT_INVALID_CODE
)
2495 else if (VECTORP (val2
))
2497 /* At most one character in the vector must be supported. */
2498 for (i
= 0; i
< ASIZE (val2
); i
++)
2500 if (! CHARACTERP (AREF (val2
, i
)))
2502 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2503 != FONT_INVALID_CODE
)
2506 if (i
== ASIZE (val2
))
2511 else if (EQ (key
, QCotf
))
2515 if (! FONT_OBJECT_P (font
))
2517 fontp
= XFONT_OBJECT (font
);
2518 if (! fontp
->driver
->otf_capability
)
2520 val2
= fontp
->driver
->otf_capability (fontp
);
2521 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2532 Each font backend has the callback function get_cache, and it
2533 returns a cons cell of which cdr part can be freely used for
2534 caching fonts. The cons cell may be shared by multiple frames
2535 and/or multiple font drivers. So, we arrange the cdr part as this:
2537 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2539 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2540 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2541 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2543 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2544 static void font_finish_cache (struct frame
*, struct font_driver
*);
2545 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2546 static void font_clear_cache (struct frame
*, Lisp_Object
,
2547 struct font_driver
*);
2550 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2552 Lisp_Object cache
, val
;
2554 cache
= driver
->get_cache (f
);
2556 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2560 val
= list2 (driver
->type
, make_number (1));
2561 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2565 val
= XCDR (XCAR (val
));
2566 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2572 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2574 Lisp_Object cache
, val
, tmp
;
2577 cache
= driver
->get_cache (f
);
2579 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2580 cache
= val
, val
= XCDR (val
);
2581 eassert (! NILP (val
));
2582 tmp
= XCDR (XCAR (val
));
2583 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2584 if (XINT (XCAR (tmp
)) == 0)
2586 font_clear_cache (f
, XCAR (val
), driver
);
2587 XSETCDR (cache
, XCDR (val
));
2593 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2595 Lisp_Object val
= driver
->get_cache (f
);
2596 Lisp_Object type
= driver
->type
;
2598 eassert (CONSP (val
));
2599 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2600 eassert (CONSP (val
));
2601 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2602 val
= XCDR (XCAR (val
));
2608 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2610 Lisp_Object tail
, elt
;
2614 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2615 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2618 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2619 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2622 eassert (VECTORP (elt
));
2623 for (i
= 0; i
< ASIZE (elt
); i
++)
2625 entity
= AREF (elt
, i
);
2627 if (FONT_ENTITY_P (entity
)
2628 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2630 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2632 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2634 Lisp_Object val
= XCAR (objlist
);
2635 struct font
*font
= XFONT_OBJECT (val
);
2637 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2639 eassert (font
&& driver
== font
->driver
);
2640 driver
->close (font
);
2643 if (driver
->free_entity
)
2644 driver
->free_entity (entity
);
2649 XSETCDR (cache
, Qnil
);
2653 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2655 /* Check each font-entity in VEC, and return a list of font-entities
2656 that satisfy these conditions:
2657 (1) matches with SPEC and SIZE if SPEC is not nil, and
2658 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2662 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2664 Lisp_Object entity
, val
;
2665 enum font_property_index prop
;
2668 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2670 entity
= AREF (vec
, i
);
2671 if (! NILP (Vface_ignored_fonts
))
2675 Lisp_Object tail
, regexp
;
2677 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2680 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2682 regexp
= XCAR (tail
);
2683 if (STRINGP (regexp
)
2684 && fast_c_string_match_ignore_case (regexp
, name
,
2694 val
= Fcons (entity
, val
);
2697 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2698 if (INTEGERP (AREF (spec
, prop
))
2699 && ((XINT (AREF (spec
, prop
)) >> 8)
2700 != (XINT (AREF (entity
, prop
)) >> 8)))
2701 prop
= FONT_SPEC_MAX
;
2702 if (prop
< FONT_SPEC_MAX
2704 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2706 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2708 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2709 prop
= FONT_SPEC_MAX
;
2711 if (prop
< FONT_SPEC_MAX
2712 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2713 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2714 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2715 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2716 prop
= FONT_SPEC_MAX
;
2717 if (prop
< FONT_SPEC_MAX
2718 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2719 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2720 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2721 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2722 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2723 prop
= FONT_SPEC_MAX
;
2724 if (prop
< FONT_SPEC_MAX
)
2725 val
= Fcons (entity
, val
);
2727 return (Fvconcat (1, &val
));
2731 /* Return a list of vectors of font-entities matching with SPEC on
2732 FRAME. Each elements in the list is a vector of entities from the
2733 same font-driver. */
2736 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2738 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2739 Lisp_Object ftype
, val
;
2740 Lisp_Object list
= Qnil
;
2742 bool need_filtering
= 0;
2745 eassert (FONT_SPEC_P (spec
));
2747 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2748 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2749 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2750 size
= font_pixel_size (f
, spec
);
2754 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2755 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2756 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2757 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2758 if (i
!= FONT_SPACING_INDEX
)
2760 ASET (scratch_font_spec
, i
, Qnil
);
2761 if (! NILP (AREF (spec
, i
)))
2764 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2765 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2767 for (; driver_list
; driver_list
= driver_list
->next
)
2769 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2771 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2773 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2774 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2779 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2782 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2784 val
= Fvconcat (1, &val
);
2785 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2786 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2789 if (VECTORP (val
) && ASIZE (val
) > 0
2791 || ! NILP (Vface_ignored_fonts
)))
2792 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2793 if (VECTORP (val
) && ASIZE (val
) > 0)
2794 list
= Fcons (val
, list
);
2797 list
= Fnreverse (list
);
2798 FONT_ADD_LOG ("list", spec
, list
);
2803 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2804 nil, is an array of face's attributes, which specifies preferred
2805 font-related attributes. */
2808 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2810 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2811 Lisp_Object ftype
, size
, entity
;
2812 Lisp_Object work
= copy_font_spec (spec
);
2814 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2815 size
= AREF (spec
, FONT_SIZE_INDEX
);
2818 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2819 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2820 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2821 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2824 for (; driver_list
; driver_list
= driver_list
->next
)
2826 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2828 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2830 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2831 entity
= assoc_no_quit (work
, XCDR (cache
));
2833 entity
= AREF (XCDR (entity
), 0);
2836 entity
= driver_list
->driver
->match (f
, work
);
2839 Lisp_Object copy
= copy_font_spec (work
);
2840 Lisp_Object match
= Fvector (1, &entity
);
2842 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2843 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2846 if (! NILP (entity
))
2849 FONT_ADD_LOG ("match", work
, entity
);
2854 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2855 opened font object. */
2858 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2860 struct font_driver_list
*driver_list
;
2861 Lisp_Object objlist
, size
, val
, font_object
;
2863 int min_width
, height
, psize
;
2865 eassert (FONT_ENTITY_P (entity
));
2866 size
= AREF (entity
, FONT_SIZE_INDEX
);
2867 if (XINT (size
) != 0)
2868 pixel_size
= XINT (size
);
2870 val
= AREF (entity
, FONT_TYPE_INDEX
);
2871 for (driver_list
= f
->font_driver_list
;
2872 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2873 driver_list
= driver_list
->next
);
2877 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2878 objlist
= XCDR (objlist
))
2880 Lisp_Object fn
= XCAR (objlist
);
2881 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2882 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2884 if (driver_list
->driver
->cached_font_ok
== NULL
2885 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2890 /* We always open a font of manageable size; i.e non-zero average
2891 width and height. */
2892 for (psize
= pixel_size
; ; psize
++)
2894 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2895 if (NILP (font_object
))
2897 font
= XFONT_OBJECT (font_object
);
2898 if (font
->average_width
> 0 && font
->height
> 0)
2901 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2902 FONT_ADD_LOG ("open", entity
, font_object
);
2903 ASET (entity
, FONT_OBJLIST_INDEX
,
2904 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2906 font
= XFONT_OBJECT (font_object
);
2907 min_width
= (font
->min_width
? font
->min_width
2908 : font
->average_width
? font
->average_width
2909 : font
->space_width
? font
->space_width
2912 int font_ascent
, font_descent
;
2913 get_font_ascent_descent (font
, &font_ascent
, &font_descent
);
2914 height
= font_ascent
+ font_descent
;
2917 #ifdef HAVE_WINDOW_SYSTEM
2918 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2919 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2921 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2922 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2923 f
->fonts_changed
= 1;
2927 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2928 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2929 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2930 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2938 /* Close FONT_OBJECT that is opened on frame F. */
2941 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2943 struct font
*font
= XFONT_OBJECT (font_object
);
2945 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2946 /* Already closed. */
2948 FONT_ADD_LOG ("close", font_object
, Qnil
);
2949 font
->driver
->close (font
);
2950 #ifdef HAVE_WINDOW_SYSTEM
2951 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2952 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2957 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2958 FONT is a font-entity and it must be opened to check. */
2961 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2965 if (FONT_ENTITY_P (font
))
2967 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2968 struct font_driver_list
*driver_list
;
2970 for (driver_list
= f
->font_driver_list
;
2971 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2972 driver_list
= driver_list
->next
);
2975 if (! driver_list
->driver
->has_char
)
2977 return driver_list
->driver
->has_char (font
, c
);
2980 eassert (FONT_OBJECT_P (font
));
2981 fontp
= XFONT_OBJECT (font
);
2982 if (fontp
->driver
->has_char
)
2984 int result
= fontp
->driver
->has_char (font
, c
);
2989 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2993 /* Return the glyph ID of FONT_OBJECT for character C. */
2996 font_encode_char (Lisp_Object font_object
, int c
)
3000 eassert (FONT_OBJECT_P (font_object
));
3001 font
= XFONT_OBJECT (font_object
);
3002 return font
->driver
->encode_char (font
, c
);
3006 /* Return the name of FONT_OBJECT. */
3009 font_get_name (Lisp_Object font_object
)
3011 eassert (FONT_OBJECT_P (font_object
));
3012 return AREF (font_object
, FONT_NAME_INDEX
);
3016 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3017 could not be parsed by font_parse_name, return Qnil. */
3020 font_spec_from_name (Lisp_Object font_name
)
3022 Lisp_Object spec
= Ffont_spec (0, NULL
);
3024 CHECK_STRING (font_name
);
3025 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
3027 font_put_extra (spec
, QCname
, font_name
);
3028 font_put_extra (spec
, QCuser_spec
, font_name
);
3034 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3036 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3041 if (! NILP (Ffont_get (font
, QCname
)))
3043 font
= copy_font_spec (font
);
3044 font_put_extra (font
, QCname
, Qnil
);
3047 if (NILP (AREF (font
, prop
))
3048 && prop
!= FONT_FAMILY_INDEX
3049 && prop
!= FONT_FOUNDRY_INDEX
3050 && prop
!= FONT_WIDTH_INDEX
3051 && prop
!= FONT_SIZE_INDEX
)
3053 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3054 font
= copy_font_spec (font
);
3055 ASET (font
, prop
, Qnil
);
3056 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3058 if (prop
== FONT_FAMILY_INDEX
)
3060 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3061 /* If we are setting the font family, we must also clear
3062 FONT_WIDTH_INDEX to avoid rejecting families that lack
3063 support for some widths. */
3064 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3066 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3067 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3068 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3069 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3070 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3071 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3073 else if (prop
== FONT_SIZE_INDEX
)
3075 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3076 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3077 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3079 else if (prop
== FONT_WIDTH_INDEX
)
3080 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3081 attrs
[LFACE_FONT_INDEX
] = font
;
3084 /* Select a font from ENTITIES (list of font-entity vectors) that
3085 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3088 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3089 Lisp_Object
*attrs
, int pixel_size
, int c
)
3091 Lisp_Object font_entity
;
3095 if (NILP (XCDR (entities
))
3096 && ASIZE (XCAR (entities
)) == 1)
3098 font_entity
= AREF (XCAR (entities
), 0);
3099 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3104 /* Sort fonts by properties specified in ATTRS. */
3105 prefer
= scratch_font_prefer
;
3107 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3108 ASET (prefer
, i
, Qnil
);
3109 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3111 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3113 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3114 ASET (prefer
, i
, AREF (face_font
, i
));
3116 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3117 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3118 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3119 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3120 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3121 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3122 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3124 return font_sort_entities (entities
, prefer
, f
, c
);
3127 /* Return a font-entity that satisfies SPEC and is the best match for
3128 face's font related attributes in ATTRS. C, if not negative, is a
3129 character that the entity must support. */
3132 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3135 Lisp_Object entities
, val
;
3136 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3141 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3142 if (NILP (registry
[0]))
3144 registry
[0] = DEFAULT_ENCODING
;
3145 registry
[1] = Qascii_0
;
3146 registry
[2] = zero_vector
;
3149 registry
[1] = zero_vector
;
3151 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3153 struct charset
*encoding
, *repertory
;
3155 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3156 &encoding
, &repertory
) < 0)
3159 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3161 else if (c
> encoding
->max_char
)
3165 work
= copy_font_spec (spec
);
3166 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3167 pixel_size
= font_pixel_size (f
, spec
);
3168 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3170 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3172 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3176 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3177 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3178 if (! NILP (foundry
[0]))
3179 foundry
[1] = zero_vector
;
3180 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3182 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3183 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3185 foundry
[2] = zero_vector
;
3188 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3190 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3191 if (! NILP (adstyle
[0]))
3192 adstyle
[1] = zero_vector
;
3193 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3195 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3197 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3199 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3201 adstyle
[2] = zero_vector
;
3204 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3207 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3210 val
= AREF (work
, FONT_FAMILY_INDEX
);
3211 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3213 val
= attrs
[LFACE_FAMILY_INDEX
];
3214 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3216 Lisp_Object familybuf
[3];
3221 family
[1] = zero_vector
; /* terminator. */
3226 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3228 if (! NILP (alters
))
3230 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3231 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3232 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3233 family
[i
] = XCAR (alters
);
3234 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3236 family
[i
] = zero_vector
;
3243 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3245 family
[i
] = zero_vector
;
3249 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3251 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3252 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3254 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3255 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3257 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3258 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3260 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3261 entities
= font_list_entities (f
, work
);
3262 if (! NILP (entities
))
3264 val
= font_select_entity (f
, entities
,
3265 attrs
, pixel_size
, c
);
3283 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3287 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3288 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3289 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3292 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3293 size
= font_pixel_size (f
, spec
);
3297 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3298 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3301 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3302 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3303 eassert (INTEGERP (height
));
3308 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3312 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3313 size
= (NUMBERP (ffsize
)
3314 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3318 size
*= font_rescale_ratio (entity
);
3321 return font_open_entity (f
, entity
, size
);
3325 /* Find a font that satisfies SPEC and is the best match for
3326 face's attributes in ATTRS on FRAME, and return the opened
3330 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3332 Lisp_Object entity
, name
;
3334 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3337 /* No font is listed for SPEC, but each font-backend may have
3338 different criteria about "font matching". So, try it. */
3339 entity
= font_matching_entity (f
, attrs
, spec
);
3343 /* Don't lose the original name that was put in initially. We need
3344 it to re-apply the font when font parameters (like hinting or dpi) have
3346 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3349 name
= Ffont_get (spec
, QCuser_spec
);
3350 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3356 /* Make FACE on frame F ready to use the font opened for FACE. */
3359 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3361 if (face
->font
->driver
->prepare_face
)
3362 face
->font
->driver
->prepare_face (f
, face
);
3366 /* Make FACE on frame F stop using the font opened for FACE. */
3369 font_done_for_face (struct frame
*f
, struct face
*face
)
3371 if (face
->font
->driver
->done_face
)
3372 face
->font
->driver
->done_face (f
, face
);
3376 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3377 font is found, return Qnil. */
3380 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3382 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3384 /* We set up the default font-related attributes of a face to prefer
3386 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3387 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3388 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3390 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3392 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3394 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3396 return font_load_for_lface (f
, attrs
, spec
);
3400 /* Open a font that matches NAME on frame F. If no proper font is
3401 found, return Qnil. */
3404 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3406 Lisp_Object spec
= CALLN (Ffont_spec
, QCname
, name
);
3407 Lisp_Object ret
= font_open_by_spec (f
, spec
);
3408 /* Do not lose name originally put in. */
3410 font_put_extra (ret
, QCuser_spec
, name
);
3416 /* Register font-driver DRIVER. This function is used in two ways.
3418 The first is with frame F non-NULL. In this case, make DRIVER
3419 available (but not yet activated) on F. All frame creators
3420 (e.g. Fx_create_frame) must call this function at least once with
3421 an available font-driver.
3423 The second is with frame F NULL. In this case, DRIVER is globally
3424 registered in the variable `font_driver_list'. All font-driver
3425 implementations must call this function in its syms_of_XXXX
3426 (e.g. syms_of_xfont). */
3429 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3431 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3432 struct font_driver_list
*prev
, *list
;
3434 #ifdef HAVE_WINDOW_SYSTEM
3435 if (f
&& ! driver
->draw
)
3436 error ("Unusable font driver for a frame: %s",
3437 SDATA (SYMBOL_NAME (driver
->type
)));
3438 #endif /* HAVE_WINDOW_SYSTEM */
3440 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3441 if (EQ (list
->driver
->type
, driver
->type
))
3442 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3444 list
= xmalloc (sizeof *list
);
3446 list
->driver
= driver
;
3451 f
->font_driver_list
= list
;
3453 font_driver_list
= list
;
3459 free_font_driver_list (struct frame
*f
)
3461 struct font_driver_list
*list
, *next
;
3463 for (list
= f
->font_driver_list
; list
; list
= next
)
3468 f
->font_driver_list
= NULL
;
3472 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3473 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3474 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3476 A caller must free all realized faces if any in advance. The
3477 return value is a list of font backends actually made used on
3481 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3483 Lisp_Object active_drivers
= Qnil
;
3484 struct font_driver_list
*list
;
3486 /* At first, turn off non-requested drivers, and turn on requested
3488 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3490 struct font_driver
*driver
= list
->driver
;
3491 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3496 if (driver
->end_for_frame
)
3497 driver
->end_for_frame (f
);
3498 font_finish_cache (f
, driver
);
3503 if (! driver
->start_for_frame
3504 || driver
->start_for_frame (f
) == 0)
3506 font_prepare_cache (f
, driver
);
3513 if (NILP (new_drivers
))
3516 if (! EQ (new_drivers
, Qt
))
3518 /* Re-order the driver list according to new_drivers. */
3519 struct font_driver_list
**list_table
, **next
;
3524 SAFE_NALLOCA (list_table
, 1, num_font_drivers
+ 1);
3525 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3527 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3528 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3531 list_table
[i
++] = list
;
3533 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3535 list_table
[i
++] = list
;
3536 list_table
[i
] = NULL
;
3538 next
= &f
->font_driver_list
;
3539 for (i
= 0; list_table
[i
]; i
++)
3541 *next
= list_table
[i
];
3542 next
= &(*next
)->next
;
3547 if (! f
->font_driver_list
->on
)
3548 { /* None of the drivers is enabled: enable them all.
3549 Happens if you set the list of drivers to (xft x) in your .emacs
3550 and then use it under w32 or ns. */
3551 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3553 struct font_driver
*driver
= list
->driver
;
3554 eassert (! list
->on
);
3555 if (! driver
->start_for_frame
3556 || driver
->start_for_frame (f
) == 0)
3558 font_prepare_cache (f
, driver
);
3565 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3567 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3568 return active_drivers
;
3571 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
3574 fset_font_data (struct frame
*f
, Lisp_Object val
)
3580 font_put_frame_data (struct frame
*f
, Lisp_Object driver
, void *data
)
3582 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3585 fset_font_data (f
, Fdelq (val
, f
->font_data
));
3589 fset_font_data (f
, Fcons (Fcons (driver
, make_save_ptr (data
)),
3592 XSETCDR (val
, make_save_ptr (data
));
3597 font_get_frame_data (struct frame
*f
, Lisp_Object driver
)
3599 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3601 return NILP (val
) ? NULL
: XSAVE_POINTER (XCDR (val
), 0);
3604 #endif /* HAVE_XFT || HAVE_FREETYPE */
3606 /* Sets attributes on a font. Any properties that appear in ALIST and
3607 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3608 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3609 arrays of strings. This function is intended for use by the font
3610 drivers to implement their specific font_filter_properties. */
3612 font_filter_properties (Lisp_Object font
,
3614 const char *const boolean_properties
[],
3615 const char *const non_boolean_properties
[])
3620 /* Set boolean values to Qt or Qnil. */
3621 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3622 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3624 Lisp_Object key
= XCAR (XCAR (it
));
3625 Lisp_Object val
= XCDR (XCAR (it
));
3626 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3628 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3630 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3631 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3634 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3635 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3636 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3637 || strcmp ("Off", str
) == 0)
3642 Ffont_put (font
, key
, val
);
3646 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3647 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3649 Lisp_Object key
= XCAR (XCAR (it
));
3650 Lisp_Object val
= XCDR (XCAR (it
));
3651 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3652 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3653 Ffont_put (font
, key
, val
);
3658 /* Return the font used to draw character C by FACE at buffer position
3659 POS in window W. If STRING is non-nil, it is a string containing C
3660 at index POS. If C is negative, get C from the current buffer or
3664 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3669 Lisp_Object font_object
;
3671 multibyte
= (NILP (string
)
3672 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3673 : STRING_MULTIBYTE (string
));
3680 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3682 c
= FETCH_CHAR (pos_byte
);
3685 c
= FETCH_BYTE (pos
);
3691 multibyte
= STRING_MULTIBYTE (string
);
3694 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3696 str
= SDATA (string
) + pos_byte
;
3697 c
= STRING_CHAR (str
);
3700 c
= SDATA (string
)[pos
];
3704 f
= XFRAME (w
->frame
);
3705 if (! FRAME_WINDOW_P (f
))
3712 if (STRINGP (string
))
3713 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3714 DEFAULT_FACE_ID
, false);
3716 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3717 pos
+ 100, false, -1);
3718 face
= FACE_FROM_ID (f
, face_id
);
3722 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3723 face
= FACE_FROM_ID (f
, face_id
);
3728 XSETFONT (font_object
, face
->font
);
3733 #ifdef HAVE_WINDOW_SYSTEM
3735 /* Check how many characters after character/byte position POS/POS_BYTE
3736 (at most to *LIMIT) can be displayed by the same font in the window W.
3737 FACE, if non-NULL, is the face selected for the character at POS.
3738 If STRING is not nil, it is the string to check instead of the current
3739 buffer. In that case, FACE must be not NULL.
3741 The return value is the font-object for the character at POS.
3742 *LIMIT is set to the position where that font can't be used.
3744 It is assured that the current buffer (or STRING) is multibyte. */
3747 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3748 struct window
*w
, struct face
*face
, Lisp_Object string
)
3752 Lisp_Object font_object
= Qnil
;
3760 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3762 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3768 while (pos
< *limit
)
3770 Lisp_Object category
;
3773 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3775 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3776 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3777 if (INTEGERP (category
)
3778 && (XINT (category
) == UNICODE_CATEGORY_Cf
3779 || CHAR_VARIATION_SELECTOR_P (c
)))
3781 if (NILP (font_object
))
3783 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3784 if (NILP (font_object
))
3788 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3798 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3799 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3800 Return nil otherwise.
3801 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3802 which kind of font it is. It must be one of `font-spec', `font-entity',
3804 (Lisp_Object object
, Lisp_Object extra_type
)
3806 if (NILP (extra_type
))
3807 return (FONTP (object
) ? Qt
: Qnil
);
3808 if (EQ (extra_type
, Qfont_spec
))
3809 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3810 if (EQ (extra_type
, Qfont_entity
))
3811 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3812 if (EQ (extra_type
, Qfont_object
))
3813 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3814 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3817 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3818 doc
: /* Return a newly created font-spec with arguments as properties.
3820 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3821 valid font property name listed below:
3823 `:family', `:weight', `:slant', `:width'
3825 They are the same as face attributes of the same name. See
3826 `set-face-attribute'.
3830 VALUE must be a string or a symbol specifying the font foundry, e.g. `misc'.
3834 VALUE must be a string or a symbol specifying the additional
3835 typographic style information of a font, e.g. `sans'.
3839 VALUE must be a string or a symbol specifying the charset registry and
3840 encoding of a font, e.g. `iso8859-1'.
3844 VALUE must be a non-negative integer or a floating point number
3845 specifying the font size. It specifies the font size in pixels (if
3846 VALUE is an integer), or in points (if VALUE is a float).
3850 VALUE must be a string of XLFD-style or fontconfig-style font name.
3854 VALUE must be a symbol representing a script that the font must
3855 support. It may be a symbol representing a subgroup of a script
3856 listed in the variable `script-representative-chars'.
3860 VALUE must be a symbol of two-letter ISO-639 language names,
3865 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3866 required OpenType features.
3868 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3869 LANGSYS-TAG: OpenType language system tag symbol,
3870 or nil for the default language system.
3871 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3872 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3874 GSUB and GPOS may contain nil elements. In such a case, the font
3875 must not have any of the remaining elements.
3877 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3878 be an OpenType font whose GPOS table of `thai' script's default
3879 language system must contain `mark' feature.
3881 usage: (font-spec ARGS...) */)
3882 (ptrdiff_t nargs
, Lisp_Object
*args
)
3884 Lisp_Object spec
= font_make_spec ();
3887 for (i
= 0; i
< nargs
; i
+= 2)
3889 Lisp_Object key
= args
[i
], val
;
3893 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3896 if (EQ (key
, QCname
))
3899 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3900 error ("Invalid font name: %s", SSDATA (val
));
3901 font_put_extra (spec
, key
, val
);
3905 int idx
= get_font_prop_index (key
);
3909 val
= font_prop_validate (idx
, Qnil
, val
);
3910 if (idx
< FONT_EXTRA_INDEX
)
3911 ASET (spec
, idx
, val
);
3913 font_put_extra (spec
, key
, val
);
3916 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3922 /* Return a copy of FONT as a font-spec. For the sake of speed, this code
3923 relies on an internal stuff exposed from alloc.c and should be handled
3927 copy_font_spec (Lisp_Object font
)
3929 enum { font_spec_size
= VECSIZE (struct font_spec
) };
3930 Lisp_Object new_spec
, tail
, *pcdr
;
3931 struct font_spec
*spec
;
3935 /* Make an uninitialized font-spec object. */
3936 spec
= (struct font_spec
*) allocate_vector (font_spec_size
);
3937 XSETPVECTYPESIZE (spec
, PVEC_FONT
, FONT_SPEC_MAX
,
3938 font_spec_size
- FONT_SPEC_MAX
);
3940 spec
->props
[FONT_TYPE_INDEX
] = spec
->props
[FONT_EXTRA_INDEX
] = Qnil
;
3942 /* Copy basic properties FONT_FOUNDRY_INDEX..FONT_AVGWIDTH_INDEX. */
3943 memcpy (spec
->props
+ 1, XVECTOR (font
)->contents
+ 1,
3944 (FONT_EXTRA_INDEX
- 1) * word_size
);
3946 /* Copy an alist of extra information but discard :font-entity property. */
3947 pcdr
= spec
->props
+ FONT_EXTRA_INDEX
;
3948 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3949 if (!EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3950 *pcdr
= Fcons (XCAR (tail
), Qnil
), pcdr
= xcdr_addr (*pcdr
);
3952 XSETFONT (new_spec
, spec
);
3956 /* Merge font-specs FROM and TO, and return a new font-spec.
3957 Every specified property in FROM overrides the corresponding
3960 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3962 Lisp_Object extra
, tail
;
3967 to
= copy_font_spec (to
);
3968 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3969 ASET (to
, i
, AREF (from
, i
));
3970 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3971 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3972 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3974 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3977 XSETCDR (slot
, XCDR (XCAR (tail
)));
3979 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3981 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3985 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3986 doc
: /* Return the value of FONT's property KEY.
3987 FONT is a font-spec, a font-entity, or a font-object.
3988 KEY is any symbol, but these are reserved for specific meanings:
3989 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3990 :size, :name, :script, :otf
3991 See the documentation of `font-spec' for their meanings.
3992 In addition, if FONT is a font-entity or a font-object, values of
3993 :script and :otf are different from those of a font-spec as below:
3995 The value of :script may be a list of scripts that are supported by the font.
3997 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3998 representing the OpenType features supported by the font by this form:
3999 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4000 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
4002 (Lisp_Object font
, Lisp_Object key
)
4010 idx
= get_font_prop_index (key
);
4011 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4012 return font_style_symbolic (font
, idx
, 0);
4013 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4014 return AREF (font
, idx
);
4015 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4016 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4018 struct font
*fontp
= XFONT_OBJECT (font
);
4020 if (fontp
->driver
->otf_capability
)
4021 val
= fontp
->driver
->otf_capability (fontp
);
4023 val
= Fcons (Qnil
, Qnil
);
4030 #ifdef HAVE_WINDOW_SYSTEM
4032 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4033 doc
: /* Return a plist of face attributes generated by FONT.
4034 FONT is a font name, a font-spec, a font-entity, or a font-object.
4035 The return value is a list of the form
4037 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4039 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4040 compatible with `set-face-attribute'. Some of these key-attribute pairs
4041 may be omitted from the list if they are not specified by FONT.
4043 The optional argument FRAME specifies the frame that the face attributes
4044 are to be displayed on. If omitted, the selected frame is used. */)
4045 (Lisp_Object font
, Lisp_Object frame
)
4047 struct frame
*f
= decode_live_frame (frame
);
4048 Lisp_Object plist
[10];
4054 int fontset
= fs_query_fontset (font
, 0);
4055 Lisp_Object name
= font
;
4057 font
= fontset_ascii (fontset
);
4058 font
= font_spec_from_name (name
);
4060 signal_error ("Invalid font name", name
);
4062 else if (! FONTP (font
))
4063 signal_error ("Invalid font object", font
);
4065 val
= AREF (font
, FONT_FAMILY_INDEX
);
4068 plist
[n
++] = QCfamily
;
4069 plist
[n
++] = SYMBOL_NAME (val
);
4072 val
= AREF (font
, FONT_SIZE_INDEX
);
4075 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4076 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4077 plist
[n
++] = QCheight
;
4078 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4080 else if (FLOATP (val
))
4082 plist
[n
++] = QCheight
;
4083 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4086 val
= FONT_WEIGHT_FOR_FACE (font
);
4089 plist
[n
++] = QCweight
;
4093 val
= FONT_SLANT_FOR_FACE (font
);
4096 plist
[n
++] = QCslant
;
4100 val
= FONT_WIDTH_FOR_FACE (font
);
4103 plist
[n
++] = QCwidth
;
4107 return Flist (n
, plist
);
4112 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4113 doc
: /* Set one property of FONT: give property KEY value VAL.
4114 FONT is a font-spec, a font-entity, or a font-object.
4116 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4117 accepted by the function `font-spec' (which see), VAL must be what
4118 allowed in `font-spec'.
4120 If FONT is a font-entity or a font-object, KEY must not be the one
4121 accepted by `font-spec'. */)
4122 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4126 idx
= get_font_prop_index (prop
);
4127 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4129 CHECK_FONT_SPEC (font
);
4130 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4134 if (EQ (prop
, QCname
)
4135 || EQ (prop
, QCscript
)
4136 || EQ (prop
, QClang
)
4137 || EQ (prop
, QCotf
))
4138 CHECK_FONT_SPEC (font
);
4141 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4146 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4147 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4148 Optional 2nd argument FRAME specifies the target frame.
4149 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4150 Optional 4th argument PREFER, if non-nil, is a font-spec to
4151 control the order of the returned list. Fonts are sorted by
4152 how close they are to PREFER. */)
4153 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4155 struct frame
*f
= decode_live_frame (frame
);
4156 Lisp_Object vec
, list
;
4159 CHECK_FONT_SPEC (font_spec
);
4167 if (! NILP (prefer
))
4168 CHECK_FONT_SPEC (prefer
);
4170 list
= font_list_entities (f
, font_spec
);
4173 if (NILP (XCDR (list
))
4174 && ASIZE (XCAR (list
)) == 1)
4175 return list1 (AREF (XCAR (list
), 0));
4177 if (! NILP (prefer
))
4178 vec
= font_sort_entities (list
, prefer
, f
, 0);
4180 vec
= font_vconcat_entity_vectors (list
);
4181 if (n
== 0 || n
>= ASIZE (vec
))
4182 list
= CALLN (Fappend
, vec
, Qnil
);
4185 for (list
= Qnil
, n
--; n
>= 0; n
--)
4186 list
= Fcons (AREF (vec
, n
), list
);
4191 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4192 doc
: /* List available font families on the current frame.
4193 If FRAME is omitted or nil, the selected frame is used. */)
4196 struct frame
*f
= decode_live_frame (frame
);
4197 struct font_driver_list
*driver_list
;
4198 Lisp_Object list
= Qnil
;
4200 for (driver_list
= f
->font_driver_list
; driver_list
;
4201 driver_list
= driver_list
->next
)
4202 if (driver_list
->driver
->list_family
)
4204 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4205 Lisp_Object tail
= list
;
4207 for (; CONSP (val
); val
= XCDR (val
))
4208 if (NILP (Fmemq (XCAR (val
), tail
))
4209 && SYMBOLP (XCAR (val
)))
4210 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4215 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4216 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4217 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4218 (Lisp_Object font_spec
, Lisp_Object frame
)
4220 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4227 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4228 doc
: /* Return XLFD name of FONT.
4229 FONT is a font-spec, font-entity, or font-object.
4230 If the name is too long for XLFD (maximum 255 chars), return nil.
4231 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4232 the consecutive wildcards are folded into one. */)
4233 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4236 int namelen
, pixel_size
= 0;
4240 if (FONT_OBJECT_P (font
))
4242 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4244 if (STRINGP (font_name
)
4245 && SDATA (font_name
)[0] == '-')
4247 if (NILP (fold_wildcards
))
4249 lispstpcpy (name
, font_name
);
4250 namelen
= SBYTES (font_name
);
4253 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4255 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4259 if (! NILP (fold_wildcards
))
4261 char *p0
= name
, *p1
;
4263 while ((p1
= strstr (p0
, "-*-*")))
4265 strcpy (p1
, p1
+ 2);
4271 return make_string (name
, namelen
);
4275 clear_font_cache (struct frame
*f
)
4277 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4279 for (; driver_list
; driver_list
= driver_list
->next
)
4280 if (driver_list
->on
)
4282 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4286 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4288 eassert (! NILP (val
));
4289 tmp
= XCDR (XCAR (val
));
4290 if (XINT (XCAR (tmp
)) == 0)
4292 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4293 XSETCDR (cache
, XCDR (val
));
4298 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4299 doc
: /* Clear font cache of each frame. */)
4302 Lisp_Object list
, frame
;
4304 FOR_EACH_FRAME (list
, frame
)
4305 clear_font_cache (XFRAME (frame
));
4312 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4314 struct font
*font
= XFONT_OBJECT (font_object
);
4315 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4316 struct font_metrics metrics
;
4318 LGLYPH_SET_CODE (glyph
, code
);
4319 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4320 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4321 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4322 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4323 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4324 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4328 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4329 doc
: /* Shape the glyph-string GSTRING.
4330 Shaping means substituting glyphs and/or adjusting positions of glyphs
4331 to get the correct visual image of character sequences set in the
4332 header of the glyph-string.
4334 If the shaping was successful, the value is GSTRING itself or a newly
4335 created glyph-string. Otherwise, the value is nil.
4337 See the documentation of `composition-get-gstring' for the format of
4339 (Lisp_Object gstring
)
4342 Lisp_Object font_object
, n
, glyph
;
4343 ptrdiff_t i
, from
, to
;
4345 if (! composition_gstring_p (gstring
))
4346 signal_error ("Invalid glyph-string: ", gstring
);
4347 if (! NILP (LGSTRING_ID (gstring
)))
4349 font_object
= LGSTRING_FONT (gstring
);
4350 CHECK_FONT_OBJECT (font_object
);
4351 font
= XFONT_OBJECT (font_object
);
4352 if (! font
->driver
->shape
)
4355 /* Try at most three times with larger gstring each time. */
4356 for (i
= 0; i
< 3; i
++)
4358 n
= font
->driver
->shape (gstring
);
4361 gstring
= larger_vector (gstring
,
4362 LGSTRING_GLYPH_LEN (gstring
), -1);
4364 if (i
== 3 || XINT (n
) == 0)
4366 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4367 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4369 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4370 GLYPHS covers all characters (except for the last few ones) in
4371 GSTRING. More formally, provided that NCHARS is the number of
4372 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4373 and TO_IDX of each glyph must satisfy these conditions:
4375 GLYPHS[0].FROM_IDX == 0
4376 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4377 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4378 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4379 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4381 ;; Be sure to cover all characters.
4382 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4383 glyph
= LGSTRING_GLYPH (gstring
, 0);
4384 from
= LGLYPH_FROM (glyph
);
4385 to
= LGLYPH_TO (glyph
);
4386 if (from
!= 0 || to
< from
)
4388 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4390 glyph
= LGSTRING_GLYPH (gstring
, i
);
4393 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4394 && (LGLYPH_FROM (glyph
) == from
4395 ? LGLYPH_TO (glyph
) == to
4396 : LGLYPH_FROM (glyph
) == to
+ 1)))
4398 from
= LGLYPH_FROM (glyph
);
4399 to
= LGLYPH_TO (glyph
);
4401 return composition_gstring_put_cache (gstring
, XINT (n
));
4407 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4409 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4410 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4412 VARIATION-SELECTOR is a character code of variation selection
4413 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4414 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4415 (Lisp_Object font_object
, Lisp_Object character
)
4417 unsigned variations
[256];
4422 CHECK_FONT_OBJECT (font_object
);
4423 CHECK_CHARACTER (character
);
4424 font
= XFONT_OBJECT (font_object
);
4425 if (! font
->driver
->get_variation_glyphs
)
4427 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4431 for (i
= 0; i
< 255; i
++)
4434 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4435 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4436 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4443 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4444 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4445 OTF-FEATURES specifies which features to apply in this format:
4446 (SCRIPT LANGSYS GSUB GPOS)
4448 SCRIPT is a symbol specifying a script tag of OpenType,
4449 LANGSYS is a symbol specifying a langsys tag of OpenType,
4450 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4452 If LANGSYS is nil, the default langsys is selected.
4454 The features are applied in the order they appear in the list. The
4455 symbol `*' means to apply all available features not present in this
4456 list, and the remaining features are ignored. For instance, (vatu
4457 pstf * haln) is to apply vatu and pstf in this order, then to apply
4458 all available features other than vatu, pstf, and haln.
4460 The features are applied to the glyphs in the range FROM and TO of
4461 the glyph-string GSTRING-IN.
4463 If some feature is actually applicable, the resulting glyphs are
4464 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4465 this case, the value is the number of produced glyphs.
4467 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4470 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4471 produced in GSTRING-OUT, and the value is nil.
4473 See the documentation of `composition-get-gstring' for the format of
4475 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4477 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4482 check_otf_features (otf_features
);
4483 CHECK_FONT_OBJECT (font_object
);
4484 font
= XFONT_OBJECT (font_object
);
4485 if (! font
->driver
->otf_drive
)
4486 error ("Font backend %s can't drive OpenType GSUB table",
4487 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4488 CHECK_CONS (otf_features
);
4489 CHECK_SYMBOL (XCAR (otf_features
));
4490 val
= XCDR (otf_features
);
4491 CHECK_SYMBOL (XCAR (val
));
4492 val
= XCDR (otf_features
);
4495 len
= check_gstring (gstring_in
);
4496 CHECK_VECTOR (gstring_out
);
4497 CHECK_NATNUM (from
);
4499 CHECK_NATNUM (index
);
4501 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4502 args_out_of_range_3 (from
, to
, make_number (len
));
4503 if (XINT (index
) >= ASIZE (gstring_out
))
4504 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4505 num
= font
->driver
->otf_drive (font
, otf_features
,
4506 gstring_in
, XINT (from
), XINT (to
),
4507 gstring_out
, XINT (index
), 0);
4510 return make_number (num
);
4513 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4515 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4516 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4518 (SCRIPT LANGSYS FEATURE ...)
4519 See the documentation of `font-drive-otf' for more detail.
4521 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4522 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4523 character code corresponding to the glyph or nil if there's no
4524 corresponding character. */)
4525 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4527 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4528 Lisp_Object gstring_in
, gstring_out
, g
;
4529 Lisp_Object alternates
;
4532 if (! font
->driver
->otf_drive
)
4533 error ("Font backend %s can't drive OpenType GSUB table",
4534 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4535 CHECK_CHARACTER (character
);
4536 CHECK_CONS (otf_features
);
4538 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4539 g
= LGSTRING_GLYPH (gstring_in
, 0);
4540 LGLYPH_SET_CHAR (g
, XINT (character
));
4541 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4542 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4543 gstring_out
, 0, 1)) < 0)
4544 gstring_out
= Ffont_make_gstring (font_object
,
4545 make_number (ASIZE (gstring_out
) * 2));
4547 for (i
= 0; i
< num
; i
++)
4549 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4550 int c
= LGLYPH_CHAR (g
);
4551 unsigned code
= LGLYPH_CODE (g
);
4553 alternates
= Fcons (Fcons (make_number (code
),
4554 c
> 0 ? make_number (c
) : Qnil
),
4557 return Fnreverse (alternates
);
4563 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4564 doc
: /* Open FONT-ENTITY. */)
4565 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4568 struct frame
*f
= decode_live_frame (frame
);
4570 CHECK_FONT_ENTITY (font_entity
);
4573 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4576 CHECK_NUMBER_OR_FLOAT (size
);
4578 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4580 isize
= XINT (size
);
4581 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4582 args_out_of_range (font_entity
, size
);
4586 return font_open_entity (f
, font_entity
, isize
);
4589 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4590 doc
: /* Close FONT-OBJECT. */)
4591 (Lisp_Object font_object
, Lisp_Object frame
)
4593 CHECK_FONT_OBJECT (font_object
);
4594 font_close_object (decode_live_frame (frame
), font_object
);
4598 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4599 doc
: /* Return information about FONT-OBJECT.
4600 The value is a vector:
4601 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4604 NAME is the font name, a string (or nil if the font backend doesn't
4607 FILENAME is the font file name, a string (or nil if the font backend
4608 doesn't provide a file name).
4610 PIXEL-SIZE is a pixel size by which the font is opened.
4612 SIZE is a maximum advance width of the font in pixels.
4614 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4617 CAPABILITY is a list whose first element is a symbol representing the
4618 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4619 remaining elements describe the details of the font capability.
4621 If the font is OpenType font, the form of the list is
4622 \(opentype GSUB GPOS)
4623 where GSUB shows which "GSUB" features the font supports, and GPOS
4624 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4625 lists of the format:
4626 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4628 If the font is not OpenType font, currently the length of the form is
4631 SCRIPT is a symbol representing OpenType script tag.
4633 LANGSYS is a symbol representing OpenType langsys tag, or nil
4634 representing the default langsys.
4636 FEATURE is a symbol representing OpenType feature tag.
4638 If the font is not OpenType font, CAPABILITY is nil. */)
4639 (Lisp_Object font_object
)
4641 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4642 Lisp_Object val
= make_uninit_vector (9);
4644 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4645 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4646 ASET (val
, 2, make_number (font
->pixel_size
));
4647 ASET (val
, 3, make_number (font
->max_width
));
4648 ASET (val
, 4, make_number (font
->ascent
));
4649 ASET (val
, 5, make_number (font
->descent
));
4650 ASET (val
, 6, make_number (font
->space_width
));
4651 ASET (val
, 7, make_number (font
->average_width
));
4652 if (font
->driver
->otf_capability
)
4653 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4655 ASET (val
, 8, Qnil
);
4659 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4661 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4662 FROM and TO are positions (integers or markers) specifying a region
4663 of the current buffer, and can be in either order. If the optional
4664 fourth arg OBJECT is not nil, it is a string or a vector containing
4665 the target characters between indices FROM and TO, which are treated
4668 Each element is a vector containing information of a glyph in this format:
4669 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4671 FROM is an index numbers of a character the glyph corresponds to.
4672 TO is the same as FROM.
4673 C is the character of the glyph.
4674 CODE is the glyph-code of C in FONT-OBJECT.
4675 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4676 ADJUSTMENT is always nil.
4677 If FONT-OBJECT doesn't have a glyph for a character,
4678 the corresponding element is nil. */)
4679 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4682 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4684 Lisp_Object
*chars
, vec
;
4689 ptrdiff_t charpos
, bytepos
;
4691 validate_region (&from
, &to
);
4694 len
= XFASTINT (to
) - XFASTINT (from
);
4695 SAFE_ALLOCA_LISP (chars
, len
);
4696 charpos
= XFASTINT (from
);
4697 bytepos
= CHAR_TO_BYTE (charpos
);
4698 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4701 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4702 chars
[i
] = make_number (c
);
4705 else if (STRINGP (object
))
4707 const unsigned char *p
;
4708 ptrdiff_t ifrom
, ito
;
4710 validate_subarray (object
, from
, to
, SCHARS (object
), &ifrom
, &ito
);
4714 SAFE_ALLOCA_LISP (chars
, len
);
4716 if (STRING_MULTIBYTE (object
))
4720 /* Skip IFROM characters from the beginning. */
4721 for (i
= 0; i
< ifrom
; i
++)
4722 c
= STRING_CHAR_ADVANCE (p
);
4724 /* Now fetch an interesting characters. */
4725 for (i
= 0; i
< len
; i
++)
4727 c
= STRING_CHAR_ADVANCE (p
);
4728 chars
[i
] = make_number (c
);
4732 for (i
= 0; i
< len
; i
++)
4733 chars
[i
] = make_number (p
[ifrom
+ i
]);
4735 else if (VECTORP (object
))
4737 ptrdiff_t ifrom
, ito
;
4739 validate_subarray (object
, from
, to
, ASIZE (object
), &ifrom
, &ito
);
4743 for (i
= 0; i
< len
; i
++)
4745 Lisp_Object elt
= AREF (object
, ifrom
+ i
);
4746 CHECK_CHARACTER (elt
);
4748 chars
= aref_addr (object
, ifrom
);
4751 wrong_type_argument (Qarrayp
, object
);
4753 vec
= make_uninit_vector (len
);
4754 for (i
= 0; i
< len
; i
++)
4757 int c
= XFASTINT (chars
[i
]);
4759 struct font_metrics metrics
;
4761 code
= font
->driver
->encode_char (font
, c
);
4762 if (code
== FONT_INVALID_CODE
)
4764 ASET (vec
, i
, Qnil
);
4768 LGLYPH_SET_FROM (g
, i
);
4769 LGLYPH_SET_TO (g
, i
);
4770 LGLYPH_SET_CHAR (g
, c
);
4771 LGLYPH_SET_CODE (g
, code
);
4772 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4773 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4774 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4775 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4776 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4777 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4780 if (! VECTORP (object
))
4785 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4786 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4787 FONT is a font-spec, font-entity, or font-object. */)
4788 (Lisp_Object spec
, Lisp_Object font
)
4790 CHECK_FONT_SPEC (spec
);
4793 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4796 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4797 doc
: /* Return a font-object for displaying a character at POSITION.
4798 Optional second arg WINDOW, if non-nil, is a window displaying
4799 the current buffer. It defaults to the currently selected window.
4800 Optional third arg STRING, if non-nil, is a string containing the target
4801 character at index specified by POSITION. */)
4802 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4804 struct window
*w
= decode_live_window (window
);
4808 if (XBUFFER (w
->contents
) != current_buffer
)
4809 error ("Specified window is not displaying the current buffer");
4810 CHECK_NUMBER_COERCE_MARKER (position
);
4811 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4812 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4816 CHECK_NUMBER (position
);
4817 CHECK_STRING (string
);
4818 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4819 args_out_of_range (string
, position
);
4822 return font_at (-1, XINT (position
), NULL
, w
, string
);
4826 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4827 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4828 The value is a number of glyphs drawn.
4829 Type C-l to recover what previously shown. */)
4830 (Lisp_Object font_object
, Lisp_Object string
)
4832 Lisp_Object frame
= selected_frame
;
4833 struct frame
*f
= XFRAME (frame
);
4839 CHECK_FONT_GET_OBJECT (font_object
, font
);
4840 CHECK_STRING (string
);
4841 len
= SCHARS (string
);
4842 code
= alloca (sizeof (unsigned) * len
);
4843 for (i
= 0; i
< len
; i
++)
4845 Lisp_Object ch
= Faref (string
, make_number (i
));
4849 code
[i
] = font
->driver
->encode_char (font
, c
);
4850 if (code
[i
] == FONT_INVALID_CODE
)
4853 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4855 if (font
->driver
->prepare_face
)
4856 font
->driver
->prepare_face (f
, face
);
4857 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4858 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4859 if (font
->driver
->done_face
)
4860 font
->driver
->done_face (f
, face
);
4862 return make_number (len
);
4866 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4867 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4868 If FRAME is omitted or nil, use the selected frame. */)
4871 #ifdef HAVE_WINDOW_SYSTEM
4872 struct frame
*f
= decode_live_frame (frame
);
4874 if (FRAME_WINDOW_P (f
))
4875 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4881 #endif /* FONT_DEBUG */
4883 #ifdef HAVE_WINDOW_SYSTEM
4885 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4886 doc
: /* Return information about a font named NAME on frame FRAME.
4887 If FRAME is omitted or nil, use the selected frame.
4889 The returned value is a vector:
4890 [ OPENED-NAME FULL-NAME SIZE HEIGHT BASELINE-OFFSET RELATIVE-COMPOSE
4891 DEFAULT-ASCENT MAX-WIDTH ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4894 OPENED-NAME is the name used for opening the font,
4895 FULL-NAME is the full name of the font,
4896 SIZE is the pixelsize of the font,
4897 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4898 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4899 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4900 how to compose characters,
4901 MAX-WIDTH is the maximum advance width of the font,
4902 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font
4904 FILENAME is the font file name, a string (or nil if the font backend
4905 doesn't provide a file name).
4906 CAPABILITY is a list whose first element is a symbol representing the
4907 font format, one of x, opentype, truetype, type1, pcf, or bdf.
4908 The remaining elements describe the details of the font capabilities,
4911 If the font is OpenType font, the form of the list is
4912 \(opentype GSUB GPOS)
4913 where GSUB shows which "GSUB" features the font supports, and GPOS
4914 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4916 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4919 SCRIPT is a symbol representing OpenType script tag.
4920 LANGSYS is a symbol representing OpenType langsys tag, or nil
4921 representing the default langsys.
4922 FEATURE is a symbol representing OpenType feature tag.
4924 If the font is not an OpenType font, there are no elements
4925 in CAPABILITY except the font format symbol.
4927 If the named font is not yet loaded, return nil. */)
4928 (Lisp_Object name
, Lisp_Object frame
)
4933 Lisp_Object font_object
;
4936 CHECK_STRING (name
);
4937 f
= decode_window_system_frame (frame
);
4941 int fontset
= fs_query_fontset (name
, 0);
4944 name
= fontset_ascii (fontset
);
4945 font_object
= font_open_by_name (f
, name
);
4947 else if (FONT_OBJECT_P (name
))
4949 else if (FONT_ENTITY_P (name
))
4950 font_object
= font_open_entity (f
, name
, 0);
4953 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4954 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4956 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4958 if (NILP (font_object
))
4960 font
= XFONT_OBJECT (font_object
);
4962 info
= make_uninit_vector (14);
4963 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4964 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4965 ASET (info
, 2, make_number (font
->pixel_size
));
4966 ASET (info
, 3, make_number (font
->height
));
4967 ASET (info
, 4, make_number (font
->baseline_offset
));
4968 ASET (info
, 5, make_number (font
->relative_compose
));
4969 ASET (info
, 6, make_number (font
->default_ascent
));
4970 ASET (info
, 7, make_number (font
->max_width
));
4971 ASET (info
, 8, make_number (font
->ascent
));
4972 ASET (info
, 9, make_number (font
->descent
));
4973 ASET (info
, 10, make_number (font
->space_width
));
4974 ASET (info
, 11, make_number (font
->average_width
));
4975 ASET (info
, 12, AREF (font_object
, FONT_FILE_INDEX
));
4976 if (font
->driver
->otf_capability
)
4977 ASET (info
, 13, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4979 ASET (info
, 13, Qnil
);
4982 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4983 close it now. Perhaps, we should manage font-objects
4984 by `reference-count'. */
4985 font_close_object (f
, font_object
);
4992 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
4995 build_style_table (const struct table_entry
*entry
, int nelement
)
4998 Lisp_Object table
, elt
;
5000 table
= make_uninit_vector (nelement
);
5001 for (i
= 0; i
< nelement
; i
++)
5003 for (j
= 0; entry
[i
].names
[j
]; j
++);
5004 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5005 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5006 for (j
= 0; entry
[i
].names
[j
]; j
++)
5007 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5008 ASET (table
, i
, elt
);
5013 /* The deferred font-log data of the form [ACTION ARG RESULT].
5014 If ACTION is not nil, that is added to the log when font_add_log is
5015 called next time. At that time, ACTION is set back to nil. */
5016 static Lisp_Object Vfont_log_deferred
;
5018 /* Prepend the font-related logging data in Vfont_log if it is not
5019 t. ACTION describes a kind of font-related action (e.g. listing,
5020 opening), ARG is the argument for the action, and RESULT is the
5021 result of the action. */
5023 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5028 if (EQ (Vfont_log
, Qt
))
5030 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5032 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
5034 ASET (Vfont_log_deferred
, 0, Qnil
);
5035 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5036 AREF (Vfont_log_deferred
, 2));
5041 Lisp_Object tail
, elt
;
5042 AUTO_STRING (equal
, "=");
5044 val
= Ffont_xlfd_name (arg
, Qt
);
5045 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5049 if (EQ (XCAR (elt
), QCscript
)
5050 && SYMBOLP (XCDR (elt
)))
5051 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5052 concat2 (equal
, SYMBOL_NAME (XCDR (elt
))));
5053 else if (EQ (XCAR (elt
), QClang
)
5054 && SYMBOLP (XCDR (elt
)))
5055 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5056 concat2 (equal
, SYMBOL_NAME (XCDR (elt
))));
5057 else if (EQ (XCAR (elt
), QCotf
)
5058 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5059 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5060 concat2 (equal
, SYMBOL_NAME (XCAR (XCDR (elt
)))));
5066 && VECTORP (XCAR (result
))
5067 && ASIZE (XCAR (result
)) > 0
5068 && FONTP (AREF (XCAR (result
), 0)))
5069 result
= font_vconcat_entity_vectors (result
);
5072 val
= Ffont_xlfd_name (result
, Qt
);
5073 if (! FONT_SPEC_P (result
))
5075 AUTO_STRING (colon
, ":");
5076 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5081 else if (CONSP (result
))
5084 result
= Fcopy_sequence (result
);
5085 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5089 val
= Ffont_xlfd_name (val
, Qt
);
5090 XSETCAR (tail
, val
);
5093 else if (VECTORP (result
))
5095 result
= Fcopy_sequence (result
);
5096 for (i
= 0; i
< ASIZE (result
); i
++)
5098 val
= AREF (result
, i
);
5100 val
= Ffont_xlfd_name (val
, Qt
);
5101 ASET (result
, i
, val
);
5104 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5107 /* Record a font-related logging data to be added to Vfont_log when
5108 font_add_log is called next time. ACTION, ARG, RESULT are the same
5112 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5114 if (EQ (Vfont_log
, Qt
))
5116 ASET (Vfont_log_deferred
, 0, build_string (action
));
5117 ASET (Vfont_log_deferred
, 1, arg
);
5118 ASET (Vfont_log_deferred
, 2, result
);
5124 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5125 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5126 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5127 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5128 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5129 /* Note that the other elements in sort_shift_bits are not used. */
5131 staticpro (&font_charset_alist
);
5132 font_charset_alist
= Qnil
;
5134 DEFSYM (Qopentype
, "opentype");
5136 /* Important character set symbols. */
5137 DEFSYM (Qascii_0
, "ascii-0");
5138 DEFSYM (Qiso8859_1
, "iso8859-1");
5139 DEFSYM (Qiso10646_1
, "iso10646-1");
5140 DEFSYM (Qunicode_bmp
, "unicode-bmp");
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");
5156 /* Symbols representing values of font spacing property. */
5162 /* Special ADSTYLE properties to avoid fonts used for Latin
5163 characters; used in xfont.c and ftfont.c. */
5167 DEFSYM (QCuser_spec
, "user-spec");
5169 staticpro (&scratch_font_spec
);
5170 scratch_font_spec
= Ffont_spec (0, NULL
);
5171 staticpro (&scratch_font_prefer
);
5172 scratch_font_prefer
= Ffont_spec (0, NULL
);
5174 staticpro (&Vfont_log_deferred
);
5175 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5179 staticpro (&otf_list
);
5181 #endif /* HAVE_LIBOTF */
5185 defsubr (&Sfont_spec
);
5186 defsubr (&Sfont_get
);
5187 #ifdef HAVE_WINDOW_SYSTEM
5188 defsubr (&Sfont_face_attributes
);
5190 defsubr (&Sfont_put
);
5191 defsubr (&Slist_fonts
);
5192 defsubr (&Sfont_family_list
);
5193 defsubr (&Sfind_font
);
5194 defsubr (&Sfont_xlfd_name
);
5195 defsubr (&Sclear_font_cache
);
5196 defsubr (&Sfont_shape_gstring
);
5197 defsubr (&Sfont_variation_glyphs
);
5199 defsubr (&Sfont_drive_otf
);
5200 defsubr (&Sfont_otf_alternates
);
5204 defsubr (&Sopen_font
);
5205 defsubr (&Sclose_font
);
5206 defsubr (&Squery_font
);
5207 defsubr (&Sfont_get_glyphs
);
5208 defsubr (&Sfont_match_p
);
5209 defsubr (&Sfont_at
);
5211 defsubr (&Sdraw_string
);
5213 defsubr (&Sframe_font_cache
);
5214 #endif /* FONT_DEBUG */
5215 #ifdef HAVE_WINDOW_SYSTEM
5216 defsubr (&Sfont_info
);
5219 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5221 Alist of fontname patterns vs the corresponding encoding and repertory info.
5222 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5223 where ENCODING is a charset or a char-table,
5224 and REPERTORY is a charset, a char-table, or nil.
5226 If ENCODING and REPERTORY are the same, the element can have the form
5227 \(REGEXP . ENCODING).
5229 ENCODING is for converting a character to a glyph code of the font.
5230 If ENCODING is a charset, encoding a character by the charset gives
5231 the corresponding glyph code. If ENCODING is a char-table, looking up
5232 the table by a character gives the corresponding glyph code.
5234 REPERTORY specifies a repertory of characters supported by the font.
5235 If REPERTORY is a charset, all characters belonging to the charset are
5236 supported. If REPERTORY is a char-table, all characters who have a
5237 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5238 gets the repertory information by an opened font and ENCODING. */);
5239 Vfont_encoding_alist
= Qnil
;
5241 /* FIXME: These 3 vars are not quite what they appear: setq on them
5242 won't have any effect other than disconnect them from the style
5243 table used by the font display code. So we make them read-only,
5244 to avoid this confusing situation. */
5246 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5247 doc
: /* Vector of valid font weight values.
5248 Each element has the form:
5249 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5250 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5251 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5252 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5254 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5255 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5256 See `font-weight-table' for the format of the vector. */);
5257 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5258 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5260 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5261 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5262 See `font-weight-table' for the format of the vector. */);
5263 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5264 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5266 staticpro (&font_style_table
);
5267 font_style_table
= make_uninit_vector (3);
5268 ASET (font_style_table
, 0, Vfont_weight_table
);
5269 ASET (font_style_table
, 1, Vfont_slant_table
);
5270 ASET (font_style_table
, 2, Vfont_width_table
);
5272 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5273 *Logging list of font related actions and results.
5274 The value t means to suppress the logging.
5275 The initial value is set to nil if the environment variable
5276 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5279 #ifdef HAVE_WINDOW_SYSTEM
5280 #ifdef HAVE_FREETYPE
5282 #ifdef HAVE_X_WINDOWS
5284 syms_of_ftcrfont ();
5290 #endif /* HAVE_XFT */
5291 #endif /* not USE_CAIRO */
5292 #endif /* HAVE_X_WINDOWS */
5293 #else /* not HAVE_FREETYPE */
5294 #ifdef HAVE_X_WINDOWS
5296 #endif /* HAVE_X_WINDOWS */
5297 #endif /* not HAVE_FREETYPE */
5300 #endif /* HAVE_BDFFONT */
5303 #endif /* HAVE_NTGUI */
5304 #endif /* HAVE_WINDOW_SYSTEM */
5310 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;