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
;
3543 font_put_frame_data (struct frame
*f
, struct font_driver
*driver
, void *data
)
3545 struct font_data_list
*list
, *prev
;
3547 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3548 prev
= list
, list
= list
->next
)
3549 if (list
->driver
== driver
)
3556 prev
->next
= list
->next
;
3558 f
->font_data_list
= list
->next
;
3566 list
= xmalloc (sizeof *list
);
3567 list
->driver
= driver
;
3568 list
->next
= f
->font_data_list
;
3569 f
->font_data_list
= list
;
3577 font_get_frame_data (struct frame
*f
, struct font_driver
*driver
)
3579 struct font_data_list
*list
;
3581 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3582 if (list
->driver
== driver
)
3590 /* Sets attributes on a font. Any properties that appear in ALIST and
3591 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3592 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3593 arrays of strings. This function is intended for use by the font
3594 drivers to implement their specific font_filter_properties. */
3596 font_filter_properties (Lisp_Object font
,
3598 const char *const boolean_properties
[],
3599 const char *const non_boolean_properties
[])
3604 /* Set boolean values to Qt or Qnil. */
3605 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3606 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3608 Lisp_Object key
= XCAR (XCAR (it
));
3609 Lisp_Object val
= XCDR (XCAR (it
));
3610 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3612 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3614 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3615 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3618 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3619 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3620 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3621 || strcmp ("Off", str
) == 0)
3626 Ffont_put (font
, key
, val
);
3630 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3631 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3633 Lisp_Object key
= XCAR (XCAR (it
));
3634 Lisp_Object val
= XCDR (XCAR (it
));
3635 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3636 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3637 Ffont_put (font
, key
, val
);
3642 /* Return the font used to draw character C by FACE at buffer position
3643 POS in window W. If STRING is non-nil, it is a string containing C
3644 at index POS. If C is negative, get C from the current buffer or
3648 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3653 Lisp_Object font_object
;
3655 multibyte
= (NILP (string
)
3656 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3657 : STRING_MULTIBYTE (string
));
3664 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3666 c
= FETCH_CHAR (pos_byte
);
3669 c
= FETCH_BYTE (pos
);
3675 multibyte
= STRING_MULTIBYTE (string
);
3678 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3680 str
= SDATA (string
) + pos_byte
;
3681 c
= STRING_CHAR (str
);
3684 c
= SDATA (string
)[pos
];
3688 f
= XFRAME (w
->frame
);
3689 if (! FRAME_WINDOW_P (f
))
3696 if (STRINGP (string
))
3697 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3698 DEFAULT_FACE_ID
, 0);
3700 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3702 face
= FACE_FROM_ID (f
, face_id
);
3706 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3707 face
= FACE_FROM_ID (f
, face_id
);
3712 XSETFONT (font_object
, face
->font
);
3717 #ifdef HAVE_WINDOW_SYSTEM
3719 /* Check how many characters after character/byte position POS/POS_BYTE
3720 (at most to *LIMIT) can be displayed by the same font in the window W.
3721 FACE, if non-NULL, is the face selected for the character at POS.
3722 If STRING is not nil, it is the string to check instead of the current
3723 buffer. In that case, FACE must be not NULL.
3725 The return value is the font-object for the character at POS.
3726 *LIMIT is set to the position where that font can't be used.
3728 It is assured that the current buffer (or STRING) is multibyte. */
3731 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3732 struct window
*w
, struct face
*face
, Lisp_Object string
)
3736 Lisp_Object font_object
= Qnil
;
3744 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3746 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3752 while (pos
< *limit
)
3754 Lisp_Object category
;
3757 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3759 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3760 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3761 if (INTEGERP (category
)
3762 && (XINT (category
) == UNICODE_CATEGORY_Cf
3763 || CHAR_VARIATION_SELECTOR_P (c
)))
3765 if (NILP (font_object
))
3767 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3768 if (NILP (font_object
))
3772 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3782 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3783 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3784 Return nil otherwise.
3785 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3786 which kind of font it is. It must be one of `font-spec', `font-entity',
3788 (Lisp_Object object
, Lisp_Object extra_type
)
3790 if (NILP (extra_type
))
3791 return (FONTP (object
) ? Qt
: Qnil
);
3792 if (EQ (extra_type
, Qfont_spec
))
3793 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3794 if (EQ (extra_type
, Qfont_entity
))
3795 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3796 if (EQ (extra_type
, Qfont_object
))
3797 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3798 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3801 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3802 doc
: /* Return a newly created font-spec with arguments as properties.
3804 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3805 valid font property name listed below:
3807 `:family', `:weight', `:slant', `:width'
3809 They are the same as face attributes of the same name. See
3810 `set-face-attribute'.
3814 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3818 VALUE must be a string or a symbol specifying the additional
3819 typographic style information of a font, e.g. ``sans''.
3823 VALUE must be a string or a symbol specifying the charset registry and
3824 encoding of a font, e.g. ``iso8859-1''.
3828 VALUE must be a non-negative integer or a floating point number
3829 specifying the font size. It specifies the font size in pixels (if
3830 VALUE is an integer), or in points (if VALUE is a float).
3834 VALUE must be a string of XLFD-style or fontconfig-style font name.
3838 VALUE must be a symbol representing a script that the font must
3839 support. It may be a symbol representing a subgroup of a script
3840 listed in the variable `script-representative-chars'.
3844 VALUE must be a symbol of two-letter ISO-639 language names,
3849 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3850 required OpenType features.
3852 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3853 LANGSYS-TAG: OpenType language system tag symbol,
3854 or nil for the default language system.
3855 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3856 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3858 GSUB and GPOS may contain `nil' element. In such a case, the font
3859 must not have any of the remaining elements.
3861 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3862 be an OpenType font whose GPOS table of `thai' script's default
3863 language system must contain `mark' feature.
3865 usage: (font-spec ARGS...) */)
3866 (ptrdiff_t nargs
, Lisp_Object
*args
)
3868 Lisp_Object spec
= font_make_spec ();
3871 for (i
= 0; i
< nargs
; i
+= 2)
3873 Lisp_Object key
= args
[i
], val
;
3877 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3880 if (EQ (key
, QCname
))
3883 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3884 error ("Invalid font name: %s", SSDATA (val
));
3885 font_put_extra (spec
, key
, val
);
3889 int idx
= get_font_prop_index (key
);
3893 val
= font_prop_validate (idx
, Qnil
, val
);
3894 if (idx
< FONT_EXTRA_INDEX
)
3895 ASET (spec
, idx
, val
);
3897 font_put_extra (spec
, key
, val
);
3900 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3906 /* Return a copy of FONT as a font-spec. */
3908 copy_font_spec (Lisp_Object font
)
3910 Lisp_Object new_spec
, tail
, prev
, extra
;
3914 new_spec
= font_make_spec ();
3915 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3916 ASET (new_spec
, i
, AREF (font
, i
));
3917 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3918 /* We must remove :font-entity property. */
3919 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3920 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3923 extra
= XCDR (extra
);
3925 XSETCDR (prev
, XCDR (tail
));
3928 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3932 /* Merge font-specs FROM and TO, and return a new font-spec.
3933 Every specified property in FROM overrides the corresponding
3936 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3938 Lisp_Object extra
, tail
;
3943 to
= copy_font_spec (to
);
3944 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3945 ASET (to
, i
, AREF (from
, i
));
3946 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3947 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3948 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3950 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3953 XSETCDR (slot
, XCDR (XCAR (tail
)));
3955 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3957 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3961 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3962 doc
: /* Return the value of FONT's property KEY.
3963 FONT is a font-spec, a font-entity, or a font-object.
3964 KEY is any symbol, but these are reserved for specific meanings:
3965 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3966 :size, :name, :script, :otf
3967 See the documentation of `font-spec' for their meanings.
3968 In addition, if FONT is a font-entity or a font-object, values of
3969 :script and :otf are different from those of a font-spec as below:
3971 The value of :script may be a list of scripts that are supported by the font.
3973 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3974 representing the OpenType features supported by the font by this form:
3975 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3976 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3978 (Lisp_Object font
, Lisp_Object key
)
3986 idx
= get_font_prop_index (key
);
3987 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3988 return font_style_symbolic (font
, idx
, 0);
3989 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3990 return AREF (font
, idx
);
3991 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3992 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3994 struct font
*fontp
= XFONT_OBJECT (font
);
3996 if (fontp
->driver
->otf_capability
)
3997 val
= fontp
->driver
->otf_capability (fontp
);
3999 val
= Fcons (Qnil
, Qnil
);
4006 #ifdef HAVE_WINDOW_SYSTEM
4008 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4009 doc
: /* Return a plist of face attributes generated by FONT.
4010 FONT is a font name, a font-spec, a font-entity, or a font-object.
4011 The return value is a list of the form
4013 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4015 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4016 compatible with `set-face-attribute'. Some of these key-attribute pairs
4017 may be omitted from the list if they are not specified by FONT.
4019 The optional argument FRAME specifies the frame that the face attributes
4020 are to be displayed on. If omitted, the selected frame is used. */)
4021 (Lisp_Object font
, Lisp_Object frame
)
4023 struct frame
*f
= decode_live_frame (frame
);
4024 Lisp_Object plist
[10];
4030 int fontset
= fs_query_fontset (font
, 0);
4031 Lisp_Object name
= font
;
4033 font
= fontset_ascii (fontset
);
4034 font
= font_spec_from_name (name
);
4036 signal_error ("Invalid font name", name
);
4038 else if (! FONTP (font
))
4039 signal_error ("Invalid font object", font
);
4041 val
= AREF (font
, FONT_FAMILY_INDEX
);
4044 plist
[n
++] = QCfamily
;
4045 plist
[n
++] = SYMBOL_NAME (val
);
4048 val
= AREF (font
, FONT_SIZE_INDEX
);
4051 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4052 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4053 plist
[n
++] = QCheight
;
4054 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4056 else if (FLOATP (val
))
4058 plist
[n
++] = QCheight
;
4059 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4062 val
= FONT_WEIGHT_FOR_FACE (font
);
4065 plist
[n
++] = QCweight
;
4069 val
= FONT_SLANT_FOR_FACE (font
);
4072 plist
[n
++] = QCslant
;
4076 val
= FONT_WIDTH_FOR_FACE (font
);
4079 plist
[n
++] = QCwidth
;
4083 return Flist (n
, plist
);
4088 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4089 doc
: /* Set one property of FONT: give property KEY value VAL.
4090 FONT is a font-spec, a font-entity, or a font-object.
4092 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4093 accepted by the function `font-spec' (which see), VAL must be what
4094 allowed in `font-spec'.
4096 If FONT is a font-entity or a font-object, KEY must not be the one
4097 accepted by `font-spec'. */)
4098 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4102 idx
= get_font_prop_index (prop
);
4103 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4105 CHECK_FONT_SPEC (font
);
4106 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4110 if (EQ (prop
, QCname
)
4111 || EQ (prop
, QCscript
)
4112 || EQ (prop
, QClang
)
4113 || EQ (prop
, QCotf
))
4114 CHECK_FONT_SPEC (font
);
4117 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4122 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4123 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4124 Optional 2nd argument FRAME specifies the target frame.
4125 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4126 Optional 4th argument PREFER, if non-nil, is a font-spec to
4127 control the order of the returned list. Fonts are sorted by
4128 how close they are to PREFER. */)
4129 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4131 struct frame
*f
= decode_live_frame (frame
);
4132 Lisp_Object vec
, list
;
4135 CHECK_FONT_SPEC (font_spec
);
4143 if (! NILP (prefer
))
4144 CHECK_FONT_SPEC (prefer
);
4146 list
= font_list_entities (f
, font_spec
);
4149 if (NILP (XCDR (list
))
4150 && ASIZE (XCAR (list
)) == 1)
4151 return list1 (AREF (XCAR (list
), 0));
4153 if (! NILP (prefer
))
4154 vec
= font_sort_entities (list
, prefer
, f
, 0);
4156 vec
= font_vconcat_entity_vectors (list
);
4157 if (n
== 0 || n
>= ASIZE (vec
))
4159 Lisp_Object args
[2];
4163 list
= Fappend (2, args
);
4167 for (list
= Qnil
, n
--; n
>= 0; n
--)
4168 list
= Fcons (AREF (vec
, n
), list
);
4173 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4174 doc
: /* List available font families on the current frame.
4175 If FRAME is omitted or nil, the selected frame is used. */)
4178 struct frame
*f
= decode_live_frame (frame
);
4179 struct font_driver_list
*driver_list
;
4180 Lisp_Object list
= Qnil
;
4182 for (driver_list
= f
->font_driver_list
; driver_list
;
4183 driver_list
= driver_list
->next
)
4184 if (driver_list
->driver
->list_family
)
4186 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4187 Lisp_Object tail
= list
;
4189 for (; CONSP (val
); val
= XCDR (val
))
4190 if (NILP (Fmemq (XCAR (val
), tail
))
4191 && SYMBOLP (XCAR (val
)))
4192 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4197 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4198 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4199 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4200 (Lisp_Object font_spec
, Lisp_Object frame
)
4202 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4209 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4210 doc
: /* Return XLFD name of FONT.
4211 FONT is a font-spec, font-entity, or font-object.
4212 If the name is too long for XLFD (maximum 255 chars), return nil.
4213 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4214 the consecutive wildcards are folded into one. */)
4215 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4218 int namelen
, pixel_size
= 0;
4222 if (FONT_OBJECT_P (font
))
4224 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4226 if (STRINGP (font_name
)
4227 && SDATA (font_name
)[0] == '-')
4229 if (NILP (fold_wildcards
))
4231 strcpy (name
, SSDATA (font_name
));
4232 namelen
= SBYTES (font_name
);
4235 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4237 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4241 if (! NILP (fold_wildcards
))
4243 char *p0
= name
, *p1
;
4245 while ((p1
= strstr (p0
, "-*-*")))
4247 strcpy (p1
, p1
+ 2);
4253 return make_string (name
, namelen
);
4257 clear_font_cache (struct frame
*f
)
4259 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4261 for (; driver_list
; driver_list
= driver_list
->next
)
4262 if (driver_list
->on
)
4264 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4268 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4270 eassert (! NILP (val
));
4271 tmp
= XCDR (XCAR (val
));
4272 if (XINT (XCAR (tmp
)) == 0)
4274 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4275 XSETCDR (cache
, XCDR (val
));
4280 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4281 doc
: /* Clear font cache of each frame. */)
4284 Lisp_Object list
, frame
;
4286 FOR_EACH_FRAME (list
, frame
)
4287 clear_font_cache (XFRAME (frame
));
4294 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4296 struct font
*font
= XFONT_OBJECT (font_object
);
4297 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4298 struct font_metrics metrics
;
4300 LGLYPH_SET_CODE (glyph
, code
);
4301 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4302 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4303 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4304 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4305 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4306 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4310 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4311 doc
: /* Shape the glyph-string GSTRING.
4312 Shaping means substituting glyphs and/or adjusting positions of glyphs
4313 to get the correct visual image of character sequences set in the
4314 header of the glyph-string.
4316 If the shaping was successful, the value is GSTRING itself or a newly
4317 created glyph-string. Otherwise, the value is nil.
4319 See the documentation of `composition-get-gstring' for the format of
4321 (Lisp_Object gstring
)
4324 Lisp_Object font_object
, n
, glyph
;
4325 ptrdiff_t i
, from
, to
;
4327 if (! composition_gstring_p (gstring
))
4328 signal_error ("Invalid glyph-string: ", gstring
);
4329 if (! NILP (LGSTRING_ID (gstring
)))
4331 font_object
= LGSTRING_FONT (gstring
);
4332 CHECK_FONT_OBJECT (font_object
);
4333 font
= XFONT_OBJECT (font_object
);
4334 if (! font
->driver
->shape
)
4337 /* Try at most three times with larger gstring each time. */
4338 for (i
= 0; i
< 3; i
++)
4340 n
= font
->driver
->shape (gstring
);
4343 gstring
= larger_vector (gstring
,
4344 LGSTRING_GLYPH_LEN (gstring
), -1);
4346 if (i
== 3 || XINT (n
) == 0)
4348 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4349 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4351 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4352 GLYPHS covers all characters (except for the last few ones) in
4353 GSTRING. More formally, provided that NCHARS is the number of
4354 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4355 and TO_IDX of each glyph must satisfy these conditions:
4357 GLYPHS[0].FROM_IDX == 0
4358 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4359 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4360 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4361 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4363 ;; Be sure to cover all characters.
4364 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4365 glyph
= LGSTRING_GLYPH (gstring
, 0);
4366 from
= LGLYPH_FROM (glyph
);
4367 to
= LGLYPH_TO (glyph
);
4368 if (from
!= 0 || to
< from
)
4370 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4372 glyph
= LGSTRING_GLYPH (gstring
, i
);
4375 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4376 && (LGLYPH_FROM (glyph
) == from
4377 ? LGLYPH_TO (glyph
) == to
4378 : LGLYPH_FROM (glyph
) == to
+ 1)))
4380 from
= LGLYPH_FROM (glyph
);
4381 to
= LGLYPH_TO (glyph
);
4383 return composition_gstring_put_cache (gstring
, XINT (n
));
4389 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4391 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4392 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4394 VARIATION-SELECTOR is a character code of variation selection
4395 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4396 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4397 (Lisp_Object font_object
, Lisp_Object character
)
4399 unsigned variations
[256];
4404 CHECK_FONT_OBJECT (font_object
);
4405 CHECK_CHARACTER (character
);
4406 font
= XFONT_OBJECT (font_object
);
4407 if (! font
->driver
->get_variation_glyphs
)
4409 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4413 for (i
= 0; i
< 255; i
++)
4416 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4417 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4418 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4425 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4426 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4427 OTF-FEATURES specifies which features to apply in this format:
4428 (SCRIPT LANGSYS GSUB GPOS)
4430 SCRIPT is a symbol specifying a script tag of OpenType,
4431 LANGSYS is a symbol specifying a langsys tag of OpenType,
4432 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4434 If LANGSYS is nil, the default langsys is selected.
4436 The features are applied in the order they appear in the list. The
4437 symbol `*' means to apply all available features not present in this
4438 list, and the remaining features are ignored. For instance, (vatu
4439 pstf * haln) is to apply vatu and pstf in this order, then to apply
4440 all available features other than vatu, pstf, and haln.
4442 The features are applied to the glyphs in the range FROM and TO of
4443 the glyph-string GSTRING-IN.
4445 If some feature is actually applicable, the resulting glyphs are
4446 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4447 this case, the value is the number of produced glyphs.
4449 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4452 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4453 produced in GSTRING-OUT, and the value is nil.
4455 See the documentation of `composition-get-gstring' for the format of
4457 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4459 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4464 check_otf_features (otf_features
);
4465 CHECK_FONT_OBJECT (font_object
);
4466 font
= XFONT_OBJECT (font_object
);
4467 if (! font
->driver
->otf_drive
)
4468 error ("Font backend %s can't drive OpenType GSUB table",
4469 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4470 CHECK_CONS (otf_features
);
4471 CHECK_SYMBOL (XCAR (otf_features
));
4472 val
= XCDR (otf_features
);
4473 CHECK_SYMBOL (XCAR (val
));
4474 val
= XCDR (otf_features
);
4477 len
= check_gstring (gstring_in
);
4478 CHECK_VECTOR (gstring_out
);
4479 CHECK_NATNUM (from
);
4481 CHECK_NATNUM (index
);
4483 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4484 args_out_of_range_3 (from
, to
, make_number (len
));
4485 if (XINT (index
) >= ASIZE (gstring_out
))
4486 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4487 num
= font
->driver
->otf_drive (font
, otf_features
,
4488 gstring_in
, XINT (from
), XINT (to
),
4489 gstring_out
, XINT (index
), 0);
4492 return make_number (num
);
4495 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4497 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4498 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4500 (SCRIPT LANGSYS FEATURE ...)
4501 See the documentation of `font-drive-otf' for more detail.
4503 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4504 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4505 character code corresponding to the glyph or nil if there's no
4506 corresponding character. */)
4507 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4510 Lisp_Object gstring_in
, gstring_out
, g
;
4511 Lisp_Object alternates
;
4514 CHECK_FONT_GET_OBJECT (font_object
, font
);
4515 if (! font
->driver
->otf_drive
)
4516 error ("Font backend %s can't drive OpenType GSUB table",
4517 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4518 CHECK_CHARACTER (character
);
4519 CHECK_CONS (otf_features
);
4521 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4522 g
= LGSTRING_GLYPH (gstring_in
, 0);
4523 LGLYPH_SET_CHAR (g
, XINT (character
));
4524 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4525 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4526 gstring_out
, 0, 1)) < 0)
4527 gstring_out
= Ffont_make_gstring (font_object
,
4528 make_number (ASIZE (gstring_out
) * 2));
4530 for (i
= 0; i
< num
; i
++)
4532 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4533 int c
= LGLYPH_CHAR (g
);
4534 unsigned code
= LGLYPH_CODE (g
);
4536 alternates
= Fcons (Fcons (make_number (code
),
4537 c
> 0 ? make_number (c
) : Qnil
),
4540 return Fnreverse (alternates
);
4546 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4547 doc
: /* Open FONT-ENTITY. */)
4548 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4551 struct frame
*f
= decode_live_frame (frame
);
4553 CHECK_FONT_ENTITY (font_entity
);
4556 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4559 CHECK_NUMBER_OR_FLOAT (size
);
4561 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4563 isize
= XINT (size
);
4564 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4565 args_out_of_range (font_entity
, size
);
4569 return font_open_entity (f
, font_entity
, isize
);
4572 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4573 doc
: /* Close FONT-OBJECT. */)
4574 (Lisp_Object font_object
, Lisp_Object frame
)
4576 CHECK_FONT_OBJECT (font_object
);
4577 font_close_object (decode_live_frame (frame
), font_object
);
4581 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4582 doc
: /* Return information about FONT-OBJECT.
4583 The value is a vector:
4584 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4587 NAME is the font name, a string (or nil if the font backend doesn't
4590 FILENAME is the font file name, a string (or nil if the font backend
4591 doesn't provide a file name).
4593 PIXEL-SIZE is a pixel size by which the font is opened.
4595 SIZE is a maximum advance width of the font in pixels.
4597 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4600 CAPABILITY is a list whose first element is a symbol representing the
4601 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4602 remaining elements describe the details of the font capability.
4604 If the font is OpenType font, the form of the list is
4605 \(opentype GSUB GPOS)
4606 where GSUB shows which "GSUB" features the font supports, and GPOS
4607 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4608 lists of the format:
4609 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4611 If the font is not OpenType font, currently the length of the form is
4614 SCRIPT is a symbol representing OpenType script tag.
4616 LANGSYS is a symbol representing OpenType langsys tag, or nil
4617 representing the default langsys.
4619 FEATURE is a symbol representing OpenType feature tag.
4621 If the font is not OpenType font, CAPABILITY is nil. */)
4622 (Lisp_Object font_object
)
4627 CHECK_FONT_GET_OBJECT (font_object
, font
);
4629 val
= make_uninit_vector (9);
4630 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4631 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4632 ASET (val
, 2, make_number (font
->pixel_size
));
4633 ASET (val
, 3, make_number (font
->max_width
));
4634 ASET (val
, 4, make_number (font
->ascent
));
4635 ASET (val
, 5, make_number (font
->descent
));
4636 ASET (val
, 6, make_number (font
->space_width
));
4637 ASET (val
, 7, make_number (font
->average_width
));
4638 if (font
->driver
->otf_capability
)
4639 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4641 ASET (val
, 8, Qnil
);
4645 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4647 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4648 FROM and TO are positions (integers or markers) specifying a region
4649 of the current buffer.
4650 If the optional fourth arg OBJECT is not nil, it is a string or a
4651 vector containing the target characters.
4653 Each element is a vector containing information of a glyph in this format:
4654 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4656 FROM is an index numbers of a character the glyph corresponds to.
4657 TO is the same as FROM.
4658 C is the character of the glyph.
4659 CODE is the glyph-code of C in FONT-OBJECT.
4660 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4661 ADJUSTMENT is always nil.
4662 If FONT-OBJECT doesn't have a glyph for a character,
4663 the corresponding element is nil. */)
4664 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4669 Lisp_Object
*chars
, vec
;
4672 CHECK_FONT_GET_OBJECT (font_object
, font
);
4675 ptrdiff_t charpos
, bytepos
;
4677 validate_region (&from
, &to
);
4680 len
= XFASTINT (to
) - XFASTINT (from
);
4681 SAFE_ALLOCA_LISP (chars
, len
);
4682 charpos
= XFASTINT (from
);
4683 bytepos
= CHAR_TO_BYTE (charpos
);
4684 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4687 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4688 chars
[i
] = make_number (c
);
4691 else if (STRINGP (object
))
4693 const unsigned char *p
;
4695 CHECK_NUMBER (from
);
4697 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4698 || XINT (to
) > SCHARS (object
))
4699 args_out_of_range_3 (object
, from
, to
);
4702 len
= XFASTINT (to
) - XFASTINT (from
);
4703 SAFE_ALLOCA_LISP (chars
, len
);
4705 if (STRING_MULTIBYTE (object
))
4706 for (i
= 0; i
< len
; i
++)
4708 int c
= STRING_CHAR_ADVANCE (p
);
4709 chars
[i
] = make_number (c
);
4712 for (i
= 0; i
< len
; i
++)
4713 chars
[i
] = make_number (p
[i
]);
4717 CHECK_VECTOR (object
);
4718 CHECK_NUMBER (from
);
4720 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4721 || XINT (to
) > ASIZE (object
))
4722 args_out_of_range_3 (object
, from
, to
);
4725 len
= XFASTINT (to
) - XFASTINT (from
);
4726 for (i
= 0; i
< len
; i
++)
4728 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4729 CHECK_CHARACTER (elt
);
4731 chars
= aref_addr (object
, XFASTINT (from
));
4734 vec
= make_uninit_vector (len
);
4735 for (i
= 0; i
< len
; i
++)
4738 int c
= XFASTINT (chars
[i
]);
4740 struct font_metrics metrics
;
4742 code
= font
->driver
->encode_char (font
, c
);
4743 if (code
== FONT_INVALID_CODE
)
4745 ASET (vec
, i
, Qnil
);
4749 LGLYPH_SET_FROM (g
, i
);
4750 LGLYPH_SET_TO (g
, i
);
4751 LGLYPH_SET_CHAR (g
, c
);
4752 LGLYPH_SET_CODE (g
, code
);
4753 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4754 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4755 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4756 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4757 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4758 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4761 if (! VECTORP (object
))
4766 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4767 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4768 FONT is a font-spec, font-entity, or font-object. */)
4769 (Lisp_Object spec
, Lisp_Object font
)
4771 CHECK_FONT_SPEC (spec
);
4774 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4777 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4778 doc
: /* Return a font-object for displaying a character at POSITION.
4779 Optional second arg WINDOW, if non-nil, is a window displaying
4780 the current buffer. It defaults to the currently selected window.
4781 Optional third arg STRING, if non-nil, is a string containing the target
4782 character at index specified by POSITION. */)
4783 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4785 struct window
*w
= decode_live_window (window
);
4789 if (XBUFFER (w
->contents
) != current_buffer
)
4790 error ("Specified window is not displaying the current buffer");
4791 CHECK_NUMBER_COERCE_MARKER (position
);
4792 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4793 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4797 CHECK_NUMBER (position
);
4798 CHECK_STRING (string
);
4799 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4800 args_out_of_range (string
, position
);
4803 return font_at (-1, XINT (position
), NULL
, w
, string
);
4807 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4808 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4809 The value is a number of glyphs drawn.
4810 Type C-l to recover what previously shown. */)
4811 (Lisp_Object font_object
, Lisp_Object string
)
4813 Lisp_Object frame
= selected_frame
;
4814 struct frame
*f
= XFRAME (frame
);
4820 CHECK_FONT_GET_OBJECT (font_object
, font
);
4821 CHECK_STRING (string
);
4822 len
= SCHARS (string
);
4823 code
= alloca (sizeof (unsigned) * len
);
4824 for (i
= 0; i
< len
; i
++)
4826 Lisp_Object ch
= Faref (string
, make_number (i
));
4830 code
[i
] = font
->driver
->encode_char (font
, c
);
4831 if (code
[i
] == FONT_INVALID_CODE
)
4834 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4836 if (font
->driver
->prepare_face
)
4837 font
->driver
->prepare_face (f
, face
);
4838 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4839 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4840 if (font
->driver
->done_face
)
4841 font
->driver
->done_face (f
, face
);
4843 return make_number (len
);
4847 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4848 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4849 If FRAME is omitted or nil, use the selected frame. */)
4852 #ifdef HAVE_WINDOW_SYSTEM
4853 struct frame
*f
= decode_live_frame (frame
);
4855 if (FRAME_WINDOW_P (f
))
4856 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4862 #endif /* FONT_DEBUG */
4864 #ifdef HAVE_WINDOW_SYSTEM
4866 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4867 doc
: /* Return information about a font named NAME on frame FRAME.
4868 If FRAME is omitted or nil, use the selected frame.
4869 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4870 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4872 OPENED-NAME is the name used for opening the font,
4873 FULL-NAME is the full name of the font,
4874 SIZE is the pixelsize of the font,
4875 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4876 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4877 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4878 how to compose characters.
4879 If the named font is not yet loaded, return nil. */)
4880 (Lisp_Object name
, Lisp_Object frame
)
4885 Lisp_Object font_object
;
4888 CHECK_STRING (name
);
4889 f
= decode_window_system_frame (frame
);
4893 int fontset
= fs_query_fontset (name
, 0);
4896 name
= fontset_ascii (fontset
);
4897 font_object
= font_open_by_name (f
, name
);
4899 else if (FONT_OBJECT_P (name
))
4901 else if (FONT_ENTITY_P (name
))
4902 font_object
= font_open_entity (f
, name
, 0);
4905 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4906 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4908 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4910 if (NILP (font_object
))
4912 font
= XFONT_OBJECT (font_object
);
4914 info
= make_uninit_vector (7);
4915 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4916 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4917 ASET (info
, 2, make_number (font
->pixel_size
));
4918 ASET (info
, 3, make_number (font
->height
));
4919 ASET (info
, 4, make_number (font
->baseline_offset
));
4920 ASET (info
, 5, make_number (font
->relative_compose
));
4921 ASET (info
, 6, make_number (font
->default_ascent
));
4924 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4925 close it now. Perhaps, we should manage font-objects
4926 by `reference-count'. */
4927 font_close_object (f
, font_object
);
4934 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
4937 build_style_table (const struct table_entry
*entry
, int nelement
)
4940 Lisp_Object table
, elt
;
4942 table
= make_uninit_vector (nelement
);
4943 for (i
= 0; i
< nelement
; i
++)
4945 for (j
= 0; entry
[i
].names
[j
]; j
++);
4946 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4947 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4948 for (j
= 0; entry
[i
].names
[j
]; j
++)
4949 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4950 ASET (table
, i
, elt
);
4955 /* The deferred font-log data of the form [ACTION ARG RESULT].
4956 If ACTION is not nil, that is added to the log when font_add_log is
4957 called next time. At that time, ACTION is set back to nil. */
4958 static Lisp_Object Vfont_log_deferred
;
4960 /* Prepend the font-related logging data in Vfont_log if it is not
4961 `t'. ACTION describes a kind of font-related action (e.g. listing,
4962 opening), ARG is the argument for the action, and RESULT is the
4963 result of the action. */
4965 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4970 if (EQ (Vfont_log
, Qt
))
4972 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4974 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4976 ASET (Vfont_log_deferred
, 0, Qnil
);
4977 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4978 AREF (Vfont_log_deferred
, 2));
4983 Lisp_Object tail
, elt
;
4984 Lisp_Object equalstr
= build_string ("=");
4986 val
= Ffont_xlfd_name (arg
, Qt
);
4987 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4991 if (EQ (XCAR (elt
), QCscript
)
4992 && SYMBOLP (XCDR (elt
)))
4993 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4994 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4995 else if (EQ (XCAR (elt
), QClang
)
4996 && SYMBOLP (XCDR (elt
)))
4997 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4998 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4999 else if (EQ (XCAR (elt
), QCotf
)
5000 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5001 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5003 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5009 && VECTORP (XCAR (result
))
5010 && ASIZE (XCAR (result
)) > 0
5011 && FONTP (AREF (XCAR (result
), 0)))
5012 result
= font_vconcat_entity_vectors (result
);
5015 val
= Ffont_xlfd_name (result
, Qt
);
5016 if (! FONT_SPEC_P (result
))
5017 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5018 build_string (":"), val
);
5021 else if (CONSP (result
))
5024 result
= Fcopy_sequence (result
);
5025 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5029 val
= Ffont_xlfd_name (val
, Qt
);
5030 XSETCAR (tail
, val
);
5033 else if (VECTORP (result
))
5035 result
= Fcopy_sequence (result
);
5036 for (i
= 0; i
< ASIZE (result
); i
++)
5038 val
= AREF (result
, i
);
5040 val
= Ffont_xlfd_name (val
, Qt
);
5041 ASET (result
, i
, val
);
5044 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5047 /* Record a font-related logging data to be added to Vfont_log when
5048 font_add_log is called next time. ACTION, ARG, RESULT are the same
5052 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5054 if (EQ (Vfont_log
, Qt
))
5056 ASET (Vfont_log_deferred
, 0, build_string (action
));
5057 ASET (Vfont_log_deferred
, 1, arg
);
5058 ASET (Vfont_log_deferred
, 2, result
);
5066 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5067 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5068 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5069 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5070 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5071 /* Note that the other elements in sort_shift_bits are not used. */
5073 staticpro (&font_charset_alist
);
5074 font_charset_alist
= Qnil
;
5076 DEFSYM (Qopentype
, "opentype");
5078 DEFSYM (Qascii_0
, "ascii-0");
5079 DEFSYM (Qiso8859_1
, "iso8859-1");
5080 DEFSYM (Qiso10646_1
, "iso10646-1");
5081 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5082 DEFSYM (Qunicode_sip
, "unicode-sip");
5086 DEFSYM (QCotf
, ":otf");
5087 DEFSYM (QClang
, ":lang");
5088 DEFSYM (QCscript
, ":script");
5089 DEFSYM (QCantialias
, ":antialias");
5091 DEFSYM (QCfoundry
, ":foundry");
5092 DEFSYM (QCadstyle
, ":adstyle");
5093 DEFSYM (QCregistry
, ":registry");
5094 DEFSYM (QCspacing
, ":spacing");
5095 DEFSYM (QCdpi
, ":dpi");
5096 DEFSYM (QCscalable
, ":scalable");
5097 DEFSYM (QCavgwidth
, ":avgwidth");
5098 DEFSYM (QCfont_entity
, ":font-entity");
5099 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5109 DEFSYM (QCuser_spec
, "user-spec");
5111 staticpro (&scratch_font_spec
);
5112 scratch_font_spec
= Ffont_spec (0, NULL
);
5113 staticpro (&scratch_font_prefer
);
5114 scratch_font_prefer
= Ffont_spec (0, NULL
);
5116 staticpro (&Vfont_log_deferred
);
5117 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5121 staticpro (&otf_list
);
5123 #endif /* HAVE_LIBOTF */
5126 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5128 Alist of fontname patterns vs the corresponding encoding and repertory info.
5129 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5130 where ENCODING is a charset or a char-table,
5131 and REPERTORY is a charset, a char-table, or nil.
5133 If ENCODING and REPERTORY are the same, the element can have the form
5134 \(REGEXP . ENCODING).
5136 ENCODING is for converting a character to a glyph code of the font.
5137 If ENCODING is a charset, encoding a character by the charset gives
5138 the corresponding glyph code. If ENCODING is a char-table, looking up
5139 the table by a character gives the corresponding glyph code.
5141 REPERTORY specifies a repertory of characters supported by the font.
5142 If REPERTORY is a charset, all characters belonging to the charset are
5143 supported. If REPERTORY is a char-table, all characters who have a
5144 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5145 gets the repertory information by an opened font and ENCODING. */);
5146 Vfont_encoding_alist
= Qnil
;
5148 /* FIXME: These 3 vars are not quite what they appear: setq on them
5149 won't have any effect other than disconnect them from the style
5150 table used by the font display code. So we make them read-only,
5151 to avoid this confusing situation. */
5153 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5154 doc
: /* Vector of valid font weight values.
5155 Each element has the form:
5156 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5157 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5158 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5159 SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-weight-table")), 1);
5161 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5162 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5163 See `font-weight-table' for the format of the vector. */);
5164 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5165 SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-slant-table")), 1);
5167 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5168 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5169 See `font-weight-table' for the format of the vector. */);
5170 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5171 SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-width-table")), 1);
5173 staticpro (&font_style_table
);
5174 font_style_table
= make_uninit_vector (3);
5175 ASET (font_style_table
, 0, Vfont_weight_table
);
5176 ASET (font_style_table
, 1, Vfont_slant_table
);
5177 ASET (font_style_table
, 2, Vfont_width_table
);
5179 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5180 *Logging list of font related actions and results.
5181 The value t means to suppress the logging.
5182 The initial value is set to nil if the environment variable
5183 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5186 #ifdef HAVE_WINDOW_SYSTEM
5187 #ifdef HAVE_FREETYPE
5189 #ifdef HAVE_X_WINDOWS
5194 #endif /* HAVE_XFT */
5195 #endif /* HAVE_X_WINDOWS */
5196 #else /* not HAVE_FREETYPE */
5197 #ifdef HAVE_X_WINDOWS
5199 #endif /* HAVE_X_WINDOWS */
5200 #endif /* not HAVE_FREETYPE */
5203 #endif /* HAVE_BDFFONT */
5206 #endif /* HAVE_NTGUI */
5207 #endif /* HAVE_WINDOW_SYSTEM */
5213 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;