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 XSETFONT (font_object
, font
);
214 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
215 font
->props
[i
] = AREF (entity
, i
);
216 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
217 font
->props
[FONT_EXTRA_INDEX
]
218 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
221 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
227 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
228 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
229 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
231 static unsigned font_encode_char (Lisp_Object
, int);
233 /* Number of registered font drivers. */
234 static int num_font_drivers
;
237 /* Return a Lispy value of a font property value at STR and LEN bytes.
238 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
239 consist entirely of one or more digits, return a symbol interned
240 from STR. Otherwise, return an integer. */
243 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
248 ptrdiff_t nbytes
, nchars
;
250 if (len
== 1 && *str
== '*')
252 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
254 for (i
= 1; i
< len
; i
++)
255 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
262 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
265 return make_number (n
);
266 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
270 xsignal1 (Qoverflow_error
, make_string (str
, len
));
274 /* This code is similar to intern function from lread.c. */
275 obarray
= check_obarray (Vobarray
);
276 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
277 tem
= oblookup (obarray
, str
,
278 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
282 if (len
== nchars
|| len
!= nbytes
)
283 tem
= make_unibyte_string (str
, len
);
285 tem
= make_multibyte_string (str
, nchars
, len
);
286 return Fintern (tem
, obarray
);
289 /* Return a pixel size of font-spec SPEC on frame F. */
292 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
294 #ifdef HAVE_WINDOW_SYSTEM
295 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
304 eassert (FLOATP (size
));
305 point_size
= XFLOAT_DATA (size
);
306 val
= AREF (spec
, FONT_DPI_INDEX
);
310 dpi
= FRAME_RES_Y (f
);
311 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
319 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
320 font vector. If VAL is not valid (i.e. not registered in
321 font_style_table), return -1 if NOERROR is zero, and return a
322 proper index if NOERROR is nonzero. In that case, register VAL in
323 font_style_table if VAL is a symbol, and return the closest index if
324 VAL is an integer. */
327 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
330 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
333 CHECK_VECTOR (table
);
340 Lisp_Object args
[2], elt
;
342 /* At first try exact match. */
343 for (i
= 0; i
< len
; i
++)
345 CHECK_VECTOR (AREF (table
, i
));
346 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
347 if (EQ (val
, AREF (AREF (table
, i
), j
)))
349 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
350 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
351 | (i
<< 4) | (j
- 1));
354 /* Try also with case-folding match. */
355 s
= SSDATA (SYMBOL_NAME (val
));
356 for (i
= 0; i
< len
; i
++)
357 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
359 elt
= AREF (AREF (table
, i
), j
);
360 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
362 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
363 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
364 | (i
<< 4) | (j
- 1));
370 elt
= Fmake_vector (make_number (2), make_number (100));
373 args
[1] = Fmake_vector (make_number (1), elt
);
374 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
375 return (100 << 8) | (i
<< 4);
380 EMACS_INT numeric
= XINT (val
);
382 for (i
= 0, last_n
= -1; i
< len
; i
++)
386 CHECK_VECTOR (AREF (table
, i
));
387 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
388 n
= XINT (AREF (AREF (table
, i
), 0));
390 return (n
<< 8) | (i
<< 4);
395 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
396 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
402 return ((last_n
<< 8) | ((i
- 1) << 4));
407 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
410 Lisp_Object val
= AREF (font
, prop
);
411 Lisp_Object table
, elt
;
416 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
417 CHECK_VECTOR (table
);
418 i
= XINT (val
) & 0xFF;
419 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
420 elt
= AREF (table
, ((i
>> 4) & 0xF));
422 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
423 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
428 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
429 FONTNAME. ENCODING is a charset symbol that specifies the encoding
430 of the font. REPERTORY is a charset symbol or nil. */
433 find_font_encoding (Lisp_Object fontname
)
435 Lisp_Object tail
, elt
;
437 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
441 && STRINGP (XCAR (elt
))
442 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
443 && (SYMBOLP (XCDR (elt
))
444 ? CHARSETP (XCDR (elt
))
445 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
451 /* Return encoding charset and repertory charset for REGISTRY in
452 ENCODING and REPERTORY correspondingly. If correct information for
453 REGISTRY is available, return 0. Otherwise return -1. */
456 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
459 int encoding_id
, repertory_id
;
461 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
467 encoding_id
= XINT (XCAR (val
));
468 repertory_id
= XINT (XCDR (val
));
472 val
= find_font_encoding (SYMBOL_NAME (registry
));
473 if (SYMBOLP (val
) && CHARSETP (val
))
475 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
477 else if (CONSP (val
))
479 if (! CHARSETP (XCAR (val
)))
481 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
482 if (NILP (XCDR (val
)))
486 if (! CHARSETP (XCDR (val
)))
488 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
493 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
495 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
499 *encoding
= CHARSET_FROM_ID (encoding_id
);
501 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
506 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
511 /* Font property value validators. See the comment of
512 font_property_table for the meaning of the arguments. */
514 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
515 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
516 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
517 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
518 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
519 static int get_font_prop_index (Lisp_Object
);
522 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
525 val
= Fintern (val
, Qnil
);
528 else if (EQ (prop
, QCregistry
))
529 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
535 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
537 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
538 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
542 EMACS_INT n
= XINT (val
);
543 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
545 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
549 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
552 if ((n
& 0xF) + 1 >= ASIZE (elt
))
556 CHECK_NUMBER (AREF (elt
, 0));
557 if (XINT (AREF (elt
, 0)) != (n
>> 8))
562 else if (SYMBOLP (val
))
564 int n
= font_style_to_value (prop
, val
, 0);
566 val
= n
>= 0 ? make_number (n
) : Qerror
;
574 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
576 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
581 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
583 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
585 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
587 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
589 if (spacing
== 'c' || spacing
== 'C')
590 return make_number (FONT_SPACING_CHARCELL
);
591 if (spacing
== 'm' || spacing
== 'M')
592 return make_number (FONT_SPACING_MONO
);
593 if (spacing
== 'p' || spacing
== 'P')
594 return make_number (FONT_SPACING_PROPORTIONAL
);
595 if (spacing
== 'd' || spacing
== 'D')
596 return make_number (FONT_SPACING_DUAL
);
602 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
604 Lisp_Object tail
, tmp
;
607 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
608 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
609 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
612 if (! SYMBOLP (XCAR (val
)))
617 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
619 for (i
= 0; i
< 2; i
++)
626 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
627 if (! SYMBOLP (XCAR (tmp
)))
635 /* Structure of known font property keys and validator of the
639 /* Pointer to the key symbol. */
641 /* Function to validate PROP's value VAL, or NULL if any value is
642 ok. The value is VAL or its regularized value if VAL is valid,
643 and Qerror if not. */
644 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
645 } font_property_table
[] =
646 { { &QCtype
, font_prop_validate_symbol
},
647 { &QCfoundry
, font_prop_validate_symbol
},
648 { &QCfamily
, font_prop_validate_symbol
},
649 { &QCadstyle
, font_prop_validate_symbol
},
650 { &QCregistry
, font_prop_validate_symbol
},
651 { &QCweight
, font_prop_validate_style
},
652 { &QCslant
, font_prop_validate_style
},
653 { &QCwidth
, font_prop_validate_style
},
654 { &QCsize
, font_prop_validate_non_neg
},
655 { &QCdpi
, font_prop_validate_non_neg
},
656 { &QCspacing
, font_prop_validate_spacing
},
657 { &QCavgwidth
, font_prop_validate_non_neg
},
658 /* The order of the above entries must match with enum
659 font_property_index. */
660 { &QClang
, font_prop_validate_symbol
},
661 { &QCscript
, font_prop_validate_symbol
},
662 { &QCotf
, font_prop_validate_otf
}
665 /* Return an index number of font property KEY or -1 if KEY is not an
666 already known property. */
669 get_font_prop_index (Lisp_Object key
)
673 for (i
= 0; i
< ARRAYELTS (font_property_table
); i
++)
674 if (EQ (key
, *font_property_table
[i
].key
))
679 /* Validate the font property. The property key is specified by the
680 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
681 signal an error. The value is VAL or the regularized one. */
684 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
686 Lisp_Object validated
;
691 prop
= *font_property_table
[idx
].key
;
694 idx
= get_font_prop_index (prop
);
698 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
699 if (EQ (validated
, Qerror
))
700 signal_error ("invalid font property", Fcons (prop
, val
));
705 /* Store VAL as a value of extra font property PROP in FONT while
706 keeping the sorting order. Don't check the validity of VAL. */
709 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
711 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
712 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
716 Lisp_Object prev
= Qnil
;
719 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
720 prev
= extra
, extra
= XCDR (extra
);
723 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
725 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
731 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
736 /* Font name parser and unparser. */
738 static int parse_matrix (const char *);
739 static int font_expand_wildcards (Lisp_Object
*, int);
740 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
742 /* An enumerator for each field of an XLFD font name. */
743 enum xlfd_field_index
762 /* An enumerator for mask bit corresponding to each XLFD field. */
765 XLFD_FOUNDRY_MASK
= 0x0001,
766 XLFD_FAMILY_MASK
= 0x0002,
767 XLFD_WEIGHT_MASK
= 0x0004,
768 XLFD_SLANT_MASK
= 0x0008,
769 XLFD_SWIDTH_MASK
= 0x0010,
770 XLFD_ADSTYLE_MASK
= 0x0020,
771 XLFD_PIXEL_MASK
= 0x0040,
772 XLFD_POINT_MASK
= 0x0080,
773 XLFD_RESX_MASK
= 0x0100,
774 XLFD_RESY_MASK
= 0x0200,
775 XLFD_SPACING_MASK
= 0x0400,
776 XLFD_AVGWIDTH_MASK
= 0x0800,
777 XLFD_REGISTRY_MASK
= 0x1000,
778 XLFD_ENCODING_MASK
= 0x2000
782 /* Parse P pointing to the pixel/point size field of the form
783 `[A B C D]' which specifies a transformation matrix:
789 by which all glyphs of the font are transformed. The spec says
790 that scalar value N for the pixel/point size is equivalent to:
791 A = N * resx/resy, B = C = 0, D = N.
793 Return the scalar value N if the form is valid. Otherwise return
797 parse_matrix (const char *p
)
803 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
806 matrix
[i
] = - strtod (p
+ 1, &end
);
808 matrix
[i
] = strtod (p
, &end
);
811 return (i
== 4 ? (int) matrix
[3] : -1);
814 /* Expand a wildcard field in FIELD (the first N fields are filled) to
815 multiple fields to fill in all 14 XLFD fields while restricting a
816 field position by its contents. */
819 font_expand_wildcards (Lisp_Object
*field
, int n
)
822 Lisp_Object tmp
[XLFD_LAST_INDEX
];
823 /* Array of information about where this element can go. Nth
824 element is for Nth element of FIELD. */
826 /* Minimum possible field. */
828 /* Maximum possible field. */
830 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
832 } range
[XLFD_LAST_INDEX
];
834 int range_from
, range_to
;
837 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
838 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
839 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
840 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
841 | XLFD_AVGWIDTH_MASK)
842 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
844 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
845 field. The value is shifted to left one bit by one in the
847 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
848 range_mask
= (range_mask
<< 1) | 1;
850 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
851 position-based restriction for FIELD[I]. */
852 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
853 i
++, range_from
++, range_to
++, range_mask
<<= 1)
855 Lisp_Object val
= field
[i
];
861 range
[i
].from
= range_from
;
862 range
[i
].to
= range_to
;
863 range
[i
].mask
= range_mask
;
867 /* The triplet FROM, TO, and MASK is a value-based
868 restriction for FIELD[I]. */
874 EMACS_INT numeric
= XINT (val
);
877 from
= to
= XLFD_ENCODING_INDEX
,
878 mask
= XLFD_ENCODING_MASK
;
879 else if (numeric
== 0)
880 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
881 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
882 else if (numeric
<= 48)
883 from
= to
= XLFD_PIXEL_INDEX
,
884 mask
= XLFD_PIXEL_MASK
;
886 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
887 mask
= XLFD_LARGENUM_MASK
;
889 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
890 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
891 mask
= XLFD_NULL_MASK
;
893 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
896 Lisp_Object name
= SYMBOL_NAME (val
);
898 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
899 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
900 mask
= XLFD_REGENC_MASK
;
902 from
= to
= XLFD_ENCODING_INDEX
,
903 mask
= XLFD_ENCODING_MASK
;
905 else if (range_from
<= XLFD_WEIGHT_INDEX
906 && range_to
>= XLFD_WEIGHT_INDEX
907 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
908 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
909 else if (range_from
<= XLFD_SLANT_INDEX
910 && range_to
>= XLFD_SLANT_INDEX
911 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
912 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
913 else if (range_from
<= XLFD_SWIDTH_INDEX
914 && range_to
>= XLFD_SWIDTH_INDEX
915 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
916 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
919 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
920 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
922 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
923 mask
= XLFD_SYMBOL_MASK
;
926 /* Merge position-based and value-based restrictions. */
928 while (from
< range_from
)
929 mask
&= ~(1 << from
++);
930 while (from
< 14 && ! (mask
& (1 << from
)))
932 while (to
> range_to
)
933 mask
&= ~(1 << to
--);
934 while (to
>= 0 && ! (mask
& (1 << to
)))
938 range
[i
].from
= from
;
940 range
[i
].mask
= mask
;
942 if (from
> range_from
|| to
< range_to
)
944 /* The range is narrowed by value-based restrictions.
945 Reflect it to the other fields. */
947 /* Following fields should be after FROM. */
949 /* Preceding fields should be before TO. */
950 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
952 /* Check FROM for non-wildcard field. */
953 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
955 while (range
[j
].from
< from
)
956 range
[j
].mask
&= ~(1 << range
[j
].from
++);
957 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
959 range
[j
].from
= from
;
962 from
= range
[j
].from
;
963 if (range
[j
].to
> to
)
965 while (range
[j
].to
> to
)
966 range
[j
].mask
&= ~(1 << range
[j
].to
--);
967 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
980 /* Decide all fields from restrictions in RANGE. */
981 for (i
= j
= 0; i
< n
; i
++)
983 if (j
< range
[i
].from
)
985 if (i
== 0 || ! NILP (tmp
[i
- 1]))
986 /* None of TMP[X] corresponds to Jth field. */
988 for (; j
< range
[i
].from
; j
++)
993 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
995 for (; j
< XLFD_LAST_INDEX
; j
++)
997 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
998 field
[XLFD_ENCODING_INDEX
]
999 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1004 /* Parse NAME (null terminated) as XLFD and store information in FONT
1005 (font-spec or font-entity). Size property of FONT is set as
1007 specified XLFD fields FONT property
1008 --------------------- -------------
1009 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1010 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1011 POINT_SIZE POINT_SIZE/10 (Lisp float)
1013 If NAME is successfully parsed, return 0. Otherwise return -1.
1015 FONT is usually a font-spec, but when this function is called from
1016 X font backend driver, it is a font-entity. In that case, NAME is
1017 a fully specified XLFD. */
1020 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1023 char *f
[XLFD_LAST_INDEX
+ 1];
1027 if (len
> 255 || !len
)
1028 /* Maximum XLFD name length is 255. */
1030 /* Accept "*-.." as a fully specified XLFD. */
1031 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1032 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1035 for (p
= name
+ i
; *p
; p
++)
1039 if (i
== XLFD_LAST_INDEX
)
1044 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1045 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1047 if (i
== XLFD_LAST_INDEX
)
1049 /* Fully specified XLFD. */
1052 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1053 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1054 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1055 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1057 val
= INTERN_FIELD_SYM (i
);
1060 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1062 ASET (font
, j
, make_number (n
));
1065 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1066 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1067 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1069 ASET (font
, FONT_REGISTRY_INDEX
,
1070 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1071 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1073 p
= f
[XLFD_PIXEL_INDEX
];
1074 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1075 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1078 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1080 ASET (font
, FONT_SIZE_INDEX
, val
);
1081 else if (FONT_ENTITY_P (font
))
1085 double point_size
= -1;
1087 eassert (FONT_SPEC_P (font
));
1088 p
= f
[XLFD_POINT_INDEX
];
1090 point_size
= parse_matrix (p
);
1091 else if (c_isdigit (*p
))
1092 point_size
= atoi (p
), point_size
/= 10;
1093 if (point_size
>= 0)
1094 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1098 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1099 if (! NILP (val
) && ! INTEGERP (val
))
1101 ASET (font
, FONT_DPI_INDEX
, val
);
1102 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1105 val
= font_prop_validate_spacing (QCspacing
, val
);
1106 if (! INTEGERP (val
))
1108 ASET (font
, FONT_SPACING_INDEX
, val
);
1110 p
= f
[XLFD_AVGWIDTH_INDEX
];
1113 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1114 if (! NILP (val
) && ! INTEGERP (val
))
1116 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1120 bool wild_card_found
= 0;
1121 Lisp_Object prop
[XLFD_LAST_INDEX
];
1123 if (FONT_ENTITY_P (font
))
1125 for (j
= 0; j
< i
; j
++)
1129 if (f
[j
][1] && f
[j
][1] != '-')
1132 wild_card_found
= 1;
1135 prop
[j
] = INTERN_FIELD (j
);
1137 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1139 if (! wild_card_found
)
1141 if (font_expand_wildcards (prop
, i
) < 0)
1144 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1145 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1146 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1147 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1148 if (! NILP (prop
[i
]))
1150 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1152 ASET (font
, j
, make_number (n
));
1154 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1155 val
= prop
[XLFD_REGISTRY_INDEX
];
1158 val
= prop
[XLFD_ENCODING_INDEX
];
1160 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1162 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1163 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1165 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1166 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1168 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1170 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1171 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1172 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1174 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1176 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1179 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1180 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1181 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1183 val
= font_prop_validate_spacing (QCspacing
,
1184 prop
[XLFD_SPACING_INDEX
]);
1185 if (! INTEGERP (val
))
1187 ASET (font
, FONT_SPACING_INDEX
, val
);
1189 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1190 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1196 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1197 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1198 0, use PIXEL_SIZE instead. */
1201 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1204 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1208 eassert (FONTP (font
));
1210 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1213 if (i
== FONT_ADSTYLE_INDEX
)
1214 j
= XLFD_ADSTYLE_INDEX
;
1215 else if (i
== FONT_REGISTRY_INDEX
)
1216 j
= XLFD_REGISTRY_INDEX
;
1217 val
= AREF (font
, i
);
1220 if (j
== XLFD_REGISTRY_INDEX
)
1228 val
= SYMBOL_NAME (val
);
1229 if (j
== XLFD_REGISTRY_INDEX
1230 && ! strchr (SSDATA (val
), '-'))
1232 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1233 ptrdiff_t alloc
= SBYTES (val
) + 4;
1234 if (nbytes
<= alloc
)
1236 f
[j
] = p
= alloca (alloc
);
1237 sprintf (p
, "%s%s-*", SDATA (val
),
1238 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1241 f
[j
] = SSDATA (val
);
1245 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1248 val
= font_style_symbolic (font
, i
, 0);
1256 val
= SYMBOL_NAME (val
);
1257 alloc
= SBYTES (val
) + 1;
1258 if (nbytes
<= alloc
)
1260 f
[j
] = p
= alloca (alloc
);
1261 /* Copy the name while excluding '-', '?', ',', and '"'. */
1262 for (k
= l
= 0; k
< alloc
; k
++)
1265 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1271 val
= AREF (font
, FONT_SIZE_INDEX
);
1272 eassert (NUMBERP (val
) || NILP (val
));
1275 EMACS_INT v
= XINT (val
);
1280 f
[XLFD_PIXEL_INDEX
] = p
=
1281 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1282 sprintf (p
, "%"pI
"d-*", v
);
1285 f
[XLFD_PIXEL_INDEX
] = "*-*";
1287 else if (FLOATP (val
))
1289 double v
= XFLOAT_DATA (val
) * 10;
1290 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1291 sprintf (p
, "*-%.0f", v
);
1294 f
[XLFD_PIXEL_INDEX
] = "*-*";
1296 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1298 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1299 f
[XLFD_RESX_INDEX
] = p
=
1300 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1301 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1304 f
[XLFD_RESX_INDEX
] = "*-*";
1305 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1307 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1309 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1310 : spacing
<= FONT_SPACING_DUAL
? "d"
1311 : spacing
<= FONT_SPACING_MONO
? "m"
1315 f
[XLFD_SPACING_INDEX
] = "*";
1316 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1318 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1319 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1322 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1323 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1324 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1325 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1326 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1327 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1328 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1329 f
[XLFD_REGISTRY_INDEX
]);
1330 return len
< nbytes
? len
: -1;
1333 /* Parse NAME (null terminated) and store information in FONT
1334 (font-spec or font-entity). NAME is supplied in either the
1335 Fontconfig or GTK font name format. If NAME is successfully
1336 parsed, return 0. Otherwise return -1.
1338 The fontconfig format is
1340 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1344 FAMILY [PROPS...] [SIZE]
1346 This function tries to guess which format it is. */
1349 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1352 char *size_beg
= NULL
, *size_end
= NULL
;
1353 char *props_beg
= NULL
, *family_end
= NULL
;
1358 for (p
= name
; *p
; p
++)
1360 if (*p
== '\\' && p
[1])
1364 props_beg
= family_end
= p
;
1369 bool decimal
= 0, size_found
= 1;
1370 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1371 if (! c_isdigit (*q
))
1373 if (*q
!= '.' || decimal
)
1392 Lisp_Object extra_props
= Qnil
;
1394 /* A fontconfig name with size and/or property data. */
1395 if (family_end
> name
)
1398 family
= font_intern_prop (name
, family_end
- name
, 1);
1399 ASET (font
, FONT_FAMILY_INDEX
, family
);
1403 double point_size
= strtod (size_beg
, &size_end
);
1404 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1405 if (*size_end
== ':' && size_end
[1])
1406 props_beg
= size_end
;
1410 /* Now parse ":KEY=VAL" patterns. */
1413 for (p
= props_beg
; *p
; p
= q
)
1415 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1418 /* Must be an enumerated value. */
1422 val
= font_intern_prop (p
, q
- p
, 1);
1424 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1425 && memcmp (p, STR, strlen (STR)) == 0)
1427 if (PROP_MATCH ("light")
1428 || PROP_MATCH ("medium")
1429 || PROP_MATCH ("demibold")
1430 || PROP_MATCH ("bold")
1431 || PROP_MATCH ("black"))
1432 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1433 else if (PROP_MATCH ("roman")
1434 || PROP_MATCH ("italic")
1435 || PROP_MATCH ("oblique"))
1436 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1437 else if (PROP_MATCH ("charcell"))
1438 ASET (font
, FONT_SPACING_INDEX
,
1439 make_number (FONT_SPACING_CHARCELL
));
1440 else if (PROP_MATCH ("mono"))
1441 ASET (font
, FONT_SPACING_INDEX
,
1442 make_number (FONT_SPACING_MONO
));
1443 else if (PROP_MATCH ("proportional"))
1444 ASET (font
, FONT_SPACING_INDEX
,
1445 make_number (FONT_SPACING_PROPORTIONAL
));
1454 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1455 prop
= FONT_SIZE_INDEX
;
1458 key
= font_intern_prop (p
, q
- p
, 1);
1459 prop
= get_font_prop_index (key
);
1463 for (q
= p
; *q
&& *q
!= ':'; q
++);
1464 val
= font_intern_prop (p
, q
- p
, 0);
1466 if (prop
>= FONT_FOUNDRY_INDEX
1467 && prop
< FONT_EXTRA_INDEX
)
1468 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1471 extra_props
= nconc2 (extra_props
,
1472 list1 (Fcons (key
, val
)));
1479 if (! NILP (extra_props
))
1481 struct font_driver_list
*driver_list
= font_driver_list
;
1482 for ( ; driver_list
; driver_list
= driver_list
->next
)
1483 if (driver_list
->driver
->filter_properties
)
1484 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1490 /* Either a fontconfig-style name with no size and property
1491 data, or a GTK-style name. */
1492 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1493 Lisp_Object width
= Qnil
, size
= Qnil
;
1497 /* Scan backwards from the end, looking for a size. */
1498 for (p
= name
+ len
- 1; p
>= name
; p
--)
1499 if (!c_isdigit (*p
))
1502 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1503 /* Found a font size. */
1504 size
= make_float (strtod (p
+ 1, NULL
));
1508 /* Now P points to the termination of the string, sans size.
1509 Scan backwards, looking for font properties. */
1510 for (; p
> name
; p
= q
)
1512 for (q
= p
- 1; q
>= name
; q
--)
1514 if (q
> name
&& *(q
-1) == '\\')
1515 --q
; /* Skip quoting backslashes. */
1521 word_len
= p
- word_start
;
1523 #define PROP_MATCH(STR) \
1524 (word_len == strlen (STR) \
1525 && memcmp (word_start, STR, strlen (STR)) == 0)
1526 #define PROP_SAVE(VAR, STR) \
1527 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1529 if (PROP_MATCH ("Ultra-Light"))
1530 PROP_SAVE (weight
, "ultra-light");
1531 else if (PROP_MATCH ("Light"))
1532 PROP_SAVE (weight
, "light");
1533 else if (PROP_MATCH ("Book"))
1534 PROP_SAVE (weight
, "book");
1535 else if (PROP_MATCH ("Medium"))
1536 PROP_SAVE (weight
, "medium");
1537 else if (PROP_MATCH ("Semi-Bold"))
1538 PROP_SAVE (weight
, "semi-bold");
1539 else if (PROP_MATCH ("Bold"))
1540 PROP_SAVE (weight
, "bold");
1541 else if (PROP_MATCH ("Italic"))
1542 PROP_SAVE (slant
, "italic");
1543 else if (PROP_MATCH ("Oblique"))
1544 PROP_SAVE (slant
, "oblique");
1545 else if (PROP_MATCH ("Semi-Condensed"))
1546 PROP_SAVE (width
, "semi-condensed");
1547 else if (PROP_MATCH ("Condensed"))
1548 PROP_SAVE (width
, "condensed");
1549 /* An unknown word must be part of the font name. */
1560 ASET (font
, FONT_FAMILY_INDEX
,
1561 font_intern_prop (name
, family_end
- name
, 1));
1563 ASET (font
, FONT_SIZE_INDEX
, size
);
1565 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1567 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1569 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1575 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1576 NAME (NBYTES length), and return the name length. If
1577 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1580 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1582 Lisp_Object family
, foundry
;
1588 Lisp_Object styles
[3];
1589 const char *style_names
[3] = { "weight", "slant", "width" };
1591 family
= AREF (font
, FONT_FAMILY_INDEX
);
1592 if (! NILP (family
))
1594 if (SYMBOLP (family
))
1595 family
= SYMBOL_NAME (family
);
1600 val
= AREF (font
, FONT_SIZE_INDEX
);
1603 if (XINT (val
) != 0)
1604 pixel_size
= XINT (val
);
1609 eassert (FLOATP (val
));
1611 point_size
= (int) XFLOAT_DATA (val
);
1614 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1615 if (! NILP (foundry
))
1617 if (SYMBOLP (foundry
))
1618 foundry
= SYMBOL_NAME (foundry
);
1623 for (i
= 0; i
< 3; i
++)
1624 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1627 lim
= name
+ nbytes
;
1628 if (! NILP (family
))
1630 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1631 if (! (0 <= len
&& len
< lim
- p
))
1637 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1638 if (! (0 <= len
&& len
< lim
- p
))
1642 else if (pixel_size
> 0)
1644 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1645 if (! (0 <= len
&& len
< lim
- p
))
1649 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1651 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1652 SSDATA (SYMBOL_NAME (AREF (font
,
1653 FONT_FOUNDRY_INDEX
))));
1654 if (! (0 <= len
&& len
< lim
- p
))
1658 for (i
= 0; i
< 3; i
++)
1659 if (! NILP (styles
[i
]))
1661 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1662 SSDATA (SYMBOL_NAME (styles
[i
])));
1663 if (! (0 <= len
&& len
< lim
- p
))
1668 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1670 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1671 XINT (AREF (font
, FONT_DPI_INDEX
)));
1672 if (! (0 <= len
&& len
< lim
- p
))
1677 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1679 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1680 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1681 if (! (0 <= len
&& len
< lim
- p
))
1686 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1688 int len
= snprintf (p
, lim
- p
,
1689 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1691 : ":scalable=false"));
1692 if (! (0 <= len
&& len
< lim
- p
))
1700 /* Parse NAME (null terminated) and store information in FONT
1701 (font-spec or font-entity). If NAME is successfully parsed, return
1702 0. Otherwise return -1. */
1705 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1707 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1708 return font_parse_xlfd (name
, namelen
, font
);
1709 return font_parse_fcname (name
, namelen
, font
);
1713 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1714 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1718 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1724 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1726 CHECK_STRING (family
);
1727 len
= SBYTES (family
);
1728 p0
= SSDATA (family
);
1729 p1
= strchr (p0
, '-');
1732 if ((*p0
!= '*' && p1
- p0
> 0)
1733 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1734 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1737 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1740 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1742 if (! NILP (registry
))
1744 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1745 CHECK_STRING (registry
);
1746 len
= SBYTES (registry
);
1747 p0
= SSDATA (registry
);
1748 p1
= strchr (p0
, '-');
1751 if (SDATA (registry
)[len
- 1] == '*')
1752 registry
= concat2 (registry
, build_string ("-*"));
1754 registry
= concat2 (registry
, build_string ("*-*"));
1756 registry
= Fdowncase (registry
);
1757 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1762 /* This part (through the next ^L) is still experimental and not
1763 tested much. We may drastically change codes. */
1769 #define LGSTRING_HEADER_SIZE 6
1770 #define LGSTRING_GLYPH_SIZE 8
1773 check_gstring (Lisp_Object gstring
)
1779 CHECK_VECTOR (gstring
);
1780 val
= AREF (gstring
, 0);
1782 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1784 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1785 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1786 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1787 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1788 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1789 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1790 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1791 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1792 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1793 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1794 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1796 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1798 val
= LGSTRING_GLYPH (gstring
, i
);
1800 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1802 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1804 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1805 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1806 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1807 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1808 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1809 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1810 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1811 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1813 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1815 if (ASIZE (val
) < 3)
1817 for (j
= 0; j
< 3; j
++)
1818 CHECK_NUMBER (AREF (val
, j
));
1823 error ("Invalid glyph-string format");
1828 check_otf_features (Lisp_Object otf_features
)
1832 CHECK_CONS (otf_features
);
1833 CHECK_SYMBOL (XCAR (otf_features
));
1834 otf_features
= XCDR (otf_features
);
1835 CHECK_CONS (otf_features
);
1836 CHECK_SYMBOL (XCAR (otf_features
));
1837 otf_features
= XCDR (otf_features
);
1838 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1840 CHECK_SYMBOL (XCAR (val
));
1841 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1842 error ("Invalid OTF GSUB feature: %s",
1843 SDATA (SYMBOL_NAME (XCAR (val
))));
1845 otf_features
= XCDR (otf_features
);
1846 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1848 CHECK_SYMBOL (XCAR (val
));
1849 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1850 error ("Invalid OTF GPOS feature: %s",
1851 SDATA (SYMBOL_NAME (XCAR (val
))));
1858 Lisp_Object otf_list
;
1861 otf_tag_symbol (OTF_Tag tag
)
1865 OTF_tag_name (tag
, name
);
1866 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1870 otf_open (Lisp_Object file
)
1872 Lisp_Object val
= Fassoc (file
, otf_list
);
1876 otf
= XSAVE_POINTER (XCDR (val
), 0);
1879 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1880 val
= make_save_ptr (otf
);
1881 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1887 /* Return a list describing which scripts/languages FONT supports by
1888 which GSUB/GPOS features of OpenType tables. See the comment of
1889 (struct font_driver).otf_capability. */
1892 font_otf_capability (struct font
*font
)
1895 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1898 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1901 for (i
= 0; i
< 2; i
++)
1903 OTF_GSUB_GPOS
*gsub_gpos
;
1904 Lisp_Object script_list
= Qnil
;
1907 if (OTF_get_features (otf
, i
== 0) < 0)
1909 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1910 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1912 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1913 Lisp_Object langsys_list
= Qnil
;
1914 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1917 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1919 OTF_LangSys
*langsys
;
1920 Lisp_Object feature_list
= Qnil
;
1921 Lisp_Object langsys_tag
;
1924 if (k
== script
->LangSysCount
)
1926 langsys
= &script
->DefaultLangSys
;
1931 langsys
= script
->LangSys
+ k
;
1933 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1935 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1937 OTF_Feature
*feature
1938 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1939 Lisp_Object feature_tag
1940 = otf_tag_symbol (feature
->FeatureTag
);
1942 feature_list
= Fcons (feature_tag
, feature_list
);
1944 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1947 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1952 XSETCAR (capability
, script_list
);
1954 XSETCDR (capability
, script_list
);
1960 /* Parse OTF features in SPEC and write a proper features spec string
1961 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1962 assured that the sufficient memory has already allocated for
1966 generate_otf_features (Lisp_Object spec
, char *features
)
1974 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1980 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1985 else if (! asterisk
)
1987 val
= SYMBOL_NAME (val
);
1988 p
+= esprintf (p
, "%s", SDATA (val
));
1992 val
= SYMBOL_NAME (val
);
1993 p
+= esprintf (p
, "~%s", SDATA (val
));
1997 error ("OTF spec too long");
2001 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
2003 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2005 return Fcons (make_number (len
),
2006 make_unibyte_string (device_table
->DeltaValue
, len
));
2010 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2012 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2014 if (value_format
& OTF_XPlacement
)
2015 ASET (val
, 0, make_number (value_record
->XPlacement
));
2016 if (value_format
& OTF_YPlacement
)
2017 ASET (val
, 1, make_number (value_record
->YPlacement
));
2018 if (value_format
& OTF_XAdvance
)
2019 ASET (val
, 2, make_number (value_record
->XAdvance
));
2020 if (value_format
& OTF_YAdvance
)
2021 ASET (val
, 3, make_number (value_record
->YAdvance
));
2022 if (value_format
& OTF_XPlaDevice
)
2023 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2024 if (value_format
& OTF_YPlaDevice
)
2025 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2026 if (value_format
& OTF_XAdvDevice
)
2027 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2028 if (value_format
& OTF_YAdvDevice
)
2029 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2034 font_otf_Anchor (OTF_Anchor
*anchor
)
2038 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2039 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2040 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2041 if (anchor
->AnchorFormat
== 2)
2042 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2045 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2046 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2050 #endif /* HAVE_LIBOTF */
2057 font_rescale_ratio (Lisp_Object font_entity
)
2059 Lisp_Object tail
, elt
;
2060 Lisp_Object name
= Qnil
;
2062 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2065 if (FLOATP (XCDR (elt
)))
2067 if (STRINGP (XCAR (elt
)))
2070 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2071 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2072 return XFLOAT_DATA (XCDR (elt
));
2074 else if (FONT_SPEC_P (XCAR (elt
)))
2076 if (font_match_p (XCAR (elt
), font_entity
))
2077 return XFLOAT_DATA (XCDR (elt
));
2084 /* We sort fonts by scoring each of them against a specified
2085 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2086 the value is, the closer the font is to the font-spec.
2088 The lowest 2 bits of the score are used for driver type. The font
2089 available by the most preferred font driver is 0.
2091 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2092 WEIGHT, SLANT, WIDTH, and SIZE. */
2094 /* How many bits to shift to store the difference value of each font
2095 property in a score. Note that floats for FONT_TYPE_INDEX and
2096 FONT_REGISTRY_INDEX are not used. */
2097 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2099 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2100 The return value indicates how different ENTITY is compared with
2104 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2109 /* Score three style numeric fields. Maximum difference is 127. */
2110 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2111 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2113 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2114 - (XINT (spec_prop
[i
]) >> 8));
2115 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2118 /* Score the size. Maximum difference is 127. */
2119 i
= FONT_SIZE_INDEX
;
2120 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2121 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2123 /* We use the higher 6-bit for the actual size difference. The
2124 lowest bit is set if the DPI is different. */
2126 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2128 if (CONSP (Vface_font_rescale_alist
))
2129 pixel_size
*= font_rescale_ratio (entity
);
2130 diff
= eabs (pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
))) << 1;
2131 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2132 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2134 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2135 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2137 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2144 /* Concatenate all elements of LIST into one vector. LIST is a list
2145 of font-entity vectors. */
2148 font_vconcat_entity_vectors (Lisp_Object list
)
2150 int nargs
= XINT (Flength (list
));
2151 Lisp_Object
*args
= alloca (word_size
* nargs
);
2154 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2155 args
[i
] = XCAR (list
);
2156 return Fvconcat (nargs
, args
);
2160 /* The structure for elements being sorted by qsort. */
2161 struct font_sort_data
2164 int font_driver_preference
;
2169 /* The comparison function for qsort. */
2172 font_compare (const void *d1
, const void *d2
)
2174 const struct font_sort_data
*data1
= d1
;
2175 const struct font_sort_data
*data2
= d2
;
2177 if (data1
->score
< data2
->score
)
2179 else if (data1
->score
> data2
->score
)
2181 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2185 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2186 If PREFER specifies a point-size, calculate the corresponding
2187 pixel-size from QCdpi property of PREFER or from the Y-resolution
2188 of FRAME before sorting.
2190 If BEST-ONLY is nonzero, return the best matching entity (that
2191 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2192 if BEST-ONLY is negative). Otherwise, return the sorted result as
2193 a single vector of font-entities.
2195 This function does no optimization for the case that the total
2196 number of elements is 1. The caller should avoid calling this in
2200 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2201 struct frame
*f
, int best_only
)
2203 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2205 struct font_sort_data
*data
;
2206 unsigned best_score
;
2207 Lisp_Object best_entity
;
2208 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2211 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2212 prefer_prop
[i
] = AREF (prefer
, i
);
2213 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2214 prefer_prop
[FONT_SIZE_INDEX
]
2215 = make_number (font_pixel_size (f
, prefer
));
2217 if (NILP (XCDR (list
)))
2219 /* What we have to take care of is this single vector. */
2221 maxlen
= ASIZE (vec
);
2225 /* We don't have to perform sort, so there's no need of creating
2226 a single vector. But, we must find the length of the longest
2229 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2230 if (maxlen
< ASIZE (XCAR (tail
)))
2231 maxlen
= ASIZE (XCAR (tail
));
2235 /* We have to create a single vector to sort it. */
2236 vec
= font_vconcat_entity_vectors (list
);
2237 maxlen
= ASIZE (vec
);
2240 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2241 best_score
= 0xFFFFFFFF;
2244 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2246 int font_driver_preference
= 0;
2247 Lisp_Object current_font_driver
;
2253 /* We are sure that the length of VEC > 0. */
2254 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2255 /* Score the elements. */
2256 for (i
= 0; i
< len
; i
++)
2258 data
[i
].entity
= AREF (vec
, i
);
2260 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2262 ? font_score (data
[i
].entity
, prefer_prop
)
2264 if (best_only
&& best_score
> data
[i
].score
)
2266 best_score
= data
[i
].score
;
2267 best_entity
= data
[i
].entity
;
2268 if (best_score
== 0)
2271 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2273 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2274 font_driver_preference
++;
2276 data
[i
].font_driver_preference
= font_driver_preference
;
2279 /* Sort if necessary. */
2282 qsort (data
, len
, sizeof *data
, font_compare
);
2283 for (i
= 0; i
< len
; i
++)
2284 ASET (vec
, i
, data
[i
].entity
);
2293 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2298 /* API of Font Service Layer. */
2300 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2301 sort_shift_bits. Finternal_set_font_selection_order calls this
2302 function with font_sort_order after setting up it. */
2305 font_update_sort_order (int *order
)
2309 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2311 int xlfd_idx
= order
[i
];
2313 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2314 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2315 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2316 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2317 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2318 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2320 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2325 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2326 Lisp_Object features
, Lisp_Object table
)
2331 table
= assq_no_quit (script
, table
);
2334 table
= XCDR (table
);
2335 if (! NILP (langsys
))
2337 table
= assq_no_quit (langsys
, table
);
2343 val
= assq_no_quit (Qnil
, table
);
2345 table
= XCAR (table
);
2349 table
= XCDR (table
);
2350 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2352 if (NILP (XCAR (features
)))
2357 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2363 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2366 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2368 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2370 script
= XCAR (spec
);
2374 langsys
= XCAR (spec
);
2385 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2386 XCAR (otf_capability
)))
2388 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2389 XCDR (otf_capability
)))
2396 /* Check if FONT (font-entity or font-object) matches with the font
2397 specification SPEC. */
2400 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2402 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2403 Lisp_Object extra
, font_extra
;
2406 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2407 if (! NILP (AREF (spec
, i
))
2408 && ! NILP (AREF (font
, i
))
2409 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2411 props
= XFONT_SPEC (spec
)->props
;
2412 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2414 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2415 prop
[i
] = AREF (spec
, i
);
2416 prop
[FONT_SIZE_INDEX
]
2417 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2421 if (font_score (font
, props
) > 0)
2423 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2424 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2425 for (; CONSP (extra
); extra
= XCDR (extra
))
2427 Lisp_Object key
= XCAR (XCAR (extra
));
2428 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2430 if (EQ (key
, QClang
))
2432 val2
= assq_no_quit (key
, font_extra
);
2441 if (NILP (Fmemq (val
, val2
)))
2446 ? NILP (Fmemq (val
, XCDR (val2
)))
2450 else if (EQ (key
, QCscript
))
2452 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2458 /* All characters in the list must be supported. */
2459 for (; CONSP (val2
); val2
= XCDR (val2
))
2461 if (! CHARACTERP (XCAR (val2
)))
2463 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2464 == FONT_INVALID_CODE
)
2468 else if (VECTORP (val2
))
2470 /* At most one character in the vector must be supported. */
2471 for (i
= 0; i
< ASIZE (val2
); i
++)
2473 if (! CHARACTERP (AREF (val2
, i
)))
2475 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2476 != FONT_INVALID_CODE
)
2479 if (i
== ASIZE (val2
))
2484 else if (EQ (key
, QCotf
))
2488 if (! FONT_OBJECT_P (font
))
2490 fontp
= XFONT_OBJECT (font
);
2491 if (! fontp
->driver
->otf_capability
)
2493 val2
= fontp
->driver
->otf_capability (fontp
);
2494 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2505 Each font backend has the callback function get_cache, and it
2506 returns a cons cell of which cdr part can be freely used for
2507 caching fonts. The cons cell may be shared by multiple frames
2508 and/or multiple font drivers. So, we arrange the cdr part as this:
2510 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2512 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2513 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2514 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2516 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2517 static void font_finish_cache (struct frame
*, struct font_driver
*);
2518 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2519 static void font_clear_cache (struct frame
*, Lisp_Object
,
2520 struct font_driver
*);
2523 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2525 Lisp_Object cache
, val
;
2527 cache
= driver
->get_cache (f
);
2529 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2533 val
= list2 (driver
->type
, make_number (1));
2534 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2538 val
= XCDR (XCAR (val
));
2539 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2545 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2547 Lisp_Object cache
, val
, tmp
;
2550 cache
= driver
->get_cache (f
);
2552 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2553 cache
= val
, val
= XCDR (val
);
2554 eassert (! NILP (val
));
2555 tmp
= XCDR (XCAR (val
));
2556 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2557 if (XINT (XCAR (tmp
)) == 0)
2559 font_clear_cache (f
, XCAR (val
), driver
);
2560 XSETCDR (cache
, XCDR (val
));
2566 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2568 Lisp_Object val
= driver
->get_cache (f
);
2569 Lisp_Object type
= driver
->type
;
2571 eassert (CONSP (val
));
2572 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2573 eassert (CONSP (val
));
2574 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2575 val
= XCDR (XCAR (val
));
2581 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2583 Lisp_Object tail
, elt
;
2587 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2588 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2591 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2592 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2595 eassert (VECTORP (elt
));
2596 for (i
= 0; i
< ASIZE (elt
); i
++)
2598 entity
= AREF (elt
, i
);
2600 if (FONT_ENTITY_P (entity
)
2601 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2603 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2605 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2607 Lisp_Object val
= XCAR (objlist
);
2608 struct font
*font
= XFONT_OBJECT (val
);
2610 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2612 eassert (font
&& driver
== font
->driver
);
2613 driver
->close (font
);
2616 if (driver
->free_entity
)
2617 driver
->free_entity (entity
);
2622 XSETCDR (cache
, Qnil
);
2626 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2628 /* Check each font-entity in VEC, and return a list of font-entities
2629 that satisfy these conditions:
2630 (1) matches with SPEC and SIZE if SPEC is not nil, and
2631 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2635 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2637 Lisp_Object entity
, val
;
2638 enum font_property_index prop
;
2641 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2643 entity
= AREF (vec
, i
);
2644 if (! NILP (Vface_ignored_fonts
))
2648 Lisp_Object tail
, regexp
;
2650 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2653 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2655 regexp
= XCAR (tail
);
2656 if (STRINGP (regexp
)
2657 && fast_c_string_match_ignore_case (regexp
, name
,
2667 val
= Fcons (entity
, val
);
2670 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2671 if (INTEGERP (AREF (spec
, prop
))
2672 && ((XINT (AREF (spec
, prop
)) >> 8)
2673 != (XINT (AREF (entity
, prop
)) >> 8)))
2674 prop
= FONT_SPEC_MAX
;
2675 if (prop
< FONT_SPEC_MAX
2677 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2679 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2681 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2682 prop
= FONT_SPEC_MAX
;
2684 if (prop
< FONT_SPEC_MAX
2685 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2686 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2687 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2688 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2689 prop
= FONT_SPEC_MAX
;
2690 if (prop
< FONT_SPEC_MAX
2691 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2692 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2693 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2694 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2695 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2696 prop
= FONT_SPEC_MAX
;
2697 if (prop
< FONT_SPEC_MAX
)
2698 val
= Fcons (entity
, val
);
2700 return (Fvconcat (1, &val
));
2704 /* Return a list of vectors of font-entities matching with SPEC on
2705 FRAME. Each elements in the list is a vector of entities from the
2706 same font-driver. */
2709 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2711 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2712 Lisp_Object ftype
, val
;
2713 Lisp_Object list
= Qnil
;
2715 bool need_filtering
= 0;
2718 eassert (FONT_SPEC_P (spec
));
2720 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2721 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2722 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2723 size
= font_pixel_size (f
, spec
);
2727 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2728 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2729 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2730 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2731 if (i
!= FONT_SPACING_INDEX
)
2733 ASET (scratch_font_spec
, i
, Qnil
);
2734 if (! NILP (AREF (spec
, i
)))
2737 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2738 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2740 for (; driver_list
; driver_list
= driver_list
->next
)
2742 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2744 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2746 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2747 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2752 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2755 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2757 val
= Fvconcat (1, &val
);
2758 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2759 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2762 if (VECTORP (val
) && ASIZE (val
) > 0
2764 || ! NILP (Vface_ignored_fonts
)))
2765 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2766 if (VECTORP (val
) && ASIZE (val
) > 0)
2767 list
= Fcons (val
, list
);
2770 list
= Fnreverse (list
);
2771 FONT_ADD_LOG ("list", spec
, list
);
2776 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2777 nil, is an array of face's attributes, which specifies preferred
2778 font-related attributes. */
2781 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2783 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2784 Lisp_Object ftype
, size
, entity
;
2785 Lisp_Object work
= copy_font_spec (spec
);
2787 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2788 size
= AREF (spec
, FONT_SIZE_INDEX
);
2791 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2792 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2793 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2794 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2797 for (; driver_list
; driver_list
= driver_list
->next
)
2799 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2801 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2803 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2804 entity
= assoc_no_quit (work
, XCDR (cache
));
2806 entity
= XCDR (entity
);
2809 entity
= driver_list
->driver
->match (f
, work
);
2812 Lisp_Object copy
= copy_font_spec (work
);
2813 Lisp_Object match
= Fvector (1, &entity
);
2815 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2816 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2819 if (! NILP (entity
))
2822 FONT_ADD_LOG ("match", work
, entity
);
2827 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2828 opened font object. */
2831 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2833 struct font_driver_list
*driver_list
;
2834 Lisp_Object objlist
, size
, val
, font_object
;
2836 int min_width
, height
, psize
;
2838 eassert (FONT_ENTITY_P (entity
));
2839 size
= AREF (entity
, FONT_SIZE_INDEX
);
2840 if (XINT (size
) != 0)
2841 pixel_size
= XINT (size
);
2843 val
= AREF (entity
, FONT_TYPE_INDEX
);
2844 for (driver_list
= f
->font_driver_list
;
2845 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2846 driver_list
= driver_list
->next
);
2850 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2851 objlist
= XCDR (objlist
))
2853 Lisp_Object fn
= XCAR (objlist
);
2854 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2855 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2857 if (driver_list
->driver
->cached_font_ok
== NULL
2858 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2863 /* We always open a font of manageable size; i.e non-zero average
2864 width and height. */
2865 for (psize
= pixel_size
; ; psize
++)
2867 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2868 if (NILP (font_object
))
2870 font
= XFONT_OBJECT (font_object
);
2871 if (font
->average_width
> 0 && font
->height
> 0)
2874 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2875 FONT_ADD_LOG ("open", entity
, font_object
);
2876 ASET (entity
, FONT_OBJLIST_INDEX
,
2877 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2879 font
= XFONT_OBJECT (font_object
);
2880 min_width
= (font
->min_width
? font
->min_width
2881 : font
->average_width
? font
->average_width
2882 : font
->space_width
? font
->space_width
2884 height
= (font
->height
? font
->height
: 1);
2885 #ifdef HAVE_WINDOW_SYSTEM
2886 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2887 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2889 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2890 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2891 f
->fonts_changed
= 1;
2895 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2896 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2897 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2898 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2906 /* Close FONT_OBJECT that is opened on frame F. */
2909 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2911 struct font
*font
= XFONT_OBJECT (font_object
);
2913 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2914 /* Already closed. */
2916 FONT_ADD_LOG ("close", font_object
, Qnil
);
2917 font
->driver
->close (font
);
2918 #ifdef HAVE_WINDOW_SYSTEM
2919 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2920 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2925 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2926 FONT is a font-entity and it must be opened to check. */
2929 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2933 if (FONT_ENTITY_P (font
))
2935 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2936 struct font_driver_list
*driver_list
;
2938 for (driver_list
= f
->font_driver_list
;
2939 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2940 driver_list
= driver_list
->next
);
2943 if (! driver_list
->driver
->has_char
)
2945 return driver_list
->driver
->has_char (font
, c
);
2948 eassert (FONT_OBJECT_P (font
));
2949 fontp
= XFONT_OBJECT (font
);
2950 if (fontp
->driver
->has_char
)
2952 int result
= fontp
->driver
->has_char (font
, c
);
2957 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2961 /* Return the glyph ID of FONT_OBJECT for character C. */
2964 font_encode_char (Lisp_Object font_object
, int c
)
2968 eassert (FONT_OBJECT_P (font_object
));
2969 font
= XFONT_OBJECT (font_object
);
2970 return font
->driver
->encode_char (font
, c
);
2974 /* Return the name of FONT_OBJECT. */
2977 font_get_name (Lisp_Object font_object
)
2979 eassert (FONT_OBJECT_P (font_object
));
2980 return AREF (font_object
, FONT_NAME_INDEX
);
2984 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2985 could not be parsed by font_parse_name, return Qnil. */
2988 font_spec_from_name (Lisp_Object font_name
)
2990 Lisp_Object spec
= Ffont_spec (0, NULL
);
2992 CHECK_STRING (font_name
);
2993 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2995 font_put_extra (spec
, QCname
, font_name
);
2996 font_put_extra (spec
, QCuser_spec
, font_name
);
3002 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3004 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3009 if (! NILP (Ffont_get (font
, QCname
)))
3011 font
= copy_font_spec (font
);
3012 font_put_extra (font
, QCname
, Qnil
);
3015 if (NILP (AREF (font
, prop
))
3016 && prop
!= FONT_FAMILY_INDEX
3017 && prop
!= FONT_FOUNDRY_INDEX
3018 && prop
!= FONT_WIDTH_INDEX
3019 && prop
!= FONT_SIZE_INDEX
)
3021 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3022 font
= copy_font_spec (font
);
3023 ASET (font
, prop
, Qnil
);
3024 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3026 if (prop
== FONT_FAMILY_INDEX
)
3028 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3029 /* If we are setting the font family, we must also clear
3030 FONT_WIDTH_INDEX to avoid rejecting families that lack
3031 support for some widths. */
3032 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3034 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3035 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3036 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3037 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3038 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3039 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3041 else if (prop
== FONT_SIZE_INDEX
)
3043 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3044 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3045 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3047 else if (prop
== FONT_WIDTH_INDEX
)
3048 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3049 attrs
[LFACE_FONT_INDEX
] = font
;
3052 /* Select a font from ENTITIES (list of font-entity vectors) that
3053 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3056 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3057 Lisp_Object
*attrs
, int pixel_size
, int c
)
3059 Lisp_Object font_entity
;
3063 if (NILP (XCDR (entities
))
3064 && ASIZE (XCAR (entities
)) == 1)
3066 font_entity
= AREF (XCAR (entities
), 0);
3067 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3072 /* Sort fonts by properties specified in ATTRS. */
3073 prefer
= scratch_font_prefer
;
3075 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3076 ASET (prefer
, i
, Qnil
);
3077 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3079 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3081 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3082 ASET (prefer
, i
, AREF (face_font
, i
));
3084 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3085 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3086 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3087 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3088 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3089 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3090 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3092 return font_sort_entities (entities
, prefer
, f
, c
);
3095 /* Return a font-entity that satisfies SPEC and is the best match for
3096 face's font related attributes in ATTRS. C, if not negative, is a
3097 character that the entity must support. */
3100 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3103 Lisp_Object entities
, val
;
3104 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3109 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3110 if (NILP (registry
[0]))
3112 registry
[0] = DEFAULT_ENCODING
;
3113 registry
[1] = Qascii_0
;
3114 registry
[2] = zero_vector
;
3117 registry
[1] = zero_vector
;
3119 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3121 struct charset
*encoding
, *repertory
;
3123 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3124 &encoding
, &repertory
) < 0)
3127 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3129 else if (c
> encoding
->max_char
)
3133 work
= copy_font_spec (spec
);
3134 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3135 pixel_size
= font_pixel_size (f
, spec
);
3136 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3138 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3140 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3144 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3145 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3146 if (! NILP (foundry
[0]))
3147 foundry
[1] = zero_vector
;
3148 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3150 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3151 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3153 foundry
[2] = zero_vector
;
3156 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3158 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3159 if (! NILP (adstyle
[0]))
3160 adstyle
[1] = zero_vector
;
3161 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3163 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3165 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3167 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3169 adstyle
[2] = zero_vector
;
3172 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3175 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3178 val
= AREF (work
, FONT_FAMILY_INDEX
);
3179 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3181 val
= attrs
[LFACE_FAMILY_INDEX
];
3182 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3186 family
= alloca ((sizeof family
[0]) * 2);
3188 family
[1] = zero_vector
; /* terminator. */
3193 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3195 if (! NILP (alters
))
3197 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3198 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3199 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3200 family
[i
] = XCAR (alters
);
3201 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3203 family
[i
] = zero_vector
;
3207 family
= alloca ((sizeof family
[0]) * 3);
3210 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3212 family
[i
] = zero_vector
;
3216 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3218 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3219 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3221 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3222 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3224 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3225 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3227 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3228 entities
= font_list_entities (f
, work
);
3229 if (! NILP (entities
))
3231 val
= font_select_entity (f
, entities
,
3232 attrs
, pixel_size
, c
);
3250 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3254 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3255 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3256 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3259 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3260 size
= font_pixel_size (f
, spec
);
3264 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3265 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3268 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3269 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3270 eassert (INTEGERP (height
));
3275 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3279 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3280 size
= (NUMBERP (ffsize
)
3281 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3285 size
*= font_rescale_ratio (entity
);
3288 return font_open_entity (f
, entity
, size
);
3292 /* Find a font that satisfies SPEC and is the best match for
3293 face's attributes in ATTRS on FRAME, and return the opened
3297 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3299 Lisp_Object entity
, name
;
3301 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3304 /* No font is listed for SPEC, but each font-backend may have
3305 different criteria about "font matching". So, try it. */
3306 entity
= font_matching_entity (f
, attrs
, spec
);
3310 /* Don't lose the original name that was put in initially. We need
3311 it to re-apply the font when font parameters (like hinting or dpi) have
3313 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3316 name
= Ffont_get (spec
, QCuser_spec
);
3317 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3323 /* Make FACE on frame F ready to use the font opened for FACE. */
3326 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3328 if (face
->font
->driver
->prepare_face
)
3329 face
->font
->driver
->prepare_face (f
, face
);
3333 /* Make FACE on frame F stop using the font opened for FACE. */
3336 font_done_for_face (struct frame
*f
, struct face
*face
)
3338 if (face
->font
->driver
->done_face
)
3339 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
);
5064 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5065 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5066 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5067 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5068 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5069 /* Note that the other elements in sort_shift_bits are not used. */
5071 staticpro (&font_charset_alist
);
5072 font_charset_alist
= Qnil
;
5074 DEFSYM (Qopentype
, "opentype");
5076 DEFSYM (Qascii_0
, "ascii-0");
5077 DEFSYM (Qiso8859_1
, "iso8859-1");
5078 DEFSYM (Qiso10646_1
, "iso10646-1");
5079 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5080 DEFSYM (Qunicode_sip
, "unicode-sip");
5084 DEFSYM (QCotf
, ":otf");
5085 DEFSYM (QClang
, ":lang");
5086 DEFSYM (QCscript
, ":script");
5087 DEFSYM (QCantialias
, ":antialias");
5089 DEFSYM (QCfoundry
, ":foundry");
5090 DEFSYM (QCadstyle
, ":adstyle");
5091 DEFSYM (QCregistry
, ":registry");
5092 DEFSYM (QCspacing
, ":spacing");
5093 DEFSYM (QCdpi
, ":dpi");
5094 DEFSYM (QCscalable
, ":scalable");
5095 DEFSYM (QCavgwidth
, ":avgwidth");
5096 DEFSYM (QCfont_entity
, ":font-entity");
5097 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5107 DEFSYM (QCuser_spec
, "user-spec");
5109 staticpro (&scratch_font_spec
);
5110 scratch_font_spec
= Ffont_spec (0, NULL
);
5111 staticpro (&scratch_font_prefer
);
5112 scratch_font_prefer
= Ffont_spec (0, NULL
);
5114 staticpro (&Vfont_log_deferred
);
5115 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5119 staticpro (&otf_list
);
5121 #endif /* HAVE_LIBOTF */
5125 defsubr (&Sfont_spec
);
5126 defsubr (&Sfont_get
);
5127 #ifdef HAVE_WINDOW_SYSTEM
5128 defsubr (&Sfont_face_attributes
);
5130 defsubr (&Sfont_put
);
5131 defsubr (&Slist_fonts
);
5132 defsubr (&Sfont_family_list
);
5133 defsubr (&Sfind_font
);
5134 defsubr (&Sfont_xlfd_name
);
5135 defsubr (&Sclear_font_cache
);
5136 defsubr (&Sfont_shape_gstring
);
5137 defsubr (&Sfont_variation_glyphs
);
5139 defsubr (&Sfont_drive_otf
);
5140 defsubr (&Sfont_otf_alternates
);
5144 defsubr (&Sopen_font
);
5145 defsubr (&Sclose_font
);
5146 defsubr (&Squery_font
);
5147 defsubr (&Sfont_get_glyphs
);
5148 defsubr (&Sfont_match_p
);
5149 defsubr (&Sfont_at
);
5151 defsubr (&Sdraw_string
);
5153 defsubr (&Sframe_font_cache
);
5154 #endif /* FONT_DEBUG */
5155 #ifdef HAVE_WINDOW_SYSTEM
5156 defsubr (&Sfont_info
);
5159 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5161 Alist of fontname patterns vs the corresponding encoding and repertory info.
5162 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5163 where ENCODING is a charset or a char-table,
5164 and REPERTORY is a charset, a char-table, or nil.
5166 If ENCODING and REPERTORY are the same, the element can have the form
5167 \(REGEXP . ENCODING).
5169 ENCODING is for converting a character to a glyph code of the font.
5170 If ENCODING is a charset, encoding a character by the charset gives
5171 the corresponding glyph code. If ENCODING is a char-table, looking up
5172 the table by a character gives the corresponding glyph code.
5174 REPERTORY specifies a repertory of characters supported by the font.
5175 If REPERTORY is a charset, all characters belonging to the charset are
5176 supported. If REPERTORY is a char-table, all characters who have a
5177 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5178 gets the repertory information by an opened font and ENCODING. */);
5179 Vfont_encoding_alist
= Qnil
;
5181 /* FIXME: These 3 vars are not quite what they appear: setq on them
5182 won't have any effect other than disconnect them from the style
5183 table used by the font display code. So we make them read-only,
5184 to avoid this confusing situation. */
5186 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5187 doc
: /* Vector of valid font weight values.
5188 Each element has the form:
5189 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5190 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5191 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5192 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5194 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5195 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5196 See `font-weight-table' for the format of the vector. */);
5197 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5198 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5200 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5201 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5202 See `font-weight-table' for the format of the vector. */);
5203 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5204 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5206 staticpro (&font_style_table
);
5207 font_style_table
= make_uninit_vector (3);
5208 ASET (font_style_table
, 0, Vfont_weight_table
);
5209 ASET (font_style_table
, 1, Vfont_slant_table
);
5210 ASET (font_style_table
, 2, Vfont_width_table
);
5212 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5213 *Logging list of font related actions and results.
5214 The value t means to suppress the logging.
5215 The initial value is set to nil if the environment variable
5216 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5219 #ifdef HAVE_WINDOW_SYSTEM
5220 #ifdef HAVE_FREETYPE
5222 #ifdef HAVE_X_WINDOWS
5227 #endif /* HAVE_XFT */
5228 #endif /* HAVE_X_WINDOWS */
5229 #else /* not HAVE_FREETYPE */
5230 #ifdef HAVE_X_WINDOWS
5232 #endif /* HAVE_X_WINDOWS */
5233 #endif /* not HAVE_FREETYPE */
5236 #endif /* HAVE_BDFFONT */
5239 #endif /* HAVE_NTGUI */
5240 #endif /* HAVE_WINDOW_SYSTEM */
5246 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;