1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2014 Free Software Foundation, Inc.
4 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
30 #include "character.h"
34 #include "dispextern.h"
36 #include "composite.h"
40 #ifdef HAVE_WINDOW_SYSTEM
42 #endif /* HAVE_WINDOW_SYSTEM */
44 Lisp_Object Qopentype
;
46 /* Important character set strings. */
47 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
49 #define DEFAULT_ENCODING Qiso8859_1
51 /* Unicode category `Cf'. */
52 static Lisp_Object QCf
;
54 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
55 static Lisp_Object font_style_table
;
57 /* Structure used for tables mapping weight, slant, and width numeric
58 values and their names. */
63 /* The first one is a valid name as a face attribute.
64 The second one (if any) is a typical name in XLFD field. */
68 /* Table of weight numeric values and their names. This table must be
69 sorted by numeric values in ascending order. */
71 static const struct table_entry weight_table
[] =
74 { 20, { "ultra-light", "ultralight" }},
75 { 40, { "extra-light", "extralight" }},
77 { 75, { "semi-light", "semilight", "demilight", "book" }},
78 { 100, { "normal", "medium", "regular", "unspecified" }},
79 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
81 { 205, { "extra-bold", "extrabold" }},
82 { 210, { "ultra-bold", "ultrabold", "black" }}
85 /* Table of slant numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static const struct table_entry slant_table
[] =
90 { 0, { "reverse-oblique", "ro" }},
91 { 10, { "reverse-italic", "ri" }},
92 { 100, { "normal", "r", "unspecified" }},
93 { 200, { "italic" ,"i", "ot" }},
94 { 210, { "oblique", "o" }}
97 /* Table of width numeric values and their names. This table must be
98 sorted by numeric values in ascending order. */
100 static const struct table_entry width_table
[] =
102 { 50, { "ultra-condensed", "ultracondensed" }},
103 { 63, { "extra-condensed", "extracondensed" }},
104 { 75, { "condensed", "compressed", "narrow" }},
105 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
106 { 100, { "normal", "medium", "regular", "unspecified" }},
107 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
108 { 125, { "expanded" }},
109 { 150, { "extra-expanded", "extraexpanded" }},
110 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
113 Lisp_Object QCfoundry
;
114 static Lisp_Object QCadstyle
, QCregistry
;
115 /* Symbols representing keys of font extra info. */
116 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
117 Lisp_Object QCantialias
, QCfont_entity
;
118 static Lisp_Object QCfc_unknown_spec
;
119 /* Symbols representing values of font spacing property. */
120 static Lisp_Object Qc
, Qm
, Qd
;
122 /* Special ADSTYLE properties to avoid fonts used for Latin
123 characters; used in xfont.c and ftfont.c. */
124 Lisp_Object Qja
, Qko
;
126 static Lisp_Object QCuser_spec
;
128 /* Alist of font registry symbols and the corresponding charset
129 information. The information is retrieved from
130 Vfont_encoding_alist on demand.
132 Eash element has the form:
133 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
137 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
138 encodes a character code to a glyph code of a font, and
139 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
140 character is supported by a font.
142 The latter form means that the information for REGISTRY couldn't be
144 static Lisp_Object font_charset_alist
;
146 /* List of all font drivers. Each font-backend (XXXfont.c) calls
147 register_font_driver in syms_of_XXXfont to register its font-driver
149 static struct font_driver_list
*font_driver_list
;
151 #ifdef ENABLE_CHECKING
153 /* Used to catch bogus pointers in font objects. */
156 valid_font_driver (struct font_driver
*drv
)
158 Lisp_Object tail
, frame
;
159 struct font_driver_list
*fdl
;
161 for (fdl
= font_driver_list
; fdl
; fdl
= fdl
->next
)
162 if (fdl
->driver
== drv
)
164 FOR_EACH_FRAME (tail
, frame
)
165 for (fdl
= XFRAME (frame
)->font_driver_list
; fdl
; fdl
= fdl
->next
)
166 if (fdl
->driver
== drv
)
171 #endif /* ENABLE_CHECKING */
173 /* Creators of font-related Lisp object. */
176 font_make_spec (void)
178 Lisp_Object font_spec
;
179 struct font_spec
*spec
180 = ((struct font_spec
*)
181 allocate_pseudovector (VECSIZE (struct font_spec
),
182 FONT_SPEC_MAX
, PVEC_FONT
));
183 XSETFONT (font_spec
, spec
);
188 font_make_entity (void)
190 Lisp_Object font_entity
;
191 struct font_entity
*entity
192 = ((struct font_entity
*)
193 allocate_pseudovector (VECSIZE (struct font_entity
),
194 FONT_ENTITY_MAX
, PVEC_FONT
));
195 XSETFONT (font_entity
, entity
);
199 /* Create a font-object whose structure size is SIZE. If ENTITY is
200 not nil, copy properties from ENTITY to the font-object. If
201 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
203 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
205 Lisp_Object font_object
;
207 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
210 /* GC can happen before the driver is set up,
211 so avoid dangling pointer here (Bug#17771). */
213 XSETFONT (font_object
, font
);
217 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
218 font
->props
[i
] = AREF (entity
, i
);
219 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
220 font
->props
[FONT_EXTRA_INDEX
]
221 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
224 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
230 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
231 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
232 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
234 static unsigned font_encode_char (Lisp_Object
, int);
236 /* Number of registered font drivers. */
237 static int num_font_drivers
;
240 /* Return a Lispy value of a font property value at STR and LEN bytes.
241 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
242 consist entirely of one or more digits, return a symbol interned
243 from STR. Otherwise, return an integer. */
246 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
251 ptrdiff_t nbytes
, nchars
;
253 if (len
== 1 && *str
== '*')
255 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
257 for (i
= 1; i
< len
; i
++)
258 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
265 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
268 return make_number (n
);
269 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
273 xsignal1 (Qoverflow_error
, make_string (str
, len
));
277 /* This code is similar to intern function from lread.c. */
278 obarray
= check_obarray (Vobarray
);
279 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
280 tem
= oblookup (obarray
, str
,
281 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
285 tem
= make_specified_string (str
, nchars
, len
,
286 len
!= nchars
&& len
== nbytes
);
287 return Fintern (tem
, obarray
);
290 /* Return a pixel size of font-spec SPEC on frame F. */
293 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
295 #ifdef HAVE_WINDOW_SYSTEM
296 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
305 eassert (FLOATP (size
));
306 point_size
= XFLOAT_DATA (size
);
307 val
= AREF (spec
, FONT_DPI_INDEX
);
311 dpi
= FRAME_RES_Y (f
);
312 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
320 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
321 font vector. If VAL is not valid (i.e. not registered in
322 font_style_table), return -1 if NOERROR is zero, and return a
323 proper index if NOERROR is nonzero. In that case, register VAL in
324 font_style_table if VAL is a symbol, and return the closest index if
325 VAL is an integer. */
328 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
331 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
334 CHECK_VECTOR (table
);
341 Lisp_Object args
[2], elt
;
343 /* At first try exact match. */
344 for (i
= 0; i
< len
; i
++)
346 CHECK_VECTOR (AREF (table
, i
));
347 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
348 if (EQ (val
, AREF (AREF (table
, i
), j
)))
350 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
351 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
352 | (i
<< 4) | (j
- 1));
355 /* Try also with case-folding match. */
356 s
= SSDATA (SYMBOL_NAME (val
));
357 for (i
= 0; i
< len
; i
++)
358 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
360 elt
= AREF (AREF (table
, i
), j
);
361 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
363 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
364 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
365 | (i
<< 4) | (j
- 1));
371 elt
= Fmake_vector (make_number (2), make_number (100));
374 args
[1] = Fmake_vector (make_number (1), elt
);
375 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
376 return (100 << 8) | (i
<< 4);
381 EMACS_INT numeric
= XINT (val
);
383 for (i
= 0, last_n
= -1; i
< len
; i
++)
387 CHECK_VECTOR (AREF (table
, i
));
388 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
389 n
= XINT (AREF (AREF (table
, i
), 0));
391 return (n
<< 8) | (i
<< 4);
396 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
397 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
403 return ((last_n
<< 8) | ((i
- 1) << 4));
408 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
411 Lisp_Object val
= AREF (font
, prop
);
412 Lisp_Object table
, elt
;
417 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
418 CHECK_VECTOR (table
);
419 i
= XINT (val
) & 0xFF;
420 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
421 elt
= AREF (table
, ((i
>> 4) & 0xF));
423 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
424 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
429 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
430 FONTNAME. ENCODING is a charset symbol that specifies the encoding
431 of the font. REPERTORY is a charset symbol or nil. */
434 find_font_encoding (Lisp_Object fontname
)
436 Lisp_Object tail
, elt
;
438 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
442 && STRINGP (XCAR (elt
))
443 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
444 && (SYMBOLP (XCDR (elt
))
445 ? CHARSETP (XCDR (elt
))
446 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
452 /* Return encoding charset and repertory charset for REGISTRY in
453 ENCODING and REPERTORY correspondingly. If correct information for
454 REGISTRY is available, return 0. Otherwise return -1. */
457 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
460 int encoding_id
, repertory_id
;
462 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
468 encoding_id
= XINT (XCAR (val
));
469 repertory_id
= XINT (XCDR (val
));
473 val
= find_font_encoding (SYMBOL_NAME (registry
));
474 if (SYMBOLP (val
) && CHARSETP (val
))
476 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
478 else if (CONSP (val
))
480 if (! CHARSETP (XCAR (val
)))
482 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
483 if (NILP (XCDR (val
)))
487 if (! CHARSETP (XCDR (val
)))
489 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
494 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
496 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
500 *encoding
= CHARSET_FROM_ID (encoding_id
);
502 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
507 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
512 /* Font property value validators. See the comment of
513 font_property_table for the meaning of the arguments. */
515 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
516 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
517 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
518 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
519 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
520 static int get_font_prop_index (Lisp_Object
);
523 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
526 val
= Fintern (val
, Qnil
);
529 else if (EQ (prop
, QCregistry
))
530 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
536 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
538 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
539 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
543 EMACS_INT n
= XINT (val
);
544 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
546 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
550 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
553 if ((n
& 0xF) + 1 >= ASIZE (elt
))
557 CHECK_NUMBER (AREF (elt
, 0));
558 if (XINT (AREF (elt
, 0)) != (n
>> 8))
563 else if (SYMBOLP (val
))
565 int n
= font_style_to_value (prop
, val
, 0);
567 val
= n
>= 0 ? make_number (n
) : Qerror
;
575 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
577 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
582 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
584 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
586 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
588 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
590 if (spacing
== 'c' || spacing
== 'C')
591 return make_number (FONT_SPACING_CHARCELL
);
592 if (spacing
== 'm' || spacing
== 'M')
593 return make_number (FONT_SPACING_MONO
);
594 if (spacing
== 'p' || spacing
== 'P')
595 return make_number (FONT_SPACING_PROPORTIONAL
);
596 if (spacing
== 'd' || spacing
== 'D')
597 return make_number (FONT_SPACING_DUAL
);
603 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
605 Lisp_Object tail
, tmp
;
608 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
609 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
610 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
613 if (! SYMBOLP (XCAR (val
)))
618 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
620 for (i
= 0; i
< 2; i
++)
627 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
628 if (! SYMBOLP (XCAR (tmp
)))
636 /* Structure of known font property keys and validator of the
640 /* Pointer to the key symbol. */
642 /* Function to validate PROP's value VAL, or NULL if any value is
643 ok. The value is VAL or its regularized value if VAL is valid,
644 and Qerror if not. */
645 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
646 } font_property_table
[] =
647 { { &QCtype
, font_prop_validate_symbol
},
648 { &QCfoundry
, font_prop_validate_symbol
},
649 { &QCfamily
, font_prop_validate_symbol
},
650 { &QCadstyle
, font_prop_validate_symbol
},
651 { &QCregistry
, font_prop_validate_symbol
},
652 { &QCweight
, font_prop_validate_style
},
653 { &QCslant
, font_prop_validate_style
},
654 { &QCwidth
, font_prop_validate_style
},
655 { &QCsize
, font_prop_validate_non_neg
},
656 { &QCdpi
, font_prop_validate_non_neg
},
657 { &QCspacing
, font_prop_validate_spacing
},
658 { &QCavgwidth
, font_prop_validate_non_neg
},
659 /* The order of the above entries must match with enum
660 font_property_index. */
661 { &QClang
, font_prop_validate_symbol
},
662 { &QCscript
, font_prop_validate_symbol
},
663 { &QCotf
, font_prop_validate_otf
}
666 /* Return an index number of font property KEY or -1 if KEY is not an
667 already known property. */
670 get_font_prop_index (Lisp_Object key
)
674 for (i
= 0; i
< ARRAYELTS (font_property_table
); i
++)
675 if (EQ (key
, *font_property_table
[i
].key
))
680 /* Validate the font property. The property key is specified by the
681 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
682 signal an error. The value is VAL or the regularized one. */
685 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
687 Lisp_Object validated
;
692 prop
= *font_property_table
[idx
].key
;
695 idx
= get_font_prop_index (prop
);
699 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
700 if (EQ (validated
, Qerror
))
701 signal_error ("invalid font property", Fcons (prop
, val
));
706 /* Store VAL as a value of extra font property PROP in FONT while
707 keeping the sorting order. Don't check the validity of VAL. */
710 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
712 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
713 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
717 Lisp_Object prev
= Qnil
;
720 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
721 prev
= extra
, extra
= XCDR (extra
);
724 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
726 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
732 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
737 /* Font name parser and unparser. */
739 static int parse_matrix (const char *);
740 static int font_expand_wildcards (Lisp_Object
*, int);
741 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
743 /* An enumerator for each field of an XLFD font name. */
744 enum xlfd_field_index
763 /* An enumerator for mask bit corresponding to each XLFD field. */
766 XLFD_FOUNDRY_MASK
= 0x0001,
767 XLFD_FAMILY_MASK
= 0x0002,
768 XLFD_WEIGHT_MASK
= 0x0004,
769 XLFD_SLANT_MASK
= 0x0008,
770 XLFD_SWIDTH_MASK
= 0x0010,
771 XLFD_ADSTYLE_MASK
= 0x0020,
772 XLFD_PIXEL_MASK
= 0x0040,
773 XLFD_POINT_MASK
= 0x0080,
774 XLFD_RESX_MASK
= 0x0100,
775 XLFD_RESY_MASK
= 0x0200,
776 XLFD_SPACING_MASK
= 0x0400,
777 XLFD_AVGWIDTH_MASK
= 0x0800,
778 XLFD_REGISTRY_MASK
= 0x1000,
779 XLFD_ENCODING_MASK
= 0x2000
783 /* Parse P pointing to the pixel/point size field of the form
784 `[A B C D]' which specifies a transformation matrix:
790 by which all glyphs of the font are transformed. The spec says
791 that scalar value N for the pixel/point size is equivalent to:
792 A = N * resx/resy, B = C = 0, D = N.
794 Return the scalar value N if the form is valid. Otherwise return
798 parse_matrix (const char *p
)
804 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
807 matrix
[i
] = - strtod (p
+ 1, &end
);
809 matrix
[i
] = strtod (p
, &end
);
812 return (i
== 4 ? (int) matrix
[3] : -1);
815 /* Expand a wildcard field in FIELD (the first N fields are filled) to
816 multiple fields to fill in all 14 XLFD fields while restricting a
817 field position by its contents. */
820 font_expand_wildcards (Lisp_Object
*field
, int n
)
823 Lisp_Object tmp
[XLFD_LAST_INDEX
];
824 /* Array of information about where this element can go. Nth
825 element is for Nth element of FIELD. */
827 /* Minimum possible field. */
829 /* Maximum possible field. */
831 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
833 } range
[XLFD_LAST_INDEX
];
835 int range_from
, range_to
;
838 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
839 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
840 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
841 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
842 | XLFD_AVGWIDTH_MASK)
843 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
845 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
846 field. The value is shifted to left one bit by one in the
848 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
849 range_mask
= (range_mask
<< 1) | 1;
851 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
852 position-based restriction for FIELD[I]. */
853 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
854 i
++, range_from
++, range_to
++, range_mask
<<= 1)
856 Lisp_Object val
= field
[i
];
862 range
[i
].from
= range_from
;
863 range
[i
].to
= range_to
;
864 range
[i
].mask
= range_mask
;
868 /* The triplet FROM, TO, and MASK is a value-based
869 restriction for FIELD[I]. */
875 EMACS_INT numeric
= XINT (val
);
878 from
= to
= XLFD_ENCODING_INDEX
,
879 mask
= XLFD_ENCODING_MASK
;
880 else if (numeric
== 0)
881 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
882 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
883 else if (numeric
<= 48)
884 from
= to
= XLFD_PIXEL_INDEX
,
885 mask
= XLFD_PIXEL_MASK
;
887 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
888 mask
= XLFD_LARGENUM_MASK
;
890 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
891 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
892 mask
= XLFD_NULL_MASK
;
894 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
897 Lisp_Object name
= SYMBOL_NAME (val
);
899 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
900 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
901 mask
= XLFD_REGENC_MASK
;
903 from
= to
= XLFD_ENCODING_INDEX
,
904 mask
= XLFD_ENCODING_MASK
;
906 else if (range_from
<= XLFD_WEIGHT_INDEX
907 && range_to
>= XLFD_WEIGHT_INDEX
908 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
909 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
910 else if (range_from
<= XLFD_SLANT_INDEX
911 && range_to
>= XLFD_SLANT_INDEX
912 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
913 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
914 else if (range_from
<= XLFD_SWIDTH_INDEX
915 && range_to
>= XLFD_SWIDTH_INDEX
916 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
917 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
920 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
921 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
923 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
924 mask
= XLFD_SYMBOL_MASK
;
927 /* Merge position-based and value-based restrictions. */
929 while (from
< range_from
)
930 mask
&= ~(1 << from
++);
931 while (from
< 14 && ! (mask
& (1 << from
)))
933 while (to
> range_to
)
934 mask
&= ~(1 << to
--);
935 while (to
>= 0 && ! (mask
& (1 << to
)))
939 range
[i
].from
= from
;
941 range
[i
].mask
= mask
;
943 if (from
> range_from
|| to
< range_to
)
945 /* The range is narrowed by value-based restrictions.
946 Reflect it to the other fields. */
948 /* Following fields should be after FROM. */
950 /* Preceding fields should be before TO. */
951 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
953 /* Check FROM for non-wildcard field. */
954 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
956 while (range
[j
].from
< from
)
957 range
[j
].mask
&= ~(1 << range
[j
].from
++);
958 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
960 range
[j
].from
= from
;
963 from
= range
[j
].from
;
964 if (range
[j
].to
> to
)
966 while (range
[j
].to
> to
)
967 range
[j
].mask
&= ~(1 << range
[j
].to
--);
968 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
981 /* Decide all fields from restrictions in RANGE. */
982 for (i
= j
= 0; i
< n
; i
++)
984 if (j
< range
[i
].from
)
986 if (i
== 0 || ! NILP (tmp
[i
- 1]))
987 /* None of TMP[X] corresponds to Jth field. */
989 for (; j
< range
[i
].from
; j
++)
994 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
996 for (; j
< XLFD_LAST_INDEX
; j
++)
998 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
999 field
[XLFD_ENCODING_INDEX
]
1000 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1005 /* Parse NAME (null terminated) as XLFD and store information in FONT
1006 (font-spec or font-entity). Size property of FONT is set as
1008 specified XLFD fields FONT property
1009 --------------------- -------------
1010 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1011 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1012 POINT_SIZE POINT_SIZE/10 (Lisp float)
1014 If NAME is successfully parsed, return 0. Otherwise return -1.
1016 FONT is usually a font-spec, but when this function is called from
1017 X font backend driver, it is a font-entity. In that case, NAME is
1018 a fully specified XLFD. */
1021 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1024 char *f
[XLFD_LAST_INDEX
+ 1];
1028 if (len
> 255 || !len
)
1029 /* Maximum XLFD name length is 255. */
1031 /* Accept "*-.." as a fully specified XLFD. */
1032 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1033 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1036 for (p
= name
+ i
; *p
; p
++)
1040 if (i
== XLFD_LAST_INDEX
)
1045 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1046 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1048 if (i
== XLFD_LAST_INDEX
)
1050 /* Fully specified XLFD. */
1053 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1054 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1055 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1056 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1058 val
= INTERN_FIELD_SYM (i
);
1061 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1063 ASET (font
, j
, make_number (n
));
1066 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1067 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1068 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1070 ASET (font
, FONT_REGISTRY_INDEX
,
1071 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1072 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1074 p
= f
[XLFD_PIXEL_INDEX
];
1075 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1076 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1079 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1081 ASET (font
, FONT_SIZE_INDEX
, val
);
1082 else if (FONT_ENTITY_P (font
))
1086 double point_size
= -1;
1088 eassert (FONT_SPEC_P (font
));
1089 p
= f
[XLFD_POINT_INDEX
];
1091 point_size
= parse_matrix (p
);
1092 else if (c_isdigit (*p
))
1093 point_size
= atoi (p
), point_size
/= 10;
1094 if (point_size
>= 0)
1095 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1099 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1100 if (! NILP (val
) && ! INTEGERP (val
))
1102 ASET (font
, FONT_DPI_INDEX
, val
);
1103 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1106 val
= font_prop_validate_spacing (QCspacing
, val
);
1107 if (! INTEGERP (val
))
1109 ASET (font
, FONT_SPACING_INDEX
, val
);
1111 p
= f
[XLFD_AVGWIDTH_INDEX
];
1114 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1115 if (! NILP (val
) && ! INTEGERP (val
))
1117 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1121 bool wild_card_found
= 0;
1122 Lisp_Object prop
[XLFD_LAST_INDEX
];
1124 if (FONT_ENTITY_P (font
))
1126 for (j
= 0; j
< i
; j
++)
1130 if (f
[j
][1] && f
[j
][1] != '-')
1133 wild_card_found
= 1;
1136 prop
[j
] = INTERN_FIELD (j
);
1138 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1140 if (! wild_card_found
)
1142 if (font_expand_wildcards (prop
, i
) < 0)
1145 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1146 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1147 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1148 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1149 if (! NILP (prop
[i
]))
1151 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1153 ASET (font
, j
, make_number (n
));
1155 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1156 val
= prop
[XLFD_REGISTRY_INDEX
];
1159 val
= prop
[XLFD_ENCODING_INDEX
];
1161 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1163 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1164 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1166 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1167 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1169 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1171 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1172 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1173 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1175 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1177 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1180 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1181 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1182 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1184 val
= font_prop_validate_spacing (QCspacing
,
1185 prop
[XLFD_SPACING_INDEX
]);
1186 if (! INTEGERP (val
))
1188 ASET (font
, FONT_SPACING_INDEX
, val
);
1190 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1191 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1197 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1198 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1199 0, use PIXEL_SIZE instead. */
1202 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1205 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1209 eassert (FONTP (font
));
1211 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1214 if (i
== FONT_ADSTYLE_INDEX
)
1215 j
= XLFD_ADSTYLE_INDEX
;
1216 else if (i
== FONT_REGISTRY_INDEX
)
1217 j
= XLFD_REGISTRY_INDEX
;
1218 val
= AREF (font
, i
);
1221 if (j
== XLFD_REGISTRY_INDEX
)
1229 val
= SYMBOL_NAME (val
);
1230 if (j
== XLFD_REGISTRY_INDEX
1231 && ! strchr (SSDATA (val
), '-'))
1233 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1234 ptrdiff_t alloc
= SBYTES (val
) + 4;
1235 if (nbytes
<= alloc
)
1237 f
[j
] = p
= alloca (alloc
);
1238 sprintf (p
, "%s%s-*", SDATA (val
),
1239 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1242 f
[j
] = SSDATA (val
);
1246 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1249 val
= font_style_symbolic (font
, i
, 0);
1257 val
= SYMBOL_NAME (val
);
1258 alloc
= SBYTES (val
) + 1;
1259 if (nbytes
<= alloc
)
1261 f
[j
] = p
= alloca (alloc
);
1262 /* Copy the name while excluding '-', '?', ',', and '"'. */
1263 for (k
= l
= 0; k
< alloc
; k
++)
1266 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1272 val
= AREF (font
, FONT_SIZE_INDEX
);
1273 eassert (NUMBERP (val
) || NILP (val
));
1276 EMACS_INT v
= XINT (val
);
1281 f
[XLFD_PIXEL_INDEX
] = p
=
1282 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1283 sprintf (p
, "%"pI
"d-*", v
);
1286 f
[XLFD_PIXEL_INDEX
] = "*-*";
1288 else if (FLOATP (val
))
1290 double v
= XFLOAT_DATA (val
) * 10;
1291 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1292 sprintf (p
, "*-%.0f", v
);
1295 f
[XLFD_PIXEL_INDEX
] = "*-*";
1297 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1299 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1300 f
[XLFD_RESX_INDEX
] = p
=
1301 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1302 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1305 f
[XLFD_RESX_INDEX
] = "*-*";
1306 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1308 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1310 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1311 : spacing
<= FONT_SPACING_DUAL
? "d"
1312 : spacing
<= FONT_SPACING_MONO
? "m"
1316 f
[XLFD_SPACING_INDEX
] = "*";
1317 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1319 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1320 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1323 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1324 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1325 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1326 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1327 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1328 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1329 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1330 f
[XLFD_REGISTRY_INDEX
]);
1331 return len
< nbytes
? len
: -1;
1334 /* Parse NAME (null terminated) and store information in FONT
1335 (font-spec or font-entity). NAME is supplied in either the
1336 Fontconfig or GTK font name format. If NAME is successfully
1337 parsed, return 0. Otherwise return -1.
1339 The fontconfig format is
1341 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1345 FAMILY [PROPS...] [SIZE]
1347 This function tries to guess which format it is. */
1350 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1353 char *size_beg
= NULL
, *size_end
= NULL
;
1354 char *props_beg
= NULL
, *family_end
= NULL
;
1359 for (p
= name
; *p
; p
++)
1361 if (*p
== '\\' && p
[1])
1365 props_beg
= family_end
= p
;
1370 bool decimal
= 0, size_found
= 1;
1371 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1372 if (! c_isdigit (*q
))
1374 if (*q
!= '.' || decimal
)
1393 Lisp_Object extra_props
= Qnil
;
1395 /* A fontconfig name with size and/or property data. */
1396 if (family_end
> name
)
1399 family
= font_intern_prop (name
, family_end
- name
, 1);
1400 ASET (font
, FONT_FAMILY_INDEX
, family
);
1404 double point_size
= strtod (size_beg
, &size_end
);
1405 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1406 if (*size_end
== ':' && size_end
[1])
1407 props_beg
= size_end
;
1411 /* Now parse ":KEY=VAL" patterns. */
1414 for (p
= props_beg
; *p
; p
= q
)
1416 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1419 /* Must be an enumerated value. */
1423 val
= font_intern_prop (p
, q
- p
, 1);
1425 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1426 && memcmp (p, STR, strlen (STR)) == 0)
1428 if (PROP_MATCH ("light")
1429 || PROP_MATCH ("medium")
1430 || PROP_MATCH ("demibold")
1431 || PROP_MATCH ("bold")
1432 || PROP_MATCH ("black"))
1433 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1434 else if (PROP_MATCH ("roman")
1435 || PROP_MATCH ("italic")
1436 || PROP_MATCH ("oblique"))
1437 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1438 else if (PROP_MATCH ("charcell"))
1439 ASET (font
, FONT_SPACING_INDEX
,
1440 make_number (FONT_SPACING_CHARCELL
));
1441 else if (PROP_MATCH ("mono"))
1442 ASET (font
, FONT_SPACING_INDEX
,
1443 make_number (FONT_SPACING_MONO
));
1444 else if (PROP_MATCH ("proportional"))
1445 ASET (font
, FONT_SPACING_INDEX
,
1446 make_number (FONT_SPACING_PROPORTIONAL
));
1455 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1456 prop
= FONT_SIZE_INDEX
;
1459 key
= font_intern_prop (p
, q
- p
, 1);
1460 prop
= get_font_prop_index (key
);
1464 for (q
= p
; *q
&& *q
!= ':'; q
++);
1465 val
= font_intern_prop (p
, q
- p
, 0);
1467 if (prop
>= FONT_FOUNDRY_INDEX
1468 && prop
< FONT_EXTRA_INDEX
)
1469 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1472 extra_props
= nconc2 (extra_props
,
1473 list1 (Fcons (key
, val
)));
1480 if (! NILP (extra_props
))
1482 struct font_driver_list
*driver_list
= font_driver_list
;
1483 for ( ; driver_list
; driver_list
= driver_list
->next
)
1484 if (driver_list
->driver
->filter_properties
)
1485 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1491 /* Either a fontconfig-style name with no size and property
1492 data, or a GTK-style name. */
1493 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1494 Lisp_Object width
= Qnil
, size
= Qnil
;
1498 /* Scan backwards from the end, looking for a size. */
1499 for (p
= name
+ len
- 1; p
>= name
; p
--)
1500 if (!c_isdigit (*p
))
1503 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1504 /* Found a font size. */
1505 size
= make_float (strtod (p
+ 1, NULL
));
1509 /* Now P points to the termination of the string, sans size.
1510 Scan backwards, looking for font properties. */
1511 for (; p
> name
; p
= q
)
1513 for (q
= p
- 1; q
>= name
; q
--)
1515 if (q
> name
&& *(q
-1) == '\\')
1516 --q
; /* Skip quoting backslashes. */
1522 word_len
= p
- word_start
;
1524 #define PROP_MATCH(STR) \
1525 (word_len == strlen (STR) \
1526 && memcmp (word_start, STR, strlen (STR)) == 0)
1527 #define PROP_SAVE(VAR, STR) \
1528 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1530 if (PROP_MATCH ("Ultra-Light"))
1531 PROP_SAVE (weight
, "ultra-light");
1532 else if (PROP_MATCH ("Light"))
1533 PROP_SAVE (weight
, "light");
1534 else if (PROP_MATCH ("Book"))
1535 PROP_SAVE (weight
, "book");
1536 else if (PROP_MATCH ("Medium"))
1537 PROP_SAVE (weight
, "medium");
1538 else if (PROP_MATCH ("Semi-Bold"))
1539 PROP_SAVE (weight
, "semi-bold");
1540 else if (PROP_MATCH ("Bold"))
1541 PROP_SAVE (weight
, "bold");
1542 else if (PROP_MATCH ("Italic"))
1543 PROP_SAVE (slant
, "italic");
1544 else if (PROP_MATCH ("Oblique"))
1545 PROP_SAVE (slant
, "oblique");
1546 else if (PROP_MATCH ("Semi-Condensed"))
1547 PROP_SAVE (width
, "semi-condensed");
1548 else if (PROP_MATCH ("Condensed"))
1549 PROP_SAVE (width
, "condensed");
1550 /* An unknown word must be part of the font name. */
1561 ASET (font
, FONT_FAMILY_INDEX
,
1562 font_intern_prop (name
, family_end
- name
, 1));
1564 ASET (font
, FONT_SIZE_INDEX
, size
);
1566 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1568 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1570 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1576 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1577 NAME (NBYTES length), and return the name length. If
1578 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1581 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1583 Lisp_Object family
, foundry
;
1589 Lisp_Object styles
[3];
1590 const char *style_names
[3] = { "weight", "slant", "width" };
1592 family
= AREF (font
, FONT_FAMILY_INDEX
);
1593 if (! NILP (family
))
1595 if (SYMBOLP (family
))
1596 family
= SYMBOL_NAME (family
);
1601 val
= AREF (font
, FONT_SIZE_INDEX
);
1604 if (XINT (val
) != 0)
1605 pixel_size
= XINT (val
);
1610 eassert (FLOATP (val
));
1612 point_size
= (int) XFLOAT_DATA (val
);
1615 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1616 if (! NILP (foundry
))
1618 if (SYMBOLP (foundry
))
1619 foundry
= SYMBOL_NAME (foundry
);
1624 for (i
= 0; i
< 3; i
++)
1625 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1628 lim
= name
+ nbytes
;
1629 if (! NILP (family
))
1631 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1632 if (! (0 <= len
&& len
< lim
- p
))
1638 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1639 if (! (0 <= len
&& len
< lim
- p
))
1643 else if (pixel_size
> 0)
1645 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1646 if (! (0 <= len
&& len
< lim
- p
))
1650 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1652 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1653 SSDATA (SYMBOL_NAME (AREF (font
,
1654 FONT_FOUNDRY_INDEX
))));
1655 if (! (0 <= len
&& len
< lim
- p
))
1659 for (i
= 0; i
< 3; i
++)
1660 if (! NILP (styles
[i
]))
1662 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1663 SSDATA (SYMBOL_NAME (styles
[i
])));
1664 if (! (0 <= len
&& len
< lim
- p
))
1669 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1671 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1672 XINT (AREF (font
, FONT_DPI_INDEX
)));
1673 if (! (0 <= len
&& len
< lim
- p
))
1678 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1680 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1681 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1682 if (! (0 <= len
&& len
< lim
- p
))
1687 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1689 int len
= snprintf (p
, lim
- p
,
1690 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1692 : ":scalable=false"));
1693 if (! (0 <= len
&& len
< lim
- p
))
1701 /* Parse NAME (null terminated) and store information in FONT
1702 (font-spec or font-entity). If NAME is successfully parsed, return
1703 0. Otherwise return -1. */
1706 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1708 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1709 return font_parse_xlfd (name
, namelen
, font
);
1710 return font_parse_fcname (name
, namelen
, font
);
1714 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1715 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1719 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1725 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1727 CHECK_STRING (family
);
1728 len
= SBYTES (family
);
1729 p0
= SSDATA (family
);
1730 p1
= strchr (p0
, '-');
1733 if ((*p0
!= '*' && p1
- p0
> 0)
1734 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1735 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1738 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1741 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1743 if (! NILP (registry
))
1745 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1746 CHECK_STRING (registry
);
1747 len
= SBYTES (registry
);
1748 p0
= SSDATA (registry
);
1749 p1
= strchr (p0
, '-');
1752 if (SDATA (registry
)[len
- 1] == '*')
1753 registry
= concat2 (registry
, build_string ("-*"));
1755 registry
= concat2 (registry
, build_string ("*-*"));
1757 registry
= Fdowncase (registry
);
1758 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1763 /* This part (through the next ^L) is still experimental and not
1764 tested much. We may drastically change codes. */
1770 #define LGSTRING_HEADER_SIZE 6
1771 #define LGSTRING_GLYPH_SIZE 8
1774 check_gstring (Lisp_Object gstring
)
1780 CHECK_VECTOR (gstring
);
1781 val
= AREF (gstring
, 0);
1783 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1785 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1786 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1787 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1788 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1789 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1790 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1791 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1792 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1793 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1794 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1795 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1797 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1799 val
= LGSTRING_GLYPH (gstring
, i
);
1801 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1803 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1805 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1806 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1807 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1808 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1809 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1810 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1811 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1812 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1814 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1816 if (ASIZE (val
) < 3)
1818 for (j
= 0; j
< 3; j
++)
1819 CHECK_NUMBER (AREF (val
, j
));
1824 error ("Invalid glyph-string format");
1829 check_otf_features (Lisp_Object otf_features
)
1833 CHECK_CONS (otf_features
);
1834 CHECK_SYMBOL (XCAR (otf_features
));
1835 otf_features
= XCDR (otf_features
);
1836 CHECK_CONS (otf_features
);
1837 CHECK_SYMBOL (XCAR (otf_features
));
1838 otf_features
= XCDR (otf_features
);
1839 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1841 CHECK_SYMBOL (XCAR (val
));
1842 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1843 error ("Invalid OTF GSUB feature: %s",
1844 SDATA (SYMBOL_NAME (XCAR (val
))));
1846 otf_features
= XCDR (otf_features
);
1847 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1849 CHECK_SYMBOL (XCAR (val
));
1850 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1851 error ("Invalid OTF GPOS feature: %s",
1852 SDATA (SYMBOL_NAME (XCAR (val
))));
1859 Lisp_Object otf_list
;
1862 otf_tag_symbol (OTF_Tag tag
)
1866 OTF_tag_name (tag
, name
);
1867 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1871 otf_open (Lisp_Object file
)
1873 Lisp_Object val
= Fassoc (file
, otf_list
);
1877 otf
= XSAVE_POINTER (XCDR (val
), 0);
1880 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1881 val
= make_save_ptr (otf
);
1882 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1888 /* Return a list describing which scripts/languages FONT supports by
1889 which GSUB/GPOS features of OpenType tables. See the comment of
1890 (struct font_driver).otf_capability. */
1893 font_otf_capability (struct font
*font
)
1896 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1899 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1902 for (i
= 0; i
< 2; i
++)
1904 OTF_GSUB_GPOS
*gsub_gpos
;
1905 Lisp_Object script_list
= Qnil
;
1908 if (OTF_get_features (otf
, i
== 0) < 0)
1910 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1911 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1913 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1914 Lisp_Object langsys_list
= Qnil
;
1915 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1918 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1920 OTF_LangSys
*langsys
;
1921 Lisp_Object feature_list
= Qnil
;
1922 Lisp_Object langsys_tag
;
1925 if (k
== script
->LangSysCount
)
1927 langsys
= &script
->DefaultLangSys
;
1932 langsys
= script
->LangSys
+ k
;
1934 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1936 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1938 OTF_Feature
*feature
1939 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1940 Lisp_Object feature_tag
1941 = otf_tag_symbol (feature
->FeatureTag
);
1943 feature_list
= Fcons (feature_tag
, feature_list
);
1945 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1948 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1953 XSETCAR (capability
, script_list
);
1955 XSETCDR (capability
, script_list
);
1961 /* Parse OTF features in SPEC and write a proper features spec string
1962 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1963 assured that the sufficient memory has already allocated for
1967 generate_otf_features (Lisp_Object spec
, char *features
)
1975 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1981 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1986 else if (! asterisk
)
1988 val
= SYMBOL_NAME (val
);
1989 p
+= esprintf (p
, "%s", SDATA (val
));
1993 val
= SYMBOL_NAME (val
);
1994 p
+= esprintf (p
, "~%s", SDATA (val
));
1998 error ("OTF spec too long");
2002 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
2004 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2006 return Fcons (make_number (len
),
2007 make_unibyte_string (device_table
->DeltaValue
, len
));
2011 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2013 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2015 if (value_format
& OTF_XPlacement
)
2016 ASET (val
, 0, make_number (value_record
->XPlacement
));
2017 if (value_format
& OTF_YPlacement
)
2018 ASET (val
, 1, make_number (value_record
->YPlacement
));
2019 if (value_format
& OTF_XAdvance
)
2020 ASET (val
, 2, make_number (value_record
->XAdvance
));
2021 if (value_format
& OTF_YAdvance
)
2022 ASET (val
, 3, make_number (value_record
->YAdvance
));
2023 if (value_format
& OTF_XPlaDevice
)
2024 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2025 if (value_format
& OTF_YPlaDevice
)
2026 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2027 if (value_format
& OTF_XAdvDevice
)
2028 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2029 if (value_format
& OTF_YAdvDevice
)
2030 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2035 font_otf_Anchor (OTF_Anchor
*anchor
)
2039 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2040 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2041 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2042 if (anchor
->AnchorFormat
== 2)
2043 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2046 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2047 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2051 #endif /* HAVE_LIBOTF */
2058 font_rescale_ratio (Lisp_Object font_entity
)
2060 Lisp_Object tail
, elt
;
2061 Lisp_Object name
= Qnil
;
2063 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2066 if (FLOATP (XCDR (elt
)))
2068 if (STRINGP (XCAR (elt
)))
2071 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2072 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2073 return XFLOAT_DATA (XCDR (elt
));
2075 else if (FONT_SPEC_P (XCAR (elt
)))
2077 if (font_match_p (XCAR (elt
), font_entity
))
2078 return XFLOAT_DATA (XCDR (elt
));
2085 /* We sort fonts by scoring each of them against a specified
2086 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2087 the value is, the closer the font is to the font-spec.
2089 The lowest 2 bits of the score are used for driver type. The font
2090 available by the most preferred font driver is 0.
2092 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2093 WEIGHT, SLANT, WIDTH, and SIZE. */
2095 /* How many bits to shift to store the difference value of each font
2096 property in a score. Note that floats for FONT_TYPE_INDEX and
2097 FONT_REGISTRY_INDEX are not used. */
2098 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2100 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2101 The return value indicates how different ENTITY is compared with
2105 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2110 /* Score three style numeric fields. Maximum difference is 127. */
2111 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2112 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2114 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2115 - (XINT (spec_prop
[i
]) >> 8));
2116 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2119 /* Score the size. Maximum difference is 127. */
2120 i
= FONT_SIZE_INDEX
;
2121 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2122 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2124 /* We use the higher 6-bit for the actual size difference. The
2125 lowest bit is set if the DPI is different. */
2127 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2129 if (CONSP (Vface_font_rescale_alist
))
2130 pixel_size
*= font_rescale_ratio (entity
);
2131 diff
= eabs (pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
))) << 1;
2132 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2133 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2135 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2136 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2138 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2145 /* Concatenate all elements of LIST into one vector. LIST is a list
2146 of font-entity vectors. */
2149 font_vconcat_entity_vectors (Lisp_Object list
)
2151 int nargs
= XINT (Flength (list
));
2152 Lisp_Object
*args
= alloca (word_size
* nargs
);
2155 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2156 args
[i
] = XCAR (list
);
2157 return Fvconcat (nargs
, args
);
2161 /* The structure for elements being sorted by qsort. */
2162 struct font_sort_data
2165 int font_driver_preference
;
2170 /* The comparison function for qsort. */
2173 font_compare (const void *d1
, const void *d2
)
2175 const struct font_sort_data
*data1
= d1
;
2176 const struct font_sort_data
*data2
= d2
;
2178 if (data1
->score
< data2
->score
)
2180 else if (data1
->score
> data2
->score
)
2182 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2186 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2187 If PREFER specifies a point-size, calculate the corresponding
2188 pixel-size from QCdpi property of PREFER or from the Y-resolution
2189 of FRAME before sorting.
2191 If BEST-ONLY is nonzero, return the best matching entity (that
2192 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2193 if BEST-ONLY is negative). Otherwise, return the sorted result as
2194 a single vector of font-entities.
2196 This function does no optimization for the case that the total
2197 number of elements is 1. The caller should avoid calling this in
2201 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2202 struct frame
*f
, int best_only
)
2204 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2206 struct font_sort_data
*data
;
2207 unsigned best_score
;
2208 Lisp_Object best_entity
;
2209 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2212 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2213 prefer_prop
[i
] = AREF (prefer
, i
);
2214 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2215 prefer_prop
[FONT_SIZE_INDEX
]
2216 = make_number (font_pixel_size (f
, prefer
));
2218 if (NILP (XCDR (list
)))
2220 /* What we have to take care of is this single vector. */
2222 maxlen
= ASIZE (vec
);
2226 /* We don't have to perform sort, so there's no need of creating
2227 a single vector. But, we must find the length of the longest
2230 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2231 if (maxlen
< ASIZE (XCAR (tail
)))
2232 maxlen
= ASIZE (XCAR (tail
));
2236 /* We have to create a single vector to sort it. */
2237 vec
= font_vconcat_entity_vectors (list
);
2238 maxlen
= ASIZE (vec
);
2241 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2242 best_score
= 0xFFFFFFFF;
2245 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2247 int font_driver_preference
= 0;
2248 Lisp_Object current_font_driver
;
2254 /* We are sure that the length of VEC > 0. */
2255 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2256 /* Score the elements. */
2257 for (i
= 0; i
< len
; i
++)
2259 data
[i
].entity
= AREF (vec
, i
);
2261 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2263 ? font_score (data
[i
].entity
, prefer_prop
)
2265 if (best_only
&& best_score
> data
[i
].score
)
2267 best_score
= data
[i
].score
;
2268 best_entity
= data
[i
].entity
;
2269 if (best_score
== 0)
2272 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2274 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2275 font_driver_preference
++;
2277 data
[i
].font_driver_preference
= font_driver_preference
;
2280 /* Sort if necessary. */
2283 qsort (data
, len
, sizeof *data
, font_compare
);
2284 for (i
= 0; i
< len
; i
++)
2285 ASET (vec
, i
, data
[i
].entity
);
2294 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2299 /* API of Font Service Layer. */
2301 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2302 sort_shift_bits. Finternal_set_font_selection_order calls this
2303 function with font_sort_order after setting up it. */
2306 font_update_sort_order (int *order
)
2310 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2312 int xlfd_idx
= order
[i
];
2314 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2315 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2316 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2317 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2318 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2319 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2321 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2326 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2327 Lisp_Object features
, Lisp_Object table
)
2332 table
= assq_no_quit (script
, table
);
2335 table
= XCDR (table
);
2336 if (! NILP (langsys
))
2338 table
= assq_no_quit (langsys
, table
);
2344 val
= assq_no_quit (Qnil
, table
);
2346 table
= XCAR (table
);
2350 table
= XCDR (table
);
2351 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2353 if (NILP (XCAR (features
)))
2358 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2364 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2367 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2369 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2371 script
= XCAR (spec
);
2375 langsys
= XCAR (spec
);
2386 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2387 XCAR (otf_capability
)))
2389 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2390 XCDR (otf_capability
)))
2397 /* Check if FONT (font-entity or font-object) matches with the font
2398 specification SPEC. */
2401 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2403 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2404 Lisp_Object extra
, font_extra
;
2407 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2408 if (! NILP (AREF (spec
, i
))
2409 && ! NILP (AREF (font
, i
))
2410 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2412 props
= XFONT_SPEC (spec
)->props
;
2413 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2415 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2416 prop
[i
] = AREF (spec
, i
);
2417 prop
[FONT_SIZE_INDEX
]
2418 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2422 if (font_score (font
, props
) > 0)
2424 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2425 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2426 for (; CONSP (extra
); extra
= XCDR (extra
))
2428 Lisp_Object key
= XCAR (XCAR (extra
));
2429 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2431 if (EQ (key
, QClang
))
2433 val2
= assq_no_quit (key
, font_extra
);
2442 if (NILP (Fmemq (val
, val2
)))
2447 ? NILP (Fmemq (val
, XCDR (val2
)))
2451 else if (EQ (key
, QCscript
))
2453 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2459 /* All characters in the list must be supported. */
2460 for (; CONSP (val2
); val2
= XCDR (val2
))
2462 if (! CHARACTERP (XCAR (val2
)))
2464 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2465 == FONT_INVALID_CODE
)
2469 else if (VECTORP (val2
))
2471 /* At most one character in the vector must be supported. */
2472 for (i
= 0; i
< ASIZE (val2
); i
++)
2474 if (! CHARACTERP (AREF (val2
, i
)))
2476 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2477 != FONT_INVALID_CODE
)
2480 if (i
== ASIZE (val2
))
2485 else if (EQ (key
, QCotf
))
2489 if (! FONT_OBJECT_P (font
))
2491 fontp
= XFONT_OBJECT (font
);
2492 if (! fontp
->driver
->otf_capability
)
2494 val2
= fontp
->driver
->otf_capability (fontp
);
2495 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2506 Each font backend has the callback function get_cache, and it
2507 returns a cons cell of which cdr part can be freely used for
2508 caching fonts. The cons cell may be shared by multiple frames
2509 and/or multiple font drivers. So, we arrange the cdr part as this:
2511 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2513 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2514 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2515 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2517 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2518 static void font_finish_cache (struct frame
*, struct font_driver
*);
2519 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2520 static void font_clear_cache (struct frame
*, Lisp_Object
,
2521 struct font_driver
*);
2524 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2526 Lisp_Object cache
, val
;
2528 cache
= driver
->get_cache (f
);
2530 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2534 val
= list2 (driver
->type
, make_number (1));
2535 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2539 val
= XCDR (XCAR (val
));
2540 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2546 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2548 Lisp_Object cache
, val
, tmp
;
2551 cache
= driver
->get_cache (f
);
2553 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2554 cache
= val
, val
= XCDR (val
);
2555 eassert (! NILP (val
));
2556 tmp
= XCDR (XCAR (val
));
2557 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2558 if (XINT (XCAR (tmp
)) == 0)
2560 font_clear_cache (f
, XCAR (val
), driver
);
2561 XSETCDR (cache
, XCDR (val
));
2567 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2569 Lisp_Object val
= driver
->get_cache (f
);
2570 Lisp_Object type
= driver
->type
;
2572 eassert (CONSP (val
));
2573 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2574 eassert (CONSP (val
));
2575 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2576 val
= XCDR (XCAR (val
));
2582 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2584 Lisp_Object tail
, elt
;
2588 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2589 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2592 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2593 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2596 eassert (VECTORP (elt
));
2597 for (i
= 0; i
< ASIZE (elt
); i
++)
2599 entity
= AREF (elt
, i
);
2601 if (FONT_ENTITY_P (entity
)
2602 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2604 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2606 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2608 Lisp_Object val
= XCAR (objlist
);
2609 struct font
*font
= XFONT_OBJECT (val
);
2611 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2613 eassert (font
&& driver
== font
->driver
);
2614 driver
->close (font
);
2617 if (driver
->free_entity
)
2618 driver
->free_entity (entity
);
2623 XSETCDR (cache
, Qnil
);
2627 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2629 /* Check each font-entity in VEC, and return a list of font-entities
2630 that satisfy these conditions:
2631 (1) matches with SPEC and SIZE if SPEC is not nil, and
2632 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2636 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2638 Lisp_Object entity
, val
;
2639 enum font_property_index prop
;
2642 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2644 entity
= AREF (vec
, i
);
2645 if (! NILP (Vface_ignored_fonts
))
2649 Lisp_Object tail
, regexp
;
2651 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2654 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2656 regexp
= XCAR (tail
);
2657 if (STRINGP (regexp
)
2658 && fast_c_string_match_ignore_case (regexp
, name
,
2668 val
= Fcons (entity
, val
);
2671 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2672 if (INTEGERP (AREF (spec
, prop
))
2673 && ((XINT (AREF (spec
, prop
)) >> 8)
2674 != (XINT (AREF (entity
, prop
)) >> 8)))
2675 prop
= FONT_SPEC_MAX
;
2676 if (prop
< FONT_SPEC_MAX
2678 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2680 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2682 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2683 prop
= FONT_SPEC_MAX
;
2685 if (prop
< FONT_SPEC_MAX
2686 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2687 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2688 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2689 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2690 prop
= FONT_SPEC_MAX
;
2691 if (prop
< FONT_SPEC_MAX
2692 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2693 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2694 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2695 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2696 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2697 prop
= FONT_SPEC_MAX
;
2698 if (prop
< FONT_SPEC_MAX
)
2699 val
= Fcons (entity
, val
);
2701 return (Fvconcat (1, &val
));
2705 /* Return a list of vectors of font-entities matching with SPEC on
2706 FRAME. Each elements in the list is a vector of entities from the
2707 same font-driver. */
2710 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2712 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2713 Lisp_Object ftype
, val
;
2714 Lisp_Object list
= Qnil
;
2716 bool need_filtering
= 0;
2719 eassert (FONT_SPEC_P (spec
));
2721 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2722 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2723 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2724 size
= font_pixel_size (f
, spec
);
2728 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2729 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2730 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2731 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2732 if (i
!= FONT_SPACING_INDEX
)
2734 ASET (scratch_font_spec
, i
, Qnil
);
2735 if (! NILP (AREF (spec
, i
)))
2738 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2739 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2741 for (; driver_list
; driver_list
= driver_list
->next
)
2743 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2745 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2747 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2748 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2753 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2756 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2758 val
= Fvconcat (1, &val
);
2759 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2760 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2763 if (VECTORP (val
) && ASIZE (val
) > 0
2765 || ! NILP (Vface_ignored_fonts
)))
2766 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2767 if (VECTORP (val
) && ASIZE (val
) > 0)
2768 list
= Fcons (val
, list
);
2771 list
= Fnreverse (list
);
2772 FONT_ADD_LOG ("list", spec
, list
);
2777 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2778 nil, is an array of face's attributes, which specifies preferred
2779 font-related attributes. */
2782 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2784 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2785 Lisp_Object ftype
, size
, entity
;
2786 Lisp_Object work
= copy_font_spec (spec
);
2788 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2789 size
= AREF (spec
, FONT_SIZE_INDEX
);
2792 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2793 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2794 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2795 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2798 for (; driver_list
; driver_list
= driver_list
->next
)
2800 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2802 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2804 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2805 entity
= assoc_no_quit (work
, XCDR (cache
));
2807 entity
= AREF (XCDR (entity
), 0);
2810 entity
= driver_list
->driver
->match (f
, work
);
2813 Lisp_Object copy
= copy_font_spec (work
);
2814 Lisp_Object match
= Fvector (1, &entity
);
2816 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2817 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2820 if (! NILP (entity
))
2823 FONT_ADD_LOG ("match", work
, entity
);
2828 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2829 opened font object. */
2832 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2834 struct font_driver_list
*driver_list
;
2835 Lisp_Object objlist
, size
, val
, font_object
;
2837 int min_width
, height
, psize
;
2839 eassert (FONT_ENTITY_P (entity
));
2840 size
= AREF (entity
, FONT_SIZE_INDEX
);
2841 if (XINT (size
) != 0)
2842 pixel_size
= XINT (size
);
2844 val
= AREF (entity
, FONT_TYPE_INDEX
);
2845 for (driver_list
= f
->font_driver_list
;
2846 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2847 driver_list
= driver_list
->next
);
2851 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2852 objlist
= XCDR (objlist
))
2854 Lisp_Object fn
= XCAR (objlist
);
2855 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2856 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2858 if (driver_list
->driver
->cached_font_ok
== NULL
2859 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2864 /* We always open a font of manageable size; i.e non-zero average
2865 width and height. */
2866 for (psize
= pixel_size
; ; psize
++)
2868 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2869 if (NILP (font_object
))
2871 font
= XFONT_OBJECT (font_object
);
2872 if (font
->average_width
> 0 && font
->height
> 0)
2875 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2876 FONT_ADD_LOG ("open", entity
, font_object
);
2877 ASET (entity
, FONT_OBJLIST_INDEX
,
2878 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2880 font
= XFONT_OBJECT (font_object
);
2881 min_width
= (font
->min_width
? font
->min_width
2882 : font
->average_width
? font
->average_width
2883 : font
->space_width
? font
->space_width
2885 height
= (font
->height
? font
->height
: 1);
2886 #ifdef HAVE_WINDOW_SYSTEM
2887 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2888 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2890 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2891 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2892 f
->fonts_changed
= 1;
2896 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2897 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2898 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2899 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2907 /* Close FONT_OBJECT that is opened on frame F. */
2910 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2912 struct font
*font
= XFONT_OBJECT (font_object
);
2914 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2915 /* Already closed. */
2917 FONT_ADD_LOG ("close", font_object
, Qnil
);
2918 font
->driver
->close (font
);
2919 #ifdef HAVE_WINDOW_SYSTEM
2920 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2921 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2926 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2927 FONT is a font-entity and it must be opened to check. */
2930 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2934 if (FONT_ENTITY_P (font
))
2936 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2937 struct font_driver_list
*driver_list
;
2939 for (driver_list
= f
->font_driver_list
;
2940 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2941 driver_list
= driver_list
->next
);
2944 if (! driver_list
->driver
->has_char
)
2946 return driver_list
->driver
->has_char (font
, c
);
2949 eassert (FONT_OBJECT_P (font
));
2950 fontp
= XFONT_OBJECT (font
);
2951 if (fontp
->driver
->has_char
)
2953 int result
= fontp
->driver
->has_char (font
, c
);
2958 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2962 /* Return the glyph ID of FONT_OBJECT for character C. */
2965 font_encode_char (Lisp_Object font_object
, int c
)
2969 eassert (FONT_OBJECT_P (font_object
));
2970 font
= XFONT_OBJECT (font_object
);
2971 return font
->driver
->encode_char (font
, c
);
2975 /* Return the name of FONT_OBJECT. */
2978 font_get_name (Lisp_Object font_object
)
2980 eassert (FONT_OBJECT_P (font_object
));
2981 return AREF (font_object
, FONT_NAME_INDEX
);
2985 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2986 could not be parsed by font_parse_name, return Qnil. */
2989 font_spec_from_name (Lisp_Object font_name
)
2991 Lisp_Object spec
= Ffont_spec (0, NULL
);
2993 CHECK_STRING (font_name
);
2994 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2996 font_put_extra (spec
, QCname
, font_name
);
2997 font_put_extra (spec
, QCuser_spec
, font_name
);
3003 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3005 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3010 if (! NILP (Ffont_get (font
, QCname
)))
3012 font
= copy_font_spec (font
);
3013 font_put_extra (font
, QCname
, Qnil
);
3016 if (NILP (AREF (font
, prop
))
3017 && prop
!= FONT_FAMILY_INDEX
3018 && prop
!= FONT_FOUNDRY_INDEX
3019 && prop
!= FONT_WIDTH_INDEX
3020 && prop
!= FONT_SIZE_INDEX
)
3022 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3023 font
= copy_font_spec (font
);
3024 ASET (font
, prop
, Qnil
);
3025 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3027 if (prop
== FONT_FAMILY_INDEX
)
3029 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3030 /* If we are setting the font family, we must also clear
3031 FONT_WIDTH_INDEX to avoid rejecting families that lack
3032 support for some widths. */
3033 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3035 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3036 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3037 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3038 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3039 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3040 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3042 else if (prop
== FONT_SIZE_INDEX
)
3044 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3045 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3046 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3048 else if (prop
== FONT_WIDTH_INDEX
)
3049 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3050 attrs
[LFACE_FONT_INDEX
] = font
;
3053 /* Select a font from ENTITIES (list of font-entity vectors) that
3054 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3057 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3058 Lisp_Object
*attrs
, int pixel_size
, int c
)
3060 Lisp_Object font_entity
;
3064 if (NILP (XCDR (entities
))
3065 && ASIZE (XCAR (entities
)) == 1)
3067 font_entity
= AREF (XCAR (entities
), 0);
3068 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3073 /* Sort fonts by properties specified in ATTRS. */
3074 prefer
= scratch_font_prefer
;
3076 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3077 ASET (prefer
, i
, Qnil
);
3078 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3080 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3082 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3083 ASET (prefer
, i
, AREF (face_font
, i
));
3085 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3086 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3087 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3088 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3089 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3090 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3091 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3093 return font_sort_entities (entities
, prefer
, f
, c
);
3096 /* Return a font-entity that satisfies SPEC and is the best match for
3097 face's font related attributes in ATTRS. C, if not negative, is a
3098 character that the entity must support. */
3101 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3104 Lisp_Object entities
, val
;
3105 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3110 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3111 if (NILP (registry
[0]))
3113 registry
[0] = DEFAULT_ENCODING
;
3114 registry
[1] = Qascii_0
;
3115 registry
[2] = zero_vector
;
3118 registry
[1] = zero_vector
;
3120 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3122 struct charset
*encoding
, *repertory
;
3124 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3125 &encoding
, &repertory
) < 0)
3128 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3130 else if (c
> encoding
->max_char
)
3134 work
= copy_font_spec (spec
);
3135 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3136 pixel_size
= font_pixel_size (f
, spec
);
3137 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3139 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3141 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3145 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3146 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3147 if (! NILP (foundry
[0]))
3148 foundry
[1] = zero_vector
;
3149 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3151 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3152 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3154 foundry
[2] = zero_vector
;
3157 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3159 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3160 if (! NILP (adstyle
[0]))
3161 adstyle
[1] = zero_vector
;
3162 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3164 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3166 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3168 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3170 adstyle
[2] = zero_vector
;
3173 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3176 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3179 val
= AREF (work
, FONT_FAMILY_INDEX
);
3180 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3182 val
= attrs
[LFACE_FAMILY_INDEX
];
3183 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3187 family
= alloca ((sizeof family
[0]) * 2);
3189 family
[1] = zero_vector
; /* terminator. */
3194 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3196 if (! NILP (alters
))
3198 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3199 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3200 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3201 family
[i
] = XCAR (alters
);
3202 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3204 family
[i
] = zero_vector
;
3208 family
= alloca ((sizeof family
[0]) * 3);
3211 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3213 family
[i
] = zero_vector
;
3217 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3219 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3220 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3222 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3223 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3225 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3226 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3228 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3229 entities
= font_list_entities (f
, work
);
3230 if (! NILP (entities
))
3232 val
= font_select_entity (f
, entities
,
3233 attrs
, pixel_size
, c
);
3251 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3255 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3256 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3257 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3260 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3261 size
= font_pixel_size (f
, spec
);
3265 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3266 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3269 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3270 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3271 eassert (INTEGERP (height
));
3276 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3280 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3281 size
= (NUMBERP (ffsize
)
3282 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3286 size
*= font_rescale_ratio (entity
);
3289 return font_open_entity (f
, entity
, size
);
3293 /* Find a font that satisfies SPEC and is the best match for
3294 face's attributes in ATTRS on FRAME, and return the opened
3298 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3300 Lisp_Object entity
, name
;
3302 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3305 /* No font is listed for SPEC, but each font-backend may have
3306 different criteria about "font matching". So, try it. */
3307 entity
= font_matching_entity (f
, attrs
, spec
);
3311 /* Don't lose the original name that was put in initially. We need
3312 it to re-apply the font when font parameters (like hinting or dpi) have
3314 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3317 name
= Ffont_get (spec
, QCuser_spec
);
3318 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3324 /* Make FACE on frame F ready to use the font opened for FACE. */
3327 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3329 if (face
->font
->driver
->prepare_face
)
3330 face
->font
->driver
->prepare_face (f
, face
);
3334 /* Make FACE on frame F stop using the font opened for FACE. */
3337 font_done_for_face (struct frame
*f
, struct face
*face
)
3339 if (face
->font
->driver
->done_face
)
3340 face
->font
->driver
->done_face (f
, face
);
3344 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3345 font is found, return Qnil. */
3348 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3350 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3352 /* We set up the default font-related attributes of a face to prefer
3354 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3355 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3356 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3358 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3360 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3362 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3364 return font_load_for_lface (f
, attrs
, spec
);
3368 /* Open a font that matches NAME on frame F. If no proper font is
3369 found, return Qnil. */
3372 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3374 Lisp_Object args
[2];
3375 Lisp_Object spec
, ret
;
3379 spec
= Ffont_spec (2, args
);
3380 ret
= font_open_by_spec (f
, spec
);
3381 /* Do not lose name originally put in. */
3383 font_put_extra (ret
, QCuser_spec
, args
[1]);
3389 /* Register font-driver DRIVER. This function is used in two ways.
3391 The first is with frame F non-NULL. In this case, make DRIVER
3392 available (but not yet activated) on F. All frame creators
3393 (e.g. Fx_create_frame) must call this function at least once with
3394 an available font-driver.
3396 The second is with frame F NULL. In this case, DRIVER is globally
3397 registered in the variable `font_driver_list'. All font-driver
3398 implementations must call this function in its syms_of_XXXX
3399 (e.g. syms_of_xfont). */
3402 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3404 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3405 struct font_driver_list
*prev
, *list
;
3407 #ifdef HAVE_WINDOW_SYSTEM
3408 if (f
&& ! driver
->draw
)
3409 error ("Unusable font driver for a frame: %s",
3410 SDATA (SYMBOL_NAME (driver
->type
)));
3411 #endif /* HAVE_WINDOW_SYSTEM */
3413 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3414 if (EQ (list
->driver
->type
, driver
->type
))
3415 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3417 list
= xmalloc (sizeof *list
);
3419 list
->driver
= driver
;
3424 f
->font_driver_list
= list
;
3426 font_driver_list
= list
;
3432 free_font_driver_list (struct frame
*f
)
3434 struct font_driver_list
*list
, *next
;
3436 for (list
= f
->font_driver_list
; list
; list
= next
)
3441 f
->font_driver_list
= NULL
;
3445 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3446 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3447 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3449 A caller must free all realized faces if any in advance. The
3450 return value is a list of font backends actually made used on
3454 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3456 Lisp_Object active_drivers
= Qnil
;
3457 struct font_driver_list
*list
;
3459 /* At first, turn off non-requested drivers, and turn on requested
3461 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3463 struct font_driver
*driver
= list
->driver
;
3464 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3469 if (driver
->end_for_frame
)
3470 driver
->end_for_frame (f
);
3471 font_finish_cache (f
, driver
);
3476 if (! driver
->start_for_frame
3477 || driver
->start_for_frame (f
) == 0)
3479 font_prepare_cache (f
, driver
);
3486 if (NILP (new_drivers
))
3489 if (! EQ (new_drivers
, Qt
))
3491 /* Re-order the driver list according to new_drivers. */
3492 struct font_driver_list
**list_table
, **next
;
3496 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3497 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3499 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3500 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3503 list_table
[i
++] = list
;
3505 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3507 list_table
[i
++] = list
;
3508 list_table
[i
] = NULL
;
3510 next
= &f
->font_driver_list
;
3511 for (i
= 0; list_table
[i
]; i
++)
3513 *next
= list_table
[i
];
3514 next
= &(*next
)->next
;
3518 if (! f
->font_driver_list
->on
)
3519 { /* None of the drivers is enabled: enable them all.
3520 Happens if you set the list of drivers to (xft x) in your .emacs
3521 and then use it under w32 or ns. */
3522 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3524 struct font_driver
*driver
= list
->driver
;
3525 eassert (! list
->on
);
3526 if (! driver
->start_for_frame
3527 || driver
->start_for_frame (f
) == 0)
3529 font_prepare_cache (f
, driver
);
3536 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3538 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3539 return active_drivers
;
3542 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
3545 font_put_frame_data (struct frame
*f
, Lisp_Object driver
, void *data
)
3547 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3550 f
->font_data
= Fdelq (val
, f
->font_data
);
3554 f
->font_data
= Fcons (Fcons (driver
, make_save_ptr (data
)),
3557 XSETCDR (val
, make_save_ptr (data
));
3562 font_get_frame_data (struct frame
*f
, Lisp_Object driver
)
3564 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3566 return NILP (val
) ? NULL
: XSAVE_POINTER (XCDR (val
), 0);
3569 #endif /* HAVE_XFT || HAVE_FREETYPE */
3571 /* Sets attributes on a font. Any properties that appear in ALIST and
3572 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3573 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3574 arrays of strings. This function is intended for use by the font
3575 drivers to implement their specific font_filter_properties. */
3577 font_filter_properties (Lisp_Object font
,
3579 const char *const boolean_properties
[],
3580 const char *const non_boolean_properties
[])
3585 /* Set boolean values to Qt or Qnil. */
3586 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3587 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3589 Lisp_Object key
= XCAR (XCAR (it
));
3590 Lisp_Object val
= XCDR (XCAR (it
));
3591 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3593 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3595 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3596 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3599 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3600 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3601 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3602 || strcmp ("Off", str
) == 0)
3607 Ffont_put (font
, key
, val
);
3611 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3612 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3614 Lisp_Object key
= XCAR (XCAR (it
));
3615 Lisp_Object val
= XCDR (XCAR (it
));
3616 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3617 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3618 Ffont_put (font
, key
, val
);
3623 /* Return the font used to draw character C by FACE at buffer position
3624 POS in window W. If STRING is non-nil, it is a string containing C
3625 at index POS. If C is negative, get C from the current buffer or
3629 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3634 Lisp_Object font_object
;
3636 multibyte
= (NILP (string
)
3637 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3638 : STRING_MULTIBYTE (string
));
3645 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3647 c
= FETCH_CHAR (pos_byte
);
3650 c
= FETCH_BYTE (pos
);
3656 multibyte
= STRING_MULTIBYTE (string
);
3659 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3661 str
= SDATA (string
) + pos_byte
;
3662 c
= STRING_CHAR (str
);
3665 c
= SDATA (string
)[pos
];
3669 f
= XFRAME (w
->frame
);
3670 if (! FRAME_WINDOW_P (f
))
3677 if (STRINGP (string
))
3678 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3679 DEFAULT_FACE_ID
, 0);
3681 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3683 face
= FACE_FROM_ID (f
, face_id
);
3687 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3688 face
= FACE_FROM_ID (f
, face_id
);
3693 XSETFONT (font_object
, face
->font
);
3698 #ifdef HAVE_WINDOW_SYSTEM
3700 /* Check how many characters after character/byte position POS/POS_BYTE
3701 (at most to *LIMIT) can be displayed by the same font in the window W.
3702 FACE, if non-NULL, is the face selected for the character at POS.
3703 If STRING is not nil, it is the string to check instead of the current
3704 buffer. In that case, FACE must be not NULL.
3706 The return value is the font-object for the character at POS.
3707 *LIMIT is set to the position where that font can't be used.
3709 It is assured that the current buffer (or STRING) is multibyte. */
3712 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3713 struct window
*w
, struct face
*face
, Lisp_Object string
)
3717 Lisp_Object font_object
= Qnil
;
3725 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3727 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3733 while (pos
< *limit
)
3735 Lisp_Object category
;
3738 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3740 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3741 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3742 if (INTEGERP (category
)
3743 && (XINT (category
) == UNICODE_CATEGORY_Cf
3744 || CHAR_VARIATION_SELECTOR_P (c
)))
3746 if (NILP (font_object
))
3748 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3749 if (NILP (font_object
))
3753 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3763 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3764 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3765 Return nil otherwise.
3766 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3767 which kind of font it is. It must be one of `font-spec', `font-entity',
3769 (Lisp_Object object
, Lisp_Object extra_type
)
3771 if (NILP (extra_type
))
3772 return (FONTP (object
) ? Qt
: Qnil
);
3773 if (EQ (extra_type
, Qfont_spec
))
3774 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3775 if (EQ (extra_type
, Qfont_entity
))
3776 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3777 if (EQ (extra_type
, Qfont_object
))
3778 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3779 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3782 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3783 doc
: /* Return a newly created font-spec with arguments as properties.
3785 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3786 valid font property name listed below:
3788 `:family', `:weight', `:slant', `:width'
3790 They are the same as face attributes of the same name. See
3791 `set-face-attribute'.
3795 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3799 VALUE must be a string or a symbol specifying the additional
3800 typographic style information of a font, e.g. ``sans''.
3804 VALUE must be a string or a symbol specifying the charset registry and
3805 encoding of a font, e.g. ``iso8859-1''.
3809 VALUE must be a non-negative integer or a floating point number
3810 specifying the font size. It specifies the font size in pixels (if
3811 VALUE is an integer), or in points (if VALUE is a float).
3815 VALUE must be a string of XLFD-style or fontconfig-style font name.
3819 VALUE must be a symbol representing a script that the font must
3820 support. It may be a symbol representing a subgroup of a script
3821 listed in the variable `script-representative-chars'.
3825 VALUE must be a symbol of two-letter ISO-639 language names,
3830 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3831 required OpenType features.
3833 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3834 LANGSYS-TAG: OpenType language system tag symbol,
3835 or nil for the default language system.
3836 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3837 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3839 GSUB and GPOS may contain `nil' element. In such a case, the font
3840 must not have any of the remaining elements.
3842 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3843 be an OpenType font whose GPOS table of `thai' script's default
3844 language system must contain `mark' feature.
3846 usage: (font-spec ARGS...) */)
3847 (ptrdiff_t nargs
, Lisp_Object
*args
)
3849 Lisp_Object spec
= font_make_spec ();
3852 for (i
= 0; i
< nargs
; i
+= 2)
3854 Lisp_Object key
= args
[i
], val
;
3858 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3861 if (EQ (key
, QCname
))
3864 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3865 error ("Invalid font name: %s", SSDATA (val
));
3866 font_put_extra (spec
, key
, val
);
3870 int idx
= get_font_prop_index (key
);
3874 val
= font_prop_validate (idx
, Qnil
, val
);
3875 if (idx
< FONT_EXTRA_INDEX
)
3876 ASET (spec
, idx
, val
);
3878 font_put_extra (spec
, key
, val
);
3881 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3887 /* Return a copy of FONT as a font-spec. */
3889 copy_font_spec (Lisp_Object font
)
3891 Lisp_Object new_spec
, tail
, prev
, extra
;
3895 new_spec
= font_make_spec ();
3896 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3897 ASET (new_spec
, i
, AREF (font
, i
));
3898 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3899 /* We must remove :font-entity property. */
3900 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3901 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3904 extra
= XCDR (extra
);
3906 XSETCDR (prev
, XCDR (tail
));
3909 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3913 /* Merge font-specs FROM and TO, and return a new font-spec.
3914 Every specified property in FROM overrides the corresponding
3917 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3919 Lisp_Object extra
, tail
;
3924 to
= copy_font_spec (to
);
3925 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3926 ASET (to
, i
, AREF (from
, i
));
3927 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3928 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3929 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3931 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3934 XSETCDR (slot
, XCDR (XCAR (tail
)));
3936 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3938 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3942 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3943 doc
: /* Return the value of FONT's property KEY.
3944 FONT is a font-spec, a font-entity, or a font-object.
3945 KEY is any symbol, but these are reserved for specific meanings:
3946 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3947 :size, :name, :script, :otf
3948 See the documentation of `font-spec' for their meanings.
3949 In addition, if FONT is a font-entity or a font-object, values of
3950 :script and :otf are different from those of a font-spec as below:
3952 The value of :script may be a list of scripts that are supported by the font.
3954 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3955 representing the OpenType features supported by the font by this form:
3956 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3957 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3959 (Lisp_Object font
, Lisp_Object key
)
3967 idx
= get_font_prop_index (key
);
3968 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3969 return font_style_symbolic (font
, idx
, 0);
3970 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3971 return AREF (font
, idx
);
3972 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3973 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3975 struct font
*fontp
= XFONT_OBJECT (font
);
3977 if (fontp
->driver
->otf_capability
)
3978 val
= fontp
->driver
->otf_capability (fontp
);
3980 val
= Fcons (Qnil
, Qnil
);
3987 #ifdef HAVE_WINDOW_SYSTEM
3989 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3990 doc
: /* Return a plist of face attributes generated by FONT.
3991 FONT is a font name, a font-spec, a font-entity, or a font-object.
3992 The return value is a list of the form
3994 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3996 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3997 compatible with `set-face-attribute'. Some of these key-attribute pairs
3998 may be omitted from the list if they are not specified by FONT.
4000 The optional argument FRAME specifies the frame that the face attributes
4001 are to be displayed on. If omitted, the selected frame is used. */)
4002 (Lisp_Object font
, Lisp_Object frame
)
4004 struct frame
*f
= decode_live_frame (frame
);
4005 Lisp_Object plist
[10];
4011 int fontset
= fs_query_fontset (font
, 0);
4012 Lisp_Object name
= font
;
4014 font
= fontset_ascii (fontset
);
4015 font
= font_spec_from_name (name
);
4017 signal_error ("Invalid font name", name
);
4019 else if (! FONTP (font
))
4020 signal_error ("Invalid font object", font
);
4022 val
= AREF (font
, FONT_FAMILY_INDEX
);
4025 plist
[n
++] = QCfamily
;
4026 plist
[n
++] = SYMBOL_NAME (val
);
4029 val
= AREF (font
, FONT_SIZE_INDEX
);
4032 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4033 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4034 plist
[n
++] = QCheight
;
4035 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4037 else if (FLOATP (val
))
4039 plist
[n
++] = QCheight
;
4040 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4043 val
= FONT_WEIGHT_FOR_FACE (font
);
4046 plist
[n
++] = QCweight
;
4050 val
= FONT_SLANT_FOR_FACE (font
);
4053 plist
[n
++] = QCslant
;
4057 val
= FONT_WIDTH_FOR_FACE (font
);
4060 plist
[n
++] = QCwidth
;
4064 return Flist (n
, plist
);
4069 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4070 doc
: /* Set one property of FONT: give property KEY value VAL.
4071 FONT is a font-spec, a font-entity, or a font-object.
4073 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4074 accepted by the function `font-spec' (which see), VAL must be what
4075 allowed in `font-spec'.
4077 If FONT is a font-entity or a font-object, KEY must not be the one
4078 accepted by `font-spec'. */)
4079 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4083 idx
= get_font_prop_index (prop
);
4084 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4086 CHECK_FONT_SPEC (font
);
4087 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4091 if (EQ (prop
, QCname
)
4092 || EQ (prop
, QCscript
)
4093 || EQ (prop
, QClang
)
4094 || EQ (prop
, QCotf
))
4095 CHECK_FONT_SPEC (font
);
4098 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4103 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4104 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4105 Optional 2nd argument FRAME specifies the target frame.
4106 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4107 Optional 4th argument PREFER, if non-nil, is a font-spec to
4108 control the order of the returned list. Fonts are sorted by
4109 how close they are to PREFER. */)
4110 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4112 struct frame
*f
= decode_live_frame (frame
);
4113 Lisp_Object vec
, list
;
4116 CHECK_FONT_SPEC (font_spec
);
4124 if (! NILP (prefer
))
4125 CHECK_FONT_SPEC (prefer
);
4127 list
= font_list_entities (f
, font_spec
);
4130 if (NILP (XCDR (list
))
4131 && ASIZE (XCAR (list
)) == 1)
4132 return list1 (AREF (XCAR (list
), 0));
4134 if (! NILP (prefer
))
4135 vec
= font_sort_entities (list
, prefer
, f
, 0);
4137 vec
= font_vconcat_entity_vectors (list
);
4138 if (n
== 0 || n
>= ASIZE (vec
))
4140 Lisp_Object args
[2];
4144 list
= Fappend (2, args
);
4148 for (list
= Qnil
, n
--; n
>= 0; n
--)
4149 list
= Fcons (AREF (vec
, n
), list
);
4154 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4155 doc
: /* List available font families on the current frame.
4156 If FRAME is omitted or nil, the selected frame is used. */)
4159 struct frame
*f
= decode_live_frame (frame
);
4160 struct font_driver_list
*driver_list
;
4161 Lisp_Object list
= Qnil
;
4163 for (driver_list
= f
->font_driver_list
; driver_list
;
4164 driver_list
= driver_list
->next
)
4165 if (driver_list
->driver
->list_family
)
4167 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4168 Lisp_Object tail
= list
;
4170 for (; CONSP (val
); val
= XCDR (val
))
4171 if (NILP (Fmemq (XCAR (val
), tail
))
4172 && SYMBOLP (XCAR (val
)))
4173 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4178 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4179 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4180 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4181 (Lisp_Object font_spec
, Lisp_Object frame
)
4183 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4190 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4191 doc
: /* Return XLFD name of FONT.
4192 FONT is a font-spec, font-entity, or font-object.
4193 If the name is too long for XLFD (maximum 255 chars), return nil.
4194 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4195 the consecutive wildcards are folded into one. */)
4196 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4199 int namelen
, pixel_size
= 0;
4203 if (FONT_OBJECT_P (font
))
4205 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4207 if (STRINGP (font_name
)
4208 && SDATA (font_name
)[0] == '-')
4210 if (NILP (fold_wildcards
))
4212 strcpy (name
, SSDATA (font_name
));
4213 namelen
= SBYTES (font_name
);
4216 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4218 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4222 if (! NILP (fold_wildcards
))
4224 char *p0
= name
, *p1
;
4226 while ((p1
= strstr (p0
, "-*-*")))
4228 strcpy (p1
, p1
+ 2);
4234 return make_string (name
, namelen
);
4238 clear_font_cache (struct frame
*f
)
4240 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4242 for (; driver_list
; driver_list
= driver_list
->next
)
4243 if (driver_list
->on
)
4245 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4249 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4251 eassert (! NILP (val
));
4252 tmp
= XCDR (XCAR (val
));
4253 if (XINT (XCAR (tmp
)) == 0)
4255 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4256 XSETCDR (cache
, XCDR (val
));
4261 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4262 doc
: /* Clear font cache of each frame. */)
4265 Lisp_Object list
, frame
;
4267 FOR_EACH_FRAME (list
, frame
)
4268 clear_font_cache (XFRAME (frame
));
4275 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4277 struct font
*font
= XFONT_OBJECT (font_object
);
4278 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4279 struct font_metrics metrics
;
4281 LGLYPH_SET_CODE (glyph
, code
);
4282 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4283 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4284 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4285 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4286 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4287 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4291 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4292 doc
: /* Shape the glyph-string GSTRING.
4293 Shaping means substituting glyphs and/or adjusting positions of glyphs
4294 to get the correct visual image of character sequences set in the
4295 header of the glyph-string.
4297 If the shaping was successful, the value is GSTRING itself or a newly
4298 created glyph-string. Otherwise, the value is nil.
4300 See the documentation of `composition-get-gstring' for the format of
4302 (Lisp_Object gstring
)
4305 Lisp_Object font_object
, n
, glyph
;
4306 ptrdiff_t i
, from
, to
;
4308 if (! composition_gstring_p (gstring
))
4309 signal_error ("Invalid glyph-string: ", gstring
);
4310 if (! NILP (LGSTRING_ID (gstring
)))
4312 font_object
= LGSTRING_FONT (gstring
);
4313 CHECK_FONT_OBJECT (font_object
);
4314 font
= XFONT_OBJECT (font_object
);
4315 if (! font
->driver
->shape
)
4318 /* Try at most three times with larger gstring each time. */
4319 for (i
= 0; i
< 3; i
++)
4321 n
= font
->driver
->shape (gstring
);
4324 gstring
= larger_vector (gstring
,
4325 LGSTRING_GLYPH_LEN (gstring
), -1);
4327 if (i
== 3 || XINT (n
) == 0)
4329 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4330 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4332 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4333 GLYPHS covers all characters (except for the last few ones) in
4334 GSTRING. More formally, provided that NCHARS is the number of
4335 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4336 and TO_IDX of each glyph must satisfy these conditions:
4338 GLYPHS[0].FROM_IDX == 0
4339 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4340 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4341 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4342 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4344 ;; Be sure to cover all characters.
4345 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4346 glyph
= LGSTRING_GLYPH (gstring
, 0);
4347 from
= LGLYPH_FROM (glyph
);
4348 to
= LGLYPH_TO (glyph
);
4349 if (from
!= 0 || to
< from
)
4351 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4353 glyph
= LGSTRING_GLYPH (gstring
, i
);
4356 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4357 && (LGLYPH_FROM (glyph
) == from
4358 ? LGLYPH_TO (glyph
) == to
4359 : LGLYPH_FROM (glyph
) == to
+ 1)))
4361 from
= LGLYPH_FROM (glyph
);
4362 to
= LGLYPH_TO (glyph
);
4364 return composition_gstring_put_cache (gstring
, XINT (n
));
4370 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4372 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4373 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4375 VARIATION-SELECTOR is a character code of variation selection
4376 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4377 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4378 (Lisp_Object font_object
, Lisp_Object character
)
4380 unsigned variations
[256];
4385 CHECK_FONT_OBJECT (font_object
);
4386 CHECK_CHARACTER (character
);
4387 font
= XFONT_OBJECT (font_object
);
4388 if (! font
->driver
->get_variation_glyphs
)
4390 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4394 for (i
= 0; i
< 255; i
++)
4397 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4398 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4399 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4406 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4407 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4408 OTF-FEATURES specifies which features to apply in this format:
4409 (SCRIPT LANGSYS GSUB GPOS)
4411 SCRIPT is a symbol specifying a script tag of OpenType,
4412 LANGSYS is a symbol specifying a langsys tag of OpenType,
4413 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4415 If LANGSYS is nil, the default langsys is selected.
4417 The features are applied in the order they appear in the list. The
4418 symbol `*' means to apply all available features not present in this
4419 list, and the remaining features are ignored. For instance, (vatu
4420 pstf * haln) is to apply vatu and pstf in this order, then to apply
4421 all available features other than vatu, pstf, and haln.
4423 The features are applied to the glyphs in the range FROM and TO of
4424 the glyph-string GSTRING-IN.
4426 If some feature is actually applicable, the resulting glyphs are
4427 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4428 this case, the value is the number of produced glyphs.
4430 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4433 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4434 produced in GSTRING-OUT, and the value is nil.
4436 See the documentation of `composition-get-gstring' for the format of
4438 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4440 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4445 check_otf_features (otf_features
);
4446 CHECK_FONT_OBJECT (font_object
);
4447 font
= XFONT_OBJECT (font_object
);
4448 if (! font
->driver
->otf_drive
)
4449 error ("Font backend %s can't drive OpenType GSUB table",
4450 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4451 CHECK_CONS (otf_features
);
4452 CHECK_SYMBOL (XCAR (otf_features
));
4453 val
= XCDR (otf_features
);
4454 CHECK_SYMBOL (XCAR (val
));
4455 val
= XCDR (otf_features
);
4458 len
= check_gstring (gstring_in
);
4459 CHECK_VECTOR (gstring_out
);
4460 CHECK_NATNUM (from
);
4462 CHECK_NATNUM (index
);
4464 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4465 args_out_of_range_3 (from
, to
, make_number (len
));
4466 if (XINT (index
) >= ASIZE (gstring_out
))
4467 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4468 num
= font
->driver
->otf_drive (font
, otf_features
,
4469 gstring_in
, XINT (from
), XINT (to
),
4470 gstring_out
, XINT (index
), 0);
4473 return make_number (num
);
4476 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4478 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4479 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4481 (SCRIPT LANGSYS FEATURE ...)
4482 See the documentation of `font-drive-otf' for more detail.
4484 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4485 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4486 character code corresponding to the glyph or nil if there's no
4487 corresponding character. */)
4488 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4491 Lisp_Object gstring_in
, gstring_out
, g
;
4492 Lisp_Object alternates
;
4495 CHECK_FONT_GET_OBJECT (font_object
, font
);
4496 if (! font
->driver
->otf_drive
)
4497 error ("Font backend %s can't drive OpenType GSUB table",
4498 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4499 CHECK_CHARACTER (character
);
4500 CHECK_CONS (otf_features
);
4502 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4503 g
= LGSTRING_GLYPH (gstring_in
, 0);
4504 LGLYPH_SET_CHAR (g
, XINT (character
));
4505 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4506 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4507 gstring_out
, 0, 1)) < 0)
4508 gstring_out
= Ffont_make_gstring (font_object
,
4509 make_number (ASIZE (gstring_out
) * 2));
4511 for (i
= 0; i
< num
; i
++)
4513 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4514 int c
= LGLYPH_CHAR (g
);
4515 unsigned code
= LGLYPH_CODE (g
);
4517 alternates
= Fcons (Fcons (make_number (code
),
4518 c
> 0 ? make_number (c
) : Qnil
),
4521 return Fnreverse (alternates
);
4527 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4528 doc
: /* Open FONT-ENTITY. */)
4529 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4532 struct frame
*f
= decode_live_frame (frame
);
4534 CHECK_FONT_ENTITY (font_entity
);
4537 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4540 CHECK_NUMBER_OR_FLOAT (size
);
4542 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4544 isize
= XINT (size
);
4545 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4546 args_out_of_range (font_entity
, size
);
4550 return font_open_entity (f
, font_entity
, isize
);
4553 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4554 doc
: /* Close FONT-OBJECT. */)
4555 (Lisp_Object font_object
, Lisp_Object frame
)
4557 CHECK_FONT_OBJECT (font_object
);
4558 font_close_object (decode_live_frame (frame
), font_object
);
4562 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4563 doc
: /* Return information about FONT-OBJECT.
4564 The value is a vector:
4565 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4568 NAME is the font name, a string (or nil if the font backend doesn't
4571 FILENAME is the font file name, a string (or nil if the font backend
4572 doesn't provide a file name).
4574 PIXEL-SIZE is a pixel size by which the font is opened.
4576 SIZE is a maximum advance width of the font in pixels.
4578 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4581 CAPABILITY is a list whose first element is a symbol representing the
4582 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4583 remaining elements describe the details of the font capability.
4585 If the font is OpenType font, the form of the list is
4586 \(opentype GSUB GPOS)
4587 where GSUB shows which "GSUB" features the font supports, and GPOS
4588 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4589 lists of the format:
4590 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4592 If the font is not OpenType font, currently the length of the form is
4595 SCRIPT is a symbol representing OpenType script tag.
4597 LANGSYS is a symbol representing OpenType langsys tag, or nil
4598 representing the default langsys.
4600 FEATURE is a symbol representing OpenType feature tag.
4602 If the font is not OpenType font, CAPABILITY is nil. */)
4603 (Lisp_Object font_object
)
4608 CHECK_FONT_GET_OBJECT (font_object
, font
);
4610 val
= make_uninit_vector (9);
4611 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4612 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4613 ASET (val
, 2, make_number (font
->pixel_size
));
4614 ASET (val
, 3, make_number (font
->max_width
));
4615 ASET (val
, 4, make_number (font
->ascent
));
4616 ASET (val
, 5, make_number (font
->descent
));
4617 ASET (val
, 6, make_number (font
->space_width
));
4618 ASET (val
, 7, make_number (font
->average_width
));
4619 if (font
->driver
->otf_capability
)
4620 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4622 ASET (val
, 8, Qnil
);
4626 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4628 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4629 FROM and TO are positions (integers or markers) specifying a region
4630 of the current buffer.
4631 If the optional fourth arg OBJECT is not nil, it is a string or a
4632 vector containing the target characters.
4634 Each element is a vector containing information of a glyph in this format:
4635 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4637 FROM is an index numbers of a character the glyph corresponds to.
4638 TO is the same as FROM.
4639 C is the character of the glyph.
4640 CODE is the glyph-code of C in FONT-OBJECT.
4641 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4642 ADJUSTMENT is always nil.
4643 If FONT-OBJECT doesn't have a glyph for a character,
4644 the corresponding element is nil. */)
4645 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4650 Lisp_Object
*chars
, vec
;
4653 CHECK_FONT_GET_OBJECT (font_object
, font
);
4656 ptrdiff_t charpos
, bytepos
;
4658 validate_region (&from
, &to
);
4661 len
= XFASTINT (to
) - XFASTINT (from
);
4662 SAFE_ALLOCA_LISP (chars
, len
);
4663 charpos
= XFASTINT (from
);
4664 bytepos
= CHAR_TO_BYTE (charpos
);
4665 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4668 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4669 chars
[i
] = make_number (c
);
4672 else if (STRINGP (object
))
4674 const unsigned char *p
;
4676 CHECK_NUMBER (from
);
4678 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4679 || XINT (to
) > SCHARS (object
))
4680 args_out_of_range_3 (object
, from
, to
);
4683 len
= XFASTINT (to
) - XFASTINT (from
);
4684 SAFE_ALLOCA_LISP (chars
, len
);
4686 if (STRING_MULTIBYTE (object
))
4687 for (i
= 0; i
< len
; i
++)
4689 int c
= STRING_CHAR_ADVANCE (p
);
4690 chars
[i
] = make_number (c
);
4693 for (i
= 0; i
< len
; i
++)
4694 chars
[i
] = make_number (p
[i
]);
4698 CHECK_VECTOR (object
);
4699 CHECK_NUMBER (from
);
4701 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4702 || XINT (to
) > ASIZE (object
))
4703 args_out_of_range_3 (object
, from
, to
);
4706 len
= XFASTINT (to
) - XFASTINT (from
);
4707 for (i
= 0; i
< len
; i
++)
4709 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4710 CHECK_CHARACTER (elt
);
4712 chars
= aref_addr (object
, XFASTINT (from
));
4715 vec
= make_uninit_vector (len
);
4716 for (i
= 0; i
< len
; i
++)
4719 int c
= XFASTINT (chars
[i
]);
4721 struct font_metrics metrics
;
4723 code
= font
->driver
->encode_char (font
, c
);
4724 if (code
== FONT_INVALID_CODE
)
4726 ASET (vec
, i
, Qnil
);
4730 LGLYPH_SET_FROM (g
, i
);
4731 LGLYPH_SET_TO (g
, i
);
4732 LGLYPH_SET_CHAR (g
, c
);
4733 LGLYPH_SET_CODE (g
, code
);
4734 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4735 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4736 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4737 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4738 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4739 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4742 if (! VECTORP (object
))
4747 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4748 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4749 FONT is a font-spec, font-entity, or font-object. */)
4750 (Lisp_Object spec
, Lisp_Object font
)
4752 CHECK_FONT_SPEC (spec
);
4755 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4758 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4759 doc
: /* Return a font-object for displaying a character at POSITION.
4760 Optional second arg WINDOW, if non-nil, is a window displaying
4761 the current buffer. It defaults to the currently selected window.
4762 Optional third arg STRING, if non-nil, is a string containing the target
4763 character at index specified by POSITION. */)
4764 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4766 struct window
*w
= decode_live_window (window
);
4770 if (XBUFFER (w
->contents
) != current_buffer
)
4771 error ("Specified window is not displaying the current buffer");
4772 CHECK_NUMBER_COERCE_MARKER (position
);
4773 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4774 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4778 CHECK_NUMBER (position
);
4779 CHECK_STRING (string
);
4780 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4781 args_out_of_range (string
, position
);
4784 return font_at (-1, XINT (position
), NULL
, w
, string
);
4788 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4789 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4790 The value is a number of glyphs drawn.
4791 Type C-l to recover what previously shown. */)
4792 (Lisp_Object font_object
, Lisp_Object string
)
4794 Lisp_Object frame
= selected_frame
;
4795 struct frame
*f
= XFRAME (frame
);
4801 CHECK_FONT_GET_OBJECT (font_object
, font
);
4802 CHECK_STRING (string
);
4803 len
= SCHARS (string
);
4804 code
= alloca (sizeof (unsigned) * len
);
4805 for (i
= 0; i
< len
; i
++)
4807 Lisp_Object ch
= Faref (string
, make_number (i
));
4811 code
[i
] = font
->driver
->encode_char (font
, c
);
4812 if (code
[i
] == FONT_INVALID_CODE
)
4815 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4817 if (font
->driver
->prepare_face
)
4818 font
->driver
->prepare_face (f
, face
);
4819 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4820 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4821 if (font
->driver
->done_face
)
4822 font
->driver
->done_face (f
, face
);
4824 return make_number (len
);
4828 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4829 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4830 If FRAME is omitted or nil, use the selected frame. */)
4833 #ifdef HAVE_WINDOW_SYSTEM
4834 struct frame
*f
= decode_live_frame (frame
);
4836 if (FRAME_WINDOW_P (f
))
4837 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4843 #endif /* FONT_DEBUG */
4845 #ifdef HAVE_WINDOW_SYSTEM
4847 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4848 doc
: /* Return information about a font named NAME on frame FRAME.
4849 If FRAME is omitted or nil, use the selected frame.
4850 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4851 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4853 OPENED-NAME is the name used for opening the font,
4854 FULL-NAME is the full name of the font,
4855 SIZE is the pixelsize of the font,
4856 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4857 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4858 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4859 how to compose characters.
4860 If the named font is not yet loaded, return nil. */)
4861 (Lisp_Object name
, Lisp_Object frame
)
4866 Lisp_Object font_object
;
4869 CHECK_STRING (name
);
4870 f
= decode_window_system_frame (frame
);
4874 int fontset
= fs_query_fontset (name
, 0);
4877 name
= fontset_ascii (fontset
);
4878 font_object
= font_open_by_name (f
, name
);
4880 else if (FONT_OBJECT_P (name
))
4882 else if (FONT_ENTITY_P (name
))
4883 font_object
= font_open_entity (f
, name
, 0);
4886 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4887 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4889 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4891 if (NILP (font_object
))
4893 font
= XFONT_OBJECT (font_object
);
4895 info
= make_uninit_vector (7);
4896 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4897 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4898 ASET (info
, 2, make_number (font
->pixel_size
));
4899 ASET (info
, 3, make_number (font
->height
));
4900 ASET (info
, 4, make_number (font
->baseline_offset
));
4901 ASET (info
, 5, make_number (font
->relative_compose
));
4902 ASET (info
, 6, make_number (font
->default_ascent
));
4905 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4906 close it now. Perhaps, we should manage font-objects
4907 by `reference-count'. */
4908 font_close_object (f
, font_object
);
4915 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
4918 build_style_table (const struct table_entry
*entry
, int nelement
)
4921 Lisp_Object table
, elt
;
4923 table
= make_uninit_vector (nelement
);
4924 for (i
= 0; i
< nelement
; i
++)
4926 for (j
= 0; entry
[i
].names
[j
]; j
++);
4927 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4928 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4929 for (j
= 0; entry
[i
].names
[j
]; j
++)
4930 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4931 ASET (table
, i
, elt
);
4936 /* The deferred font-log data of the form [ACTION ARG RESULT].
4937 If ACTION is not nil, that is added to the log when font_add_log is
4938 called next time. At that time, ACTION is set back to nil. */
4939 static Lisp_Object Vfont_log_deferred
;
4941 /* Prepend the font-related logging data in Vfont_log if it is not
4942 `t'. ACTION describes a kind of font-related action (e.g. listing,
4943 opening), ARG is the argument for the action, and RESULT is the
4944 result of the action. */
4946 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4951 if (EQ (Vfont_log
, Qt
))
4953 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4955 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4957 ASET (Vfont_log_deferred
, 0, Qnil
);
4958 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4959 AREF (Vfont_log_deferred
, 2));
4964 Lisp_Object tail
, elt
;
4965 Lisp_Object equalstr
= build_string ("=");
4967 val
= Ffont_xlfd_name (arg
, Qt
);
4968 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4972 if (EQ (XCAR (elt
), QCscript
)
4973 && SYMBOLP (XCDR (elt
)))
4974 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4975 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4976 else if (EQ (XCAR (elt
), QClang
)
4977 && SYMBOLP (XCDR (elt
)))
4978 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4979 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4980 else if (EQ (XCAR (elt
), QCotf
)
4981 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4982 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4984 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4990 && VECTORP (XCAR (result
))
4991 && ASIZE (XCAR (result
)) > 0
4992 && FONTP (AREF (XCAR (result
), 0)))
4993 result
= font_vconcat_entity_vectors (result
);
4996 val
= Ffont_xlfd_name (result
, Qt
);
4997 if (! FONT_SPEC_P (result
))
4998 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4999 build_string (":"), val
);
5002 else if (CONSP (result
))
5005 result
= Fcopy_sequence (result
);
5006 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5010 val
= Ffont_xlfd_name (val
, Qt
);
5011 XSETCAR (tail
, val
);
5014 else if (VECTORP (result
))
5016 result
= Fcopy_sequence (result
);
5017 for (i
= 0; i
< ASIZE (result
); i
++)
5019 val
= AREF (result
, i
);
5021 val
= Ffont_xlfd_name (val
, Qt
);
5022 ASET (result
, i
, val
);
5025 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5028 /* Record a font-related logging data to be added to Vfont_log when
5029 font_add_log is called next time. ACTION, ARG, RESULT are the same
5033 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5035 if (EQ (Vfont_log
, Qt
))
5037 ASET (Vfont_log_deferred
, 0, build_string (action
));
5038 ASET (Vfont_log_deferred
, 1, arg
);
5039 ASET (Vfont_log_deferred
, 2, result
);
5045 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5046 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5047 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5048 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5049 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5050 /* Note that the other elements in sort_shift_bits are not used. */
5052 staticpro (&font_charset_alist
);
5053 font_charset_alist
= Qnil
;
5055 DEFSYM (Qopentype
, "opentype");
5057 DEFSYM (Qascii_0
, "ascii-0");
5058 DEFSYM (Qiso8859_1
, "iso8859-1");
5059 DEFSYM (Qiso10646_1
, "iso10646-1");
5060 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5061 DEFSYM (Qunicode_sip
, "unicode-sip");
5065 DEFSYM (QCotf
, ":otf");
5066 DEFSYM (QClang
, ":lang");
5067 DEFSYM (QCscript
, ":script");
5068 DEFSYM (QCantialias
, ":antialias");
5070 DEFSYM (QCfoundry
, ":foundry");
5071 DEFSYM (QCadstyle
, ":adstyle");
5072 DEFSYM (QCregistry
, ":registry");
5073 DEFSYM (QCspacing
, ":spacing");
5074 DEFSYM (QCdpi
, ":dpi");
5075 DEFSYM (QCscalable
, ":scalable");
5076 DEFSYM (QCavgwidth
, ":avgwidth");
5077 DEFSYM (QCfont_entity
, ":font-entity");
5078 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5088 DEFSYM (QCuser_spec
, "user-spec");
5090 staticpro (&scratch_font_spec
);
5091 scratch_font_spec
= Ffont_spec (0, NULL
);
5092 staticpro (&scratch_font_prefer
);
5093 scratch_font_prefer
= Ffont_spec (0, NULL
);
5095 staticpro (&Vfont_log_deferred
);
5096 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5100 staticpro (&otf_list
);
5102 #endif /* HAVE_LIBOTF */
5106 defsubr (&Sfont_spec
);
5107 defsubr (&Sfont_get
);
5108 #ifdef HAVE_WINDOW_SYSTEM
5109 defsubr (&Sfont_face_attributes
);
5111 defsubr (&Sfont_put
);
5112 defsubr (&Slist_fonts
);
5113 defsubr (&Sfont_family_list
);
5114 defsubr (&Sfind_font
);
5115 defsubr (&Sfont_xlfd_name
);
5116 defsubr (&Sclear_font_cache
);
5117 defsubr (&Sfont_shape_gstring
);
5118 defsubr (&Sfont_variation_glyphs
);
5120 defsubr (&Sfont_drive_otf
);
5121 defsubr (&Sfont_otf_alternates
);
5125 defsubr (&Sopen_font
);
5126 defsubr (&Sclose_font
);
5127 defsubr (&Squery_font
);
5128 defsubr (&Sfont_get_glyphs
);
5129 defsubr (&Sfont_match_p
);
5130 defsubr (&Sfont_at
);
5132 defsubr (&Sdraw_string
);
5134 defsubr (&Sframe_font_cache
);
5135 #endif /* FONT_DEBUG */
5136 #ifdef HAVE_WINDOW_SYSTEM
5137 defsubr (&Sfont_info
);
5140 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5142 Alist of fontname patterns vs the corresponding encoding and repertory info.
5143 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5144 where ENCODING is a charset or a char-table,
5145 and REPERTORY is a charset, a char-table, or nil.
5147 If ENCODING and REPERTORY are the same, the element can have the form
5148 \(REGEXP . ENCODING).
5150 ENCODING is for converting a character to a glyph code of the font.
5151 If ENCODING is a charset, encoding a character by the charset gives
5152 the corresponding glyph code. If ENCODING is a char-table, looking up
5153 the table by a character gives the corresponding glyph code.
5155 REPERTORY specifies a repertory of characters supported by the font.
5156 If REPERTORY is a charset, all characters belonging to the charset are
5157 supported. If REPERTORY is a char-table, all characters who have a
5158 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5159 gets the repertory information by an opened font and ENCODING. */);
5160 Vfont_encoding_alist
= Qnil
;
5162 /* FIXME: These 3 vars are not quite what they appear: setq on them
5163 won't have any effect other than disconnect them from the style
5164 table used by the font display code. So we make them read-only,
5165 to avoid this confusing situation. */
5167 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5168 doc
: /* Vector of valid font weight values.
5169 Each element has the form:
5170 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5171 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5172 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5173 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5175 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5176 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5177 See `font-weight-table' for the format of the vector. */);
5178 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5179 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5181 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5182 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5183 See `font-weight-table' for the format of the vector. */);
5184 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5185 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5187 staticpro (&font_style_table
);
5188 font_style_table
= make_uninit_vector (3);
5189 ASET (font_style_table
, 0, Vfont_weight_table
);
5190 ASET (font_style_table
, 1, Vfont_slant_table
);
5191 ASET (font_style_table
, 2, Vfont_width_table
);
5193 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5194 *Logging list of font related actions and results.
5195 The value t means to suppress the logging.
5196 The initial value is set to nil if the environment variable
5197 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5200 #ifdef HAVE_WINDOW_SYSTEM
5201 #ifdef HAVE_FREETYPE
5203 #ifdef HAVE_X_WINDOWS
5208 #endif /* HAVE_XFT */
5209 #endif /* HAVE_X_WINDOWS */
5210 #else /* not HAVE_FREETYPE */
5211 #ifdef HAVE_X_WINDOWS
5213 #endif /* HAVE_X_WINDOWS */
5214 #endif /* not HAVE_FREETYPE */
5217 #endif /* HAVE_BDFFONT */
5220 #endif /* HAVE_NTGUI */
5221 #endif /* HAVE_WINDOW_SYSTEM */
5227 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;