1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2011 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/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
51 Lisp_Object Qopentype
;
53 /* Important character set strings. */
54 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
56 #define DEFAULT_ENCODING Qiso8859_1
58 /* Unicode category `Cf'. */
59 static Lisp_Object QCf
;
61 /* Special vector of zero length. This is repeatedly used by (struct
62 font_driver *)->list when a specified font is not found. */
63 static Lisp_Object null_vector
;
65 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
66 static Lisp_Object font_style_table
;
68 /* Structure used for tables mapping weight, slant, and width numeric
69 values and their names. */
74 /* The first one is a valid name as a face attribute.
75 The second one (if any) is a typical name in XLFD field. */
79 /* Table of weight numeric values and their names. This table must be
80 sorted by numeric values in ascending order. */
82 static const struct table_entry weight_table
[] =
85 { 20, { "ultra-light", "ultralight" }},
86 { 40, { "extra-light", "extralight" }},
88 { 75, { "semi-light", "semilight", "demilight", "book" }},
89 { 100, { "normal", "medium", "regular", "unspecified" }},
90 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
92 { 205, { "extra-bold", "extrabold" }},
93 { 210, { "ultra-bold", "ultrabold", "black" }}
96 /* Table of slant numeric values and their names. This table must be
97 sorted by numeric values in ascending order. */
99 static const struct table_entry slant_table
[] =
101 { 0, { "reverse-oblique", "ro" }},
102 { 10, { "reverse-italic", "ri" }},
103 { 100, { "normal", "r", "unspecified" }},
104 { 200, { "italic" ,"i", "ot" }},
105 { 210, { "oblique", "o" }}
108 /* Table of width numeric values and their names. This table must be
109 sorted by numeric values in ascending order. */
111 static const struct table_entry width_table
[] =
113 { 50, { "ultra-condensed", "ultracondensed" }},
114 { 63, { "extra-condensed", "extracondensed" }},
115 { 75, { "condensed", "compressed", "narrow" }},
116 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
117 { 100, { "normal", "medium", "regular", "unspecified" }},
118 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
119 { 125, { "expanded" }},
120 { 150, { "extra-expanded", "extraexpanded" }},
121 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
124 Lisp_Object QCfoundry
;
125 static Lisp_Object QCadstyle
, QCregistry
;
126 /* Symbols representing keys of font extra info. */
127 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
128 Lisp_Object QCantialias
, QCfont_entity
;
129 static Lisp_Object QCfc_unknown_spec
;
130 /* Symbols representing values of font spacing property. */
131 static Lisp_Object Qc
, Qm
, Qd
;
133 /* Special ADSTYLE properties to avoid fonts used for Latin
134 characters; used in xfont.c and ftfont.c. */
135 Lisp_Object Qja
, Qko
;
137 static Lisp_Object QCuser_spec
;
139 /* Alist of font registry symbols and the corresponding charset
140 information. The information is retrieved from
141 Vfont_encoding_alist on demand.
143 Eash element has the form:
144 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
148 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
149 encodes a character code to a glyph code of a font, and
150 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
151 character is supported by a font.
153 The latter form means that the information for REGISTRY couldn't be
155 static Lisp_Object font_charset_alist
;
157 /* List of all font drivers. Each font-backend (XXXfont.c) calls
158 register_font_driver in syms_of_XXXfont to register its font-driver
160 static struct font_driver_list
*font_driver_list
;
164 /* Creaters of font-related Lisp object. */
167 font_make_spec (void)
169 Lisp_Object font_spec
;
170 struct font_spec
*spec
171 = ((struct font_spec
*)
172 allocate_pseudovector (VECSIZE (struct font_spec
),
173 FONT_SPEC_MAX
, PVEC_FONT
));
174 XSETFONT (font_spec
, spec
);
179 font_make_entity (void)
181 Lisp_Object font_entity
;
182 struct font_entity
*entity
183 = ((struct font_entity
*)
184 allocate_pseudovector (VECSIZE (struct font_entity
),
185 FONT_ENTITY_MAX
, PVEC_FONT
));
186 XSETFONT (font_entity
, entity
);
190 /* Create a font-object whose structure size is SIZE. If ENTITY is
191 not nil, copy properties from ENTITY to the font-object. If
192 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
194 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
196 Lisp_Object font_object
;
198 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
201 XSETFONT (font_object
, font
);
205 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
206 font
->props
[i
] = AREF (entity
, i
);
207 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
208 font
->props
[FONT_EXTRA_INDEX
]
209 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
212 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
218 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
219 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
220 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
222 static unsigned font_encode_char (Lisp_Object
, int);
224 /* Number of registered font drivers. */
225 static int num_font_drivers
;
228 /* Return a Lispy value of a font property value at STR and LEN bytes.
229 If STR is "*", return nil.
230 If FORCE_SYMBOL is zero and all characters in STR are digits,
231 return an integer. Otherwise, return a symbol interned from
235 font_intern_prop (const char *str
, int len
, int force_symbol
)
240 EMACS_INT nbytes
, nchars
;
242 if (len
== 1 && *str
== '*')
244 if (!force_symbol
&& len
>=1 && isdigit (*str
))
246 for (i
= 1; i
< len
; i
++)
247 if (! isdigit (str
[i
]))
250 return make_number (atoi (str
));
253 /* The following code is copied from the function intern (in
254 lread.c), and modified to suit our purpose. */
256 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
257 obarray
= check_obarray (obarray
);
258 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
259 if (len
== nchars
|| len
!= nbytes
)
260 /* CONTENTS contains no multibyte sequences or contains an invalid
261 multibyte sequence. We'll make a unibyte string. */
262 tem
= oblookup (obarray
, str
, len
, len
);
264 tem
= oblookup (obarray
, str
, nchars
, len
);
267 if (len
== nchars
|| len
!= nbytes
)
268 tem
= make_unibyte_string (str
, len
);
270 tem
= make_multibyte_string (str
, nchars
, len
);
271 return Fintern (tem
, obarray
);
274 /* Return a pixel size of font-spec SPEC on frame F. */
277 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
279 #ifdef HAVE_WINDOW_SYSTEM
280 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
289 font_assert (FLOATP (size
));
290 point_size
= XFLOAT_DATA (size
);
291 val
= AREF (spec
, FONT_DPI_INDEX
);
296 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
304 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
305 font vector. If VAL is not valid (i.e. not registered in
306 font_style_table), return -1 if NOERROR is zero, and return a
307 proper index if NOERROR is nonzero. In that case, register VAL in
308 font_style_table if VAL is a symbol, and return the closest index if
309 VAL is an integer. */
312 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
314 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
315 int len
= ASIZE (table
);
321 Lisp_Object args
[2], elt
;
323 /* At first try exact match. */
324 for (i
= 0; i
< len
; i
++)
325 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
326 if (EQ (val
, AREF (AREF (table
, i
), j
)))
327 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
328 | (i
<< 4) | (j
- 1));
329 /* Try also with case-folding match. */
330 s
= SSDATA (SYMBOL_NAME (val
));
331 for (i
= 0; i
< len
; i
++)
332 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
334 elt
= AREF (AREF (table
, i
), j
);
335 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
336 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
337 | (i
<< 4) | (j
- 1));
343 elt
= Fmake_vector (make_number (2), make_number (100));
346 args
[1] = Fmake_vector (make_number (1), elt
);
347 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
348 return (100 << 8) | (i
<< 4);
353 int numeric
= XINT (val
);
355 for (i
= 0, last_n
= -1; i
< len
; i
++)
357 int n
= XINT (AREF (AREF (table
, i
), 0));
360 return (n
<< 8) | (i
<< 4);
365 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
366 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
372 return ((last_n
<< 8) | ((i
- 1) << 4));
377 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
379 Lisp_Object val
= AREF (font
, prop
);
380 Lisp_Object table
, elt
;
385 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
386 i
= XINT (val
) & 0xFF;
387 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
388 elt
= AREF (table
, ((i
>> 4) & 0xF));
389 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
390 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
393 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
394 FONTNAME. ENCODING is a charset symbol that specifies the encoding
395 of the font. REPERTORY is a charset symbol or nil. */
398 find_font_encoding (Lisp_Object fontname
)
400 Lisp_Object tail
, elt
;
402 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
406 && STRINGP (XCAR (elt
))
407 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
408 && (SYMBOLP (XCDR (elt
))
409 ? CHARSETP (XCDR (elt
))
410 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
416 /* Return encoding charset and repertory charset for REGISTRY in
417 ENCODING and REPERTORY correspondingly. If correct information for
418 REGISTRY is available, return 0. Otherwise return -1. */
421 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
424 int encoding_id
, repertory_id
;
426 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
432 encoding_id
= XINT (XCAR (val
));
433 repertory_id
= XINT (XCDR (val
));
437 val
= find_font_encoding (SYMBOL_NAME (registry
));
438 if (SYMBOLP (val
) && CHARSETP (val
))
440 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
442 else if (CONSP (val
))
444 if (! CHARSETP (XCAR (val
)))
446 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
447 if (NILP (XCDR (val
)))
451 if (! CHARSETP (XCDR (val
)))
453 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
458 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
460 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
464 *encoding
= CHARSET_FROM_ID (encoding_id
);
466 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
471 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
476 /* Font property value validators. See the comment of
477 font_property_table for the meaning of the arguments. */
479 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
480 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
481 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
482 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
483 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
484 static int get_font_prop_index (Lisp_Object
);
487 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
490 val
= Fintern (val
, Qnil
);
493 else if (EQ (prop
, QCregistry
))
494 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
500 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
502 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
503 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
509 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
513 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
515 if ((n
& 0xF) + 1 >= ASIZE (elt
))
517 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
521 else if (SYMBOLP (val
))
523 int n
= font_style_to_value (prop
, val
, 0);
525 val
= n
>= 0 ? make_number (n
) : Qerror
;
533 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
535 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
540 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
542 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
544 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
546 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
548 if (spacing
== 'c' || spacing
== 'C')
549 return make_number (FONT_SPACING_CHARCELL
);
550 if (spacing
== 'm' || spacing
== 'M')
551 return make_number (FONT_SPACING_MONO
);
552 if (spacing
== 'p' || spacing
== 'P')
553 return make_number (FONT_SPACING_PROPORTIONAL
);
554 if (spacing
== 'd' || spacing
== 'D')
555 return make_number (FONT_SPACING_DUAL
);
561 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
563 Lisp_Object tail
, tmp
;
566 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
567 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
568 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
571 if (! SYMBOLP (XCAR (val
)))
576 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
578 for (i
= 0; i
< 2; i
++)
585 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
586 if (! SYMBOLP (XCAR (tmp
)))
594 /* Structure of known font property keys and validator of the
598 /* Pointer to the key symbol. */
600 /* Function to validate PROP's value VAL, or NULL if any value is
601 ok. The value is VAL or its regularized value if VAL is valid,
602 and Qerror if not. */
603 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
604 } font_property_table
[] =
605 { { &QCtype
, font_prop_validate_symbol
},
606 { &QCfoundry
, font_prop_validate_symbol
},
607 { &QCfamily
, font_prop_validate_symbol
},
608 { &QCadstyle
, font_prop_validate_symbol
},
609 { &QCregistry
, font_prop_validate_symbol
},
610 { &QCweight
, font_prop_validate_style
},
611 { &QCslant
, font_prop_validate_style
},
612 { &QCwidth
, font_prop_validate_style
},
613 { &QCsize
, font_prop_validate_non_neg
},
614 { &QCdpi
, font_prop_validate_non_neg
},
615 { &QCspacing
, font_prop_validate_spacing
},
616 { &QCavgwidth
, font_prop_validate_non_neg
},
617 /* The order of the above entries must match with enum
618 font_property_index. */
619 { &QClang
, font_prop_validate_symbol
},
620 { &QCscript
, font_prop_validate_symbol
},
621 { &QCotf
, font_prop_validate_otf
}
624 /* Size (number of elements) of the above table. */
625 #define FONT_PROPERTY_TABLE_SIZE \
626 ((sizeof font_property_table) / (sizeof *font_property_table))
628 /* Return an index number of font property KEY or -1 if KEY is not an
629 already known property. */
632 get_font_prop_index (Lisp_Object key
)
636 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
637 if (EQ (key
, *font_property_table
[i
].key
))
642 /* Validate the font property. The property key is specified by the
643 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
644 signal an error. The value is VAL or the regularized one. */
647 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
649 Lisp_Object validated
;
654 prop
= *font_property_table
[idx
].key
;
657 idx
= get_font_prop_index (prop
);
661 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
662 if (EQ (validated
, Qerror
))
663 signal_error ("invalid font property", Fcons (prop
, val
));
668 /* Store VAL as a value of extra font property PROP in FONT while
669 keeping the sorting order. Don't check the validity of VAL. */
672 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
674 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
675 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
679 Lisp_Object prev
= Qnil
;
682 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
683 prev
= extra
, extra
= XCDR (extra
);
686 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
688 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
694 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
699 /* Font name parser and unparser */
701 static int parse_matrix (const char *);
702 static int font_expand_wildcards (Lisp_Object
*, int);
703 static int font_parse_name (char *, Lisp_Object
);
705 /* An enumerator for each field of an XLFD font name. */
706 enum xlfd_field_index
725 /* An enumerator for mask bit corresponding to each XLFD field. */
728 XLFD_FOUNDRY_MASK
= 0x0001,
729 XLFD_FAMILY_MASK
= 0x0002,
730 XLFD_WEIGHT_MASK
= 0x0004,
731 XLFD_SLANT_MASK
= 0x0008,
732 XLFD_SWIDTH_MASK
= 0x0010,
733 XLFD_ADSTYLE_MASK
= 0x0020,
734 XLFD_PIXEL_MASK
= 0x0040,
735 XLFD_POINT_MASK
= 0x0080,
736 XLFD_RESX_MASK
= 0x0100,
737 XLFD_RESY_MASK
= 0x0200,
738 XLFD_SPACING_MASK
= 0x0400,
739 XLFD_AVGWIDTH_MASK
= 0x0800,
740 XLFD_REGISTRY_MASK
= 0x1000,
741 XLFD_ENCODING_MASK
= 0x2000
745 /* Parse P pointing to the pixel/point size field of the form
746 `[A B C D]' which specifies a transformation matrix:
752 by which all glyphs of the font are transformed. The spec says
753 that scalar value N for the pixel/point size is equivalent to:
754 A = N * resx/resy, B = C = 0, D = N.
756 Return the scalar value N if the form is valid. Otherwise return
760 parse_matrix (const char *p
)
766 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
769 matrix
[i
] = - strtod (p
+ 1, &end
);
771 matrix
[i
] = strtod (p
, &end
);
774 return (i
== 4 ? (int) matrix
[3] : -1);
777 /* Expand a wildcard field in FIELD (the first N fields are filled) to
778 multiple fields to fill in all 14 XLFD fields while restricting a
779 field position by its contents. */
782 font_expand_wildcards (Lisp_Object
*field
, int n
)
785 Lisp_Object tmp
[XLFD_LAST_INDEX
];
786 /* Array of information about where this element can go. Nth
787 element is for Nth element of FIELD. */
789 /* Minimum possible field. */
791 /* Maxinum possible field. */
793 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
795 } range
[XLFD_LAST_INDEX
];
797 int range_from
, range_to
;
800 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
801 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
802 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
803 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
804 | XLFD_AVGWIDTH_MASK)
805 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
807 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
808 field. The value is shifted to left one bit by one in the
810 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
811 range_mask
= (range_mask
<< 1) | 1;
813 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
814 position-based retriction for FIELD[I]. */
815 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
816 i
++, range_from
++, range_to
++, range_mask
<<= 1)
818 Lisp_Object val
= field
[i
];
824 range
[i
].from
= range_from
;
825 range
[i
].to
= range_to
;
826 range
[i
].mask
= range_mask
;
830 /* The triplet FROM, TO, and MASK is a value-based
831 retriction for FIELD[I]. */
837 int numeric
= XINT (val
);
840 from
= to
= XLFD_ENCODING_INDEX
,
841 mask
= XLFD_ENCODING_MASK
;
842 else if (numeric
== 0)
843 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
844 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
845 else if (numeric
<= 48)
846 from
= to
= XLFD_PIXEL_INDEX
,
847 mask
= XLFD_PIXEL_MASK
;
849 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
850 mask
= XLFD_LARGENUM_MASK
;
852 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
853 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
854 mask
= XLFD_NULL_MASK
;
856 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
859 Lisp_Object name
= SYMBOL_NAME (val
);
861 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
862 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
863 mask
= XLFD_REGENC_MASK
;
865 from
= to
= XLFD_ENCODING_INDEX
,
866 mask
= XLFD_ENCODING_MASK
;
868 else if (range_from
<= XLFD_WEIGHT_INDEX
869 && range_to
>= XLFD_WEIGHT_INDEX
870 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
871 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
872 else if (range_from
<= XLFD_SLANT_INDEX
873 && range_to
>= XLFD_SLANT_INDEX
874 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
875 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
876 else if (range_from
<= XLFD_SWIDTH_INDEX
877 && range_to
>= XLFD_SWIDTH_INDEX
878 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
879 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
882 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
883 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
885 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
886 mask
= XLFD_SYMBOL_MASK
;
889 /* Merge position-based and value-based restrictions. */
891 while (from
< range_from
)
892 mask
&= ~(1 << from
++);
893 while (from
< 14 && ! (mask
& (1 << from
)))
895 while (to
> range_to
)
896 mask
&= ~(1 << to
--);
897 while (to
>= 0 && ! (mask
& (1 << to
)))
901 range
[i
].from
= from
;
903 range
[i
].mask
= mask
;
905 if (from
> range_from
|| to
< range_to
)
907 /* The range is narrowed by value-based restrictions.
908 Reflect it to the other fields. */
910 /* Following fields should be after FROM. */
912 /* Preceding fields should be before TO. */
913 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
915 /* Check FROM for non-wildcard field. */
916 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
918 while (range
[j
].from
< from
)
919 range
[j
].mask
&= ~(1 << range
[j
].from
++);
920 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
922 range
[j
].from
= from
;
925 from
= range
[j
].from
;
926 if (range
[j
].to
> to
)
928 while (range
[j
].to
> to
)
929 range
[j
].mask
&= ~(1 << range
[j
].to
--);
930 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
943 /* Decide all fileds from restrictions in RANGE. */
944 for (i
= j
= 0; i
< n
; i
++)
946 if (j
< range
[i
].from
)
948 if (i
== 0 || ! NILP (tmp
[i
- 1]))
949 /* None of TMP[X] corresponds to Jth field. */
951 for (; j
< range
[i
].from
; j
++)
956 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
958 for (; j
< XLFD_LAST_INDEX
; j
++)
960 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
961 field
[XLFD_ENCODING_INDEX
]
962 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
967 /* Parse NAME (null terminated) as XLFD and store information in FONT
968 (font-spec or font-entity). Size property of FONT is set as
970 specified XLFD fields FONT property
971 --------------------- -------------
972 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
973 POINT_SIZE and RESY calculated pixel size (Lisp integer)
974 POINT_SIZE POINT_SIZE/10 (Lisp float)
976 If NAME is successfully parsed, return 0. Otherwise return -1.
978 FONT is usually a font-spec, but when this function is called from
979 X font backend driver, it is a font-entity. In that case, NAME is
980 a fully specified XLFD. */
983 font_parse_xlfd (char *name
, Lisp_Object font
)
985 ptrdiff_t len
= strlen (name
);
987 char *f
[XLFD_LAST_INDEX
+ 1];
991 if (len
> 255 || !len
)
992 /* Maximum XLFD name length is 255. */
994 /* Accept "*-.." as a fully specified XLFD. */
995 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
996 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
999 for (p
= name
+ i
; *p
; p
++)
1003 if (i
== XLFD_LAST_INDEX
)
1008 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1009 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1011 if (i
== XLFD_LAST_INDEX
)
1013 /* Fully specified XLFD. */
1016 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1017 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1018 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1019 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1021 val
= INTERN_FIELD_SYM (i
);
1024 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1026 ASET (font
, j
, make_number (n
));
1029 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1030 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1031 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1033 ASET (font
, FONT_REGISTRY_INDEX
,
1034 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1035 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1037 p
= f
[XLFD_PIXEL_INDEX
];
1038 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1039 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1042 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1044 ASET (font
, FONT_SIZE_INDEX
, val
);
1045 else if (FONT_ENTITY_P (font
))
1049 double point_size
= -1;
1051 font_assert (FONT_SPEC_P (font
));
1052 p
= f
[XLFD_POINT_INDEX
];
1054 point_size
= parse_matrix (p
);
1055 else if (isdigit (*p
))
1056 point_size
= atoi (p
), point_size
/= 10;
1057 if (point_size
>= 0)
1058 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1062 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1063 if (! NILP (val
) && ! INTEGERP (val
))
1065 ASET (font
, FONT_DPI_INDEX
, val
);
1066 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1069 val
= font_prop_validate_spacing (QCspacing
, val
);
1070 if (! INTEGERP (val
))
1072 ASET (font
, FONT_SPACING_INDEX
, val
);
1074 p
= f
[XLFD_AVGWIDTH_INDEX
];
1077 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1078 if (! NILP (val
) && ! INTEGERP (val
))
1080 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1084 int wild_card_found
= 0;
1085 Lisp_Object prop
[XLFD_LAST_INDEX
];
1087 if (FONT_ENTITY_P (font
))
1089 for (j
= 0; j
< i
; j
++)
1093 if (f
[j
][1] && f
[j
][1] != '-')
1096 wild_card_found
= 1;
1099 prop
[j
] = INTERN_FIELD (j
);
1101 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1103 if (! wild_card_found
)
1105 if (font_expand_wildcards (prop
, i
) < 0)
1108 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1109 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1110 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1111 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1112 if (! NILP (prop
[i
]))
1114 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1116 ASET (font
, j
, make_number (n
));
1118 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1119 val
= prop
[XLFD_REGISTRY_INDEX
];
1122 val
= prop
[XLFD_ENCODING_INDEX
];
1124 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1126 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1127 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1129 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1130 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1132 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1134 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1135 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1136 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1138 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1140 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1143 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1144 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1145 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1147 val
= font_prop_validate_spacing (QCspacing
,
1148 prop
[XLFD_SPACING_INDEX
]);
1149 if (! INTEGERP (val
))
1151 ASET (font
, FONT_SPACING_INDEX
, val
);
1153 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1154 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1160 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1161 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1162 0, use PIXEL_SIZE instead. */
1165 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1168 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1172 font_assert (FONTP (font
));
1174 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1177 if (i
== FONT_ADSTYLE_INDEX
)
1178 j
= XLFD_ADSTYLE_INDEX
;
1179 else if (i
== FONT_REGISTRY_INDEX
)
1180 j
= XLFD_REGISTRY_INDEX
;
1181 val
= AREF (font
, i
);
1184 if (j
== XLFD_REGISTRY_INDEX
)
1185 f
[j
] = "*-*", len
+= 4;
1187 f
[j
] = "*", len
+= 2;
1192 val
= SYMBOL_NAME (val
);
1193 if (j
== XLFD_REGISTRY_INDEX
1194 && ! strchr (SSDATA (val
), '-'))
1196 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1197 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1199 f
[j
] = p
= alloca (SBYTES (val
) + 3);
1200 sprintf (p
, "%s-*", SDATA (val
));
1201 len
+= SBYTES (val
) + 3;
1205 f
[j
] = p
= alloca (SBYTES (val
) + 4);
1206 sprintf (p
, "%s*-*", SDATA (val
));
1207 len
+= SBYTES (val
) + 4;
1211 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1215 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1218 val
= font_style_symbolic (font
, i
, 0);
1220 f
[j
] = "*", len
+= 2;
1223 val
= SYMBOL_NAME (val
);
1224 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1228 val
= AREF (font
, FONT_SIZE_INDEX
);
1229 font_assert (NUMBERP (val
) || NILP (val
));
1237 f
[XLFD_PIXEL_INDEX
] = p
= alloca (22);
1238 len
+= sprintf (p
, "%d-*", i
) + 1;
1241 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1243 else if (FLOATP (val
))
1245 i
= XFLOAT_DATA (val
) * 10;
1246 f
[XLFD_PIXEL_INDEX
] = p
= alloca (12);
1247 len
+= sprintf (p
, "*-%d", i
) + 1;
1250 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1252 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1254 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1255 f
[XLFD_RESX_INDEX
] = p
= alloca (22);
1256 len
+= sprintf (p
, "%d-%d", i
, i
) + 1;
1259 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1260 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1262 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1264 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1265 : spacing
<= FONT_SPACING_DUAL
? "d"
1266 : spacing
<= FONT_SPACING_MONO
? "m"
1271 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1272 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1274 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (22);
1275 len
+= sprintf (p
, "%"pI
"d",
1276 XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1279 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1280 len
++; /* for terminating '\0'. */
1283 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1284 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1285 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1286 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1287 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1288 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1289 f
[XLFD_REGISTRY_INDEX
]);
1292 /* Parse NAME (null terminated) and store information in FONT
1293 (font-spec or font-entity). NAME is supplied in either the
1294 Fontconfig or GTK font name format. If NAME is successfully
1295 parsed, return 0. Otherwise return -1.
1297 The fontconfig format is
1299 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1303 FAMILY [PROPS...] [SIZE]
1305 This function tries to guess which format it is. */
1308 font_parse_fcname (char *name
, Lisp_Object font
)
1311 char *size_beg
= NULL
, *size_end
= NULL
;
1312 char *props_beg
= NULL
, *family_end
= NULL
;
1313 ptrdiff_t len
= strlen (name
);
1318 for (p
= name
; *p
; p
++)
1320 if (*p
== '\\' && p
[1])
1324 props_beg
= family_end
= p
;
1329 int decimal
= 0, size_found
= 1;
1330 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1333 if (*q
!= '.' || decimal
)
1352 Lisp_Object extra_props
= Qnil
;
1354 /* A fontconfig name with size and/or property data. */
1355 if (family_end
> name
)
1358 family
= font_intern_prop (name
, family_end
- name
, 1);
1359 ASET (font
, FONT_FAMILY_INDEX
, family
);
1363 double point_size
= strtod (size_beg
, &size_end
);
1364 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1365 if (*size_end
== ':' && size_end
[1])
1366 props_beg
= size_end
;
1370 /* Now parse ":KEY=VAL" patterns. */
1373 for (p
= props_beg
; *p
; p
= q
)
1375 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1378 /* Must be an enumerated value. */
1382 val
= font_intern_prop (p
, q
- p
, 1);
1384 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1385 && memcmp (p, STR, strlen (STR)) == 0)
1387 if (PROP_MATCH ("light")
1388 || PROP_MATCH ("medium")
1389 || PROP_MATCH ("demibold")
1390 || PROP_MATCH ("bold")
1391 || PROP_MATCH ("black"))
1392 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1393 else if (PROP_MATCH ("roman")
1394 || PROP_MATCH ("italic")
1395 || PROP_MATCH ("oblique"))
1396 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1397 else if (PROP_MATCH ("charcell"))
1398 ASET (font
, FONT_SPACING_INDEX
,
1399 make_number (FONT_SPACING_CHARCELL
));
1400 else if (PROP_MATCH ("mono"))
1401 ASET (font
, FONT_SPACING_INDEX
,
1402 make_number (FONT_SPACING_MONO
));
1403 else if (PROP_MATCH ("proportional"))
1404 ASET (font
, FONT_SPACING_INDEX
,
1405 make_number (FONT_SPACING_PROPORTIONAL
));
1414 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1415 prop
= FONT_SIZE_INDEX
;
1418 key
= font_intern_prop (p
, q
- p
, 1);
1419 prop
= get_font_prop_index (key
);
1423 for (q
= p
; *q
&& *q
!= ':'; q
++);
1424 val
= font_intern_prop (p
, q
- p
, 0);
1426 if (prop
>= FONT_FOUNDRY_INDEX
1427 && prop
< FONT_EXTRA_INDEX
)
1428 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1431 extra_props
= nconc2 (extra_props
,
1432 Fcons (Fcons (key
, val
), Qnil
));
1439 if (! NILP (extra_props
))
1441 struct font_driver_list
*driver_list
= font_driver_list
;
1442 for ( ; driver_list
; driver_list
= driver_list
->next
)
1443 if (driver_list
->driver
->filter_properties
)
1444 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1450 /* Either a fontconfig-style name with no size and property
1451 data, or a GTK-style name. */
1452 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1453 Lisp_Object width
= Qnil
, size
= Qnil
;
1457 /* Scan backwards from the end, looking for a size. */
1458 for (p
= name
+ len
- 1; p
>= name
; p
--)
1462 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1463 /* Found a font size. */
1464 size
= make_float (strtod (p
+ 1, NULL
));
1468 /* Now P points to the termination of the string, sans size.
1469 Scan backwards, looking for font properties. */
1470 for (; p
> name
; p
= q
)
1472 for (q
= p
- 1; q
>= name
; q
--)
1474 if (q
> name
&& *(q
-1) == '\\')
1475 --q
; /* Skip quoting backslashes. */
1481 word_len
= p
- word_start
;
1483 #define PROP_MATCH(STR) \
1484 (word_len == strlen (STR) \
1485 && memcmp (word_start, STR, strlen (STR)) == 0)
1486 #define PROP_SAVE(VAR, STR) \
1487 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1489 if (PROP_MATCH ("Ultra-Light"))
1490 PROP_SAVE (weight
, "ultra-light");
1491 else if (PROP_MATCH ("Light"))
1492 PROP_SAVE (weight
, "light");
1493 else if (PROP_MATCH ("Book"))
1494 PROP_SAVE (weight
, "book");
1495 else if (PROP_MATCH ("Medium"))
1496 PROP_SAVE (weight
, "medium");
1497 else if (PROP_MATCH ("Semi-Bold"))
1498 PROP_SAVE (weight
, "semi-bold");
1499 else if (PROP_MATCH ("Bold"))
1500 PROP_SAVE (weight
, "bold");
1501 else if (PROP_MATCH ("Italic"))
1502 PROP_SAVE (slant
, "italic");
1503 else if (PROP_MATCH ("Oblique"))
1504 PROP_SAVE (slant
, "oblique");
1505 else if (PROP_MATCH ("Semi-Condensed"))
1506 PROP_SAVE (width
, "semi-condensed");
1507 else if (PROP_MATCH ("Condensed"))
1508 PROP_SAVE (width
, "condensed");
1509 /* An unknown word must be part of the font name. */
1520 ASET (font
, FONT_FAMILY_INDEX
,
1521 font_intern_prop (name
, family_end
- name
, 1));
1523 ASET (font
, FONT_SIZE_INDEX
, size
);
1525 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1527 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1529 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1535 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1536 NAME (NBYTES length), and return the name length. If
1537 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1540 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1542 Lisp_Object family
, foundry
;
1543 Lisp_Object tail
, val
;
1548 Lisp_Object styles
[3];
1549 const char *style_names
[3] = { "weight", "slant", "width" };
1552 family
= AREF (font
, FONT_FAMILY_INDEX
);
1553 if (! NILP (family
))
1555 if (SYMBOLP (family
))
1557 family
= SYMBOL_NAME (family
);
1558 len
+= SBYTES (family
);
1564 val
= AREF (font
, FONT_SIZE_INDEX
);
1567 if (XINT (val
) != 0)
1568 pixel_size
= XINT (val
);
1570 len
+= 21; /* for ":pixelsize=NUM" */
1577 point_size
= (int) XFLOAT_DATA (val
);
1578 len
+= 11; /* for "-NUM" */
1581 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1582 if (! NILP (foundry
))
1584 if (SYMBOLP (foundry
))
1586 foundry
= SYMBOL_NAME (foundry
);
1587 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1593 for (i
= 0; i
< 3; i
++)
1595 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1596 if (! NILP (styles
[i
]))
1597 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1598 SDATA (SYMBOL_NAME (styles
[i
])));
1601 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1602 len
+= sprintf (work
, ":dpi=%"pI
"d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1603 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1604 len
+= strlen (":spacing=100");
1605 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1606 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1607 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1609 Lisp_Object key
= XCAR (XCAR (tail
)), value
= XCDR (XCAR (tail
));
1611 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1612 if (STRINGP (value
))
1613 len
+= SBYTES (value
);
1614 else if (INTEGERP (value
))
1615 len
+= sprintf (work
, "%"pI
"d", XINT (value
));
1616 else if (SYMBOLP (value
))
1617 len
+= (NILP (value
) ? 5 : 4); /* for "false" or "true" */
1623 if (! NILP (family
))
1624 p
+= sprintf (p
, "%s", SDATA (family
));
1628 p
+= sprintf (p
, "%d", point_size
);
1630 p
+= sprintf (p
, "-%d", point_size
);
1632 else if (pixel_size
> 0)
1633 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1634 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1635 p
+= sprintf (p
, ":foundry=%s",
1636 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1637 for (i
= 0; i
< 3; i
++)
1638 if (! NILP (styles
[i
]))
1639 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1640 SDATA (SYMBOL_NAME (styles
[i
])));
1641 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1642 p
+= sprintf (p
, ":dpi=%"pI
"d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1643 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1644 p
+= sprintf (p
, ":spacing=%"pI
"d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1645 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1647 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1648 p
+= sprintf (p
, ":scalable=true");
1650 p
+= sprintf (p
, ":scalable=false");
1655 /* Parse NAME (null terminated) and store information in FONT
1656 (font-spec or font-entity). If NAME is successfully parsed, return
1657 0. Otherwise return -1. */
1660 font_parse_name (char *name
, Lisp_Object font
)
1662 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1663 return font_parse_xlfd (name
, font
);
1664 return font_parse_fcname (name
, font
);
1668 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1669 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1673 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1679 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1681 CHECK_STRING (family
);
1682 len
= SBYTES (family
);
1683 p0
= SSDATA (family
);
1684 p1
= strchr (p0
, '-');
1687 if ((*p0
!= '*' && p1
- p0
> 0)
1688 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1689 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1692 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1695 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1697 if (! NILP (registry
))
1699 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1700 CHECK_STRING (registry
);
1701 len
= SBYTES (registry
);
1702 p0
= SSDATA (registry
);
1703 p1
= strchr (p0
, '-');
1706 if (SDATA (registry
)[len
- 1] == '*')
1707 registry
= concat2 (registry
, build_string ("-*"));
1709 registry
= concat2 (registry
, build_string ("*-*"));
1711 registry
= Fdowncase (registry
);
1712 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1717 /* This part (through the next ^L) is still experimental and not
1718 tested much. We may drastically change codes. */
1724 #define LGSTRING_HEADER_SIZE 6
1725 #define LGSTRING_GLYPH_SIZE 8
1728 check_gstring (gstring
)
1729 Lisp_Object gstring
;
1734 CHECK_VECTOR (gstring
);
1735 val
= AREF (gstring
, 0);
1737 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1739 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1740 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1741 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1742 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1743 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1744 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1745 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1746 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1747 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1748 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1749 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1751 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1753 val
= LGSTRING_GLYPH (gstring
, i
);
1755 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1757 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1759 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1760 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1761 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1762 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1763 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1764 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1765 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1766 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1768 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1770 if (ASIZE (val
) < 3)
1772 for (j
= 0; j
< 3; j
++)
1773 CHECK_NUMBER (AREF (val
, j
));
1778 error ("Invalid glyph-string format");
1783 check_otf_features (otf_features
)
1784 Lisp_Object otf_features
;
1788 CHECK_CONS (otf_features
);
1789 CHECK_SYMBOL (XCAR (otf_features
));
1790 otf_features
= XCDR (otf_features
);
1791 CHECK_CONS (otf_features
);
1792 CHECK_SYMBOL (XCAR (otf_features
));
1793 otf_features
= XCDR (otf_features
);
1794 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1796 CHECK_SYMBOL (Fcar (val
));
1797 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1798 error ("Invalid OTF GSUB feature: %s",
1799 SDATA (SYMBOL_NAME (XCAR (val
))));
1801 otf_features
= XCDR (otf_features
);
1802 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1804 CHECK_SYMBOL (Fcar (val
));
1805 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1806 error ("Invalid OTF GPOS feature: %s",
1807 SDATA (SYMBOL_NAME (XCAR (val
))));
1814 Lisp_Object otf_list
;
1817 otf_tag_symbol (tag
)
1822 OTF_tag_name (tag
, name
);
1823 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1830 Lisp_Object val
= Fassoc (file
, otf_list
);
1834 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1837 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1838 val
= make_save_value (otf
, 0);
1839 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1845 /* Return a list describing which scripts/languages FONT supports by
1846 which GSUB/GPOS features of OpenType tables. See the comment of
1847 (struct font_driver).otf_capability. */
1850 font_otf_capability (font
)
1854 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1857 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1860 for (i
= 0; i
< 2; i
++)
1862 OTF_GSUB_GPOS
*gsub_gpos
;
1863 Lisp_Object script_list
= Qnil
;
1866 if (OTF_get_features (otf
, i
== 0) < 0)
1868 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1869 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1871 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1872 Lisp_Object langsys_list
= Qnil
;
1873 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1876 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1878 OTF_LangSys
*langsys
;
1879 Lisp_Object feature_list
= Qnil
;
1880 Lisp_Object langsys_tag
;
1883 if (k
== script
->LangSysCount
)
1885 langsys
= &script
->DefaultLangSys
;
1890 langsys
= script
->LangSys
+ k
;
1892 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1894 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1896 OTF_Feature
*feature
1897 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1898 Lisp_Object feature_tag
1899 = otf_tag_symbol (feature
->FeatureTag
);
1901 feature_list
= Fcons (feature_tag
, feature_list
);
1903 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1906 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1911 XSETCAR (capability
, script_list
);
1913 XSETCDR (capability
, script_list
);
1919 /* Parse OTF features in SPEC and write a proper features spec string
1920 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1921 assured that the sufficient memory has already allocated for
1925 generate_otf_features (spec
, features
)
1935 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1941 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1946 else if (! asterisk
)
1948 val
= SYMBOL_NAME (val
);
1949 p
+= sprintf (p
, "%s", SDATA (val
));
1953 val
= SYMBOL_NAME (val
);
1954 p
+= sprintf (p
, "~%s", SDATA (val
));
1958 error ("OTF spec too long");
1962 font_otf_DeviceTable (device_table
)
1963 OTF_DeviceTable
*device_table
;
1965 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1967 return Fcons (make_number (len
),
1968 make_unibyte_string (device_table
->DeltaValue
, len
));
1972 font_otf_ValueRecord (value_format
, value_record
)
1974 OTF_ValueRecord
*value_record
;
1976 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1978 if (value_format
& OTF_XPlacement
)
1979 ASET (val
, 0, make_number (value_record
->XPlacement
));
1980 if (value_format
& OTF_YPlacement
)
1981 ASET (val
, 1, make_number (value_record
->YPlacement
));
1982 if (value_format
& OTF_XAdvance
)
1983 ASET (val
, 2, make_number (value_record
->XAdvance
));
1984 if (value_format
& OTF_YAdvance
)
1985 ASET (val
, 3, make_number (value_record
->YAdvance
));
1986 if (value_format
& OTF_XPlaDevice
)
1987 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1988 if (value_format
& OTF_YPlaDevice
)
1989 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1990 if (value_format
& OTF_XAdvDevice
)
1991 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1992 if (value_format
& OTF_YAdvDevice
)
1993 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1998 font_otf_Anchor (anchor
)
2003 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2004 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2005 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2006 if (anchor
->AnchorFormat
== 2)
2007 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2010 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2011 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2015 #endif /* HAVE_LIBOTF */
2021 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2022 static int font_compare (const void *, const void *);
2023 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2027 font_rescale_ratio (Lisp_Object font_entity
)
2029 Lisp_Object tail
, elt
;
2030 Lisp_Object name
= Qnil
;
2032 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2035 if (FLOATP (XCDR (elt
)))
2037 if (STRINGP (XCAR (elt
)))
2040 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2041 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2042 return XFLOAT_DATA (XCDR (elt
));
2044 else if (FONT_SPEC_P (XCAR (elt
)))
2046 if (font_match_p (XCAR (elt
), font_entity
))
2047 return XFLOAT_DATA (XCDR (elt
));
2054 /* We sort fonts by scoring each of them against a specified
2055 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2056 the value is, the closer the font is to the font-spec.
2058 The lowest 2 bits of the score are used for driver type. The font
2059 available by the most preferred font driver is 0.
2061 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2062 WEIGHT, SLANT, WIDTH, and SIZE. */
2064 /* How many bits to shift to store the difference value of each font
2065 property in a score. Note that floats for FONT_TYPE_INDEX and
2066 FONT_REGISTRY_INDEX are not used. */
2067 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2069 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2070 The return value indicates how different ENTITY is compared with
2074 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2079 /* Score three style numeric fields. Maximum difference is 127. */
2080 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2081 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2083 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2084 - (XINT (spec_prop
[i
]) >> 8));
2087 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2090 /* Score the size. Maximum difference is 127. */
2091 i
= FONT_SIZE_INDEX
;
2092 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2093 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2095 /* We use the higher 6-bit for the actual size difference. The
2096 lowest bit is set if the DPI is different. */
2098 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2100 if (CONSP (Vface_font_rescale_alist
))
2101 pixel_size
*= font_rescale_ratio (entity
);
2102 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2106 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2107 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2109 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2110 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2112 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2119 /* Concatenate all elements of LIST into one vector. LIST is a list
2120 of font-entity vectors. */
2123 font_vconcat_entity_vectors (Lisp_Object list
)
2125 int nargs
= XINT (Flength (list
));
2126 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2129 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2130 args
[i
] = XCAR (list
);
2131 return Fvconcat (nargs
, args
);
2135 /* The structure for elements being sorted by qsort. */
2136 struct font_sort_data
2139 int font_driver_preference
;
2144 /* The comparison function for qsort. */
2147 font_compare (const void *d1
, const void *d2
)
2149 const struct font_sort_data
*data1
= d1
;
2150 const struct font_sort_data
*data2
= d2
;
2152 if (data1
->score
< data2
->score
)
2154 else if (data1
->score
> data2
->score
)
2156 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2160 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2161 If PREFER specifies a point-size, calculate the corresponding
2162 pixel-size from QCdpi property of PREFER or from the Y-resolution
2163 of FRAME before sorting.
2165 If BEST-ONLY is nonzero, return the best matching entity (that
2166 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2167 if BEST-ONLY is negative). Otherwise, return the sorted result as
2168 a single vector of font-entities.
2170 This function does no optimization for the case that the total
2171 number of elements is 1. The caller should avoid calling this in
2175 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2177 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2179 struct font_sort_data
*data
;
2180 unsigned best_score
;
2181 Lisp_Object best_entity
;
2182 struct frame
*f
= XFRAME (frame
);
2183 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2186 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2187 prefer_prop
[i
] = AREF (prefer
, i
);
2188 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2189 prefer_prop
[FONT_SIZE_INDEX
]
2190 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2192 if (NILP (XCDR (list
)))
2194 /* What we have to take care of is this single vector. */
2196 maxlen
= ASIZE (vec
);
2200 /* We don't have to perform sort, so there's no need of creating
2201 a single vector. But, we must find the length of the longest
2204 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2205 if (maxlen
< ASIZE (XCAR (tail
)))
2206 maxlen
= ASIZE (XCAR (tail
));
2210 /* We have to create a single vector to sort it. */
2211 vec
= font_vconcat_entity_vectors (list
);
2212 maxlen
= ASIZE (vec
);
2215 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2216 best_score
= 0xFFFFFFFF;
2219 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2221 int font_driver_preference
= 0;
2222 Lisp_Object current_font_driver
;
2228 /* We are sure that the length of VEC > 0. */
2229 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2230 /* Score the elements. */
2231 for (i
= 0; i
< len
; i
++)
2233 data
[i
].entity
= AREF (vec
, i
);
2235 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2237 ? font_score (data
[i
].entity
, prefer_prop
)
2239 if (best_only
&& best_score
> data
[i
].score
)
2241 best_score
= data
[i
].score
;
2242 best_entity
= data
[i
].entity
;
2243 if (best_score
== 0)
2246 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2248 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2249 font_driver_preference
++;
2251 data
[i
].font_driver_preference
= font_driver_preference
;
2254 /* Sort if necessary. */
2257 qsort (data
, len
, sizeof *data
, font_compare
);
2258 for (i
= 0; i
< len
; i
++)
2259 ASET (vec
, i
, data
[i
].entity
);
2268 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2273 /* API of Font Service Layer. */
2275 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2276 sort_shift_bits. Finternal_set_font_selection_order calls this
2277 function with font_sort_order after setting up it. */
2280 font_update_sort_order (int *order
)
2284 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2286 int xlfd_idx
= order
[i
];
2288 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2289 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2290 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2291 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2292 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2293 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2295 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2300 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2305 table
= assq_no_quit (script
, table
);
2308 table
= XCDR (table
);
2309 if (! NILP (langsys
))
2311 table
= assq_no_quit (langsys
, table
);
2317 val
= assq_no_quit (Qnil
, table
);
2319 table
= XCAR (table
);
2323 table
= XCDR (table
);
2324 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2326 if (NILP (XCAR (features
)))
2331 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2337 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2340 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2342 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2344 script
= XCAR (spec
);
2348 langsys
= XCAR (spec
);
2359 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2360 XCAR (otf_capability
)))
2362 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2363 XCDR (otf_capability
)))
2370 /* Check if FONT (font-entity or font-object) matches with the font
2371 specification SPEC. */
2374 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2376 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2377 Lisp_Object extra
, font_extra
;
2380 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2381 if (! NILP (AREF (spec
, i
))
2382 && ! NILP (AREF (font
, i
))
2383 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2385 props
= XFONT_SPEC (spec
)->props
;
2386 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2388 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2389 prop
[i
] = AREF (spec
, i
);
2390 prop
[FONT_SIZE_INDEX
]
2391 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2395 if (font_score (font
, props
) > 0)
2397 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2398 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2399 for (; CONSP (extra
); extra
= XCDR (extra
))
2401 Lisp_Object key
= XCAR (XCAR (extra
));
2402 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2404 if (EQ (key
, QClang
))
2406 val2
= assq_no_quit (key
, font_extra
);
2415 if (NILP (Fmemq (val
, val2
)))
2420 ? NILP (Fmemq (val
, XCDR (val2
)))
2424 else if (EQ (key
, QCscript
))
2426 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2432 /* All characters in the list must be supported. */
2433 for (; CONSP (val2
); val2
= XCDR (val2
))
2435 if (! NATNUMP (XCAR (val2
)))
2437 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2438 == FONT_INVALID_CODE
)
2442 else if (VECTORP (val2
))
2444 /* At most one character in the vector must be supported. */
2445 for (i
= 0; i
< ASIZE (val2
); i
++)
2447 if (! NATNUMP (AREF (val2
, i
)))
2449 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2450 != FONT_INVALID_CODE
)
2453 if (i
== ASIZE (val2
))
2458 else if (EQ (key
, QCotf
))
2462 if (! FONT_OBJECT_P (font
))
2464 fontp
= XFONT_OBJECT (font
);
2465 if (! fontp
->driver
->otf_capability
)
2467 val2
= fontp
->driver
->otf_capability (fontp
);
2468 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2479 Each font backend has the callback function get_cache, and it
2480 returns a cons cell of which cdr part can be freely used for
2481 caching fonts. The cons cell may be shared by multiple frames
2482 and/or multiple font drivers. So, we arrange the cdr part as this:
2484 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2486 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2487 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2488 cons (FONT-SPEC FONT-ENTITY ...). */
2490 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2491 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2492 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2493 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2494 struct font_driver
*);
2497 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2499 Lisp_Object cache
, val
;
2501 cache
= driver
->get_cache (f
);
2503 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2507 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2508 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2512 val
= XCDR (XCAR (val
));
2513 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2519 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2521 Lisp_Object cache
, val
, tmp
;
2524 cache
= driver
->get_cache (f
);
2526 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2527 cache
= val
, val
= XCDR (val
);
2528 font_assert (! NILP (val
));
2529 tmp
= XCDR (XCAR (val
));
2530 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2531 if (XINT (XCAR (tmp
)) == 0)
2533 font_clear_cache (f
, XCAR (val
), driver
);
2534 XSETCDR (cache
, XCDR (val
));
2540 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2542 Lisp_Object val
= driver
->get_cache (f
);
2543 Lisp_Object type
= driver
->type
;
2545 font_assert (CONSP (val
));
2546 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2547 font_assert (CONSP (val
));
2548 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2549 val
= XCDR (XCAR (val
));
2553 static int num_fonts
;
2556 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2558 Lisp_Object tail
, elt
;
2559 Lisp_Object tail2
, entity
;
2561 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2562 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2565 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2566 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2568 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2570 entity
= XCAR (tail2
);
2572 if (FONT_ENTITY_P (entity
)
2573 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2575 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2577 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2579 Lisp_Object val
= XCAR (objlist
);
2580 struct font
*font
= XFONT_OBJECT (val
);
2582 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2584 font_assert (font
&& driver
== font
->driver
);
2585 driver
->close (f
, font
);
2589 if (driver
->free_entity
)
2590 driver
->free_entity (entity
);
2595 XSETCDR (cache
, Qnil
);
2599 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2601 /* Check each font-entity in VEC, and return a list of font-entities
2602 that satisfy these conditions:
2603 (1) matches with SPEC and SIZE if SPEC is not nil, and
2604 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2608 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2610 Lisp_Object entity
, val
;
2611 enum font_property_index prop
;
2614 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2616 entity
= AREF (vec
, i
);
2617 if (! NILP (Vface_ignored_fonts
))
2620 Lisp_Object tail
, regexp
;
2622 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2624 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2626 regexp
= XCAR (tail
);
2627 if (STRINGP (regexp
)
2628 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2637 val
= Fcons (entity
, val
);
2640 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2641 if (INTEGERP (AREF (spec
, prop
))
2642 && ((XINT (AREF (spec
, prop
)) >> 8)
2643 != (XINT (AREF (entity
, prop
)) >> 8)))
2644 prop
= FONT_SPEC_MAX
;
2645 if (prop
< FONT_SPEC_MAX
2647 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2649 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2652 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2653 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2654 prop
= FONT_SPEC_MAX
;
2656 if (prop
< FONT_SPEC_MAX
2657 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2658 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2659 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2660 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2661 prop
= FONT_SPEC_MAX
;
2662 if (prop
< FONT_SPEC_MAX
2663 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2664 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2665 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2666 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2667 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2668 prop
= FONT_SPEC_MAX
;
2669 if (prop
< FONT_SPEC_MAX
)
2670 val
= Fcons (entity
, val
);
2672 return (Fvconcat (1, &val
));
2676 /* Return a list of vectors of font-entities matching with SPEC on
2677 FRAME. Each elements in the list is a vector of entities from the
2678 same font-driver. */
2681 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2683 FRAME_PTR f
= XFRAME (frame
);
2684 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2685 Lisp_Object ftype
, val
;
2686 Lisp_Object list
= Qnil
;
2688 int need_filtering
= 0;
2691 font_assert (FONT_SPEC_P (spec
));
2693 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2694 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2695 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2696 size
= font_pixel_size (f
, spec
);
2700 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2701 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2702 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2703 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2704 if (i
!= FONT_SPACING_INDEX
)
2706 ASET (scratch_font_spec
, i
, Qnil
);
2707 if (! NILP (AREF (spec
, i
)))
2710 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2711 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2713 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2715 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2717 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2719 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2720 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2727 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2731 val
= Fvconcat (1, &val
);
2732 copy
= copy_font_spec (scratch_font_spec
);
2733 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2734 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2738 || ! NILP (Vface_ignored_fonts
)))
2739 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2740 if (ASIZE (val
) > 0)
2741 list
= Fcons (val
, list
);
2744 list
= Fnreverse (list
);
2745 FONT_ADD_LOG ("list", spec
, list
);
2750 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2751 nil, is an array of face's attributes, which specifies preferred
2752 font-related attributes. */
2755 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2757 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2758 Lisp_Object ftype
, size
, entity
;
2760 Lisp_Object work
= copy_font_spec (spec
);
2762 XSETFRAME (frame
, f
);
2763 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2764 size
= AREF (spec
, FONT_SIZE_INDEX
);
2767 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2768 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2769 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2770 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2773 for (; driver_list
; driver_list
= driver_list
->next
)
2775 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2777 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2780 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2781 entity
= assoc_no_quit (work
, XCDR (cache
));
2783 entity
= XCDR (entity
);
2786 entity
= driver_list
->driver
->match (frame
, work
);
2787 copy
= copy_font_spec (work
);
2788 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2789 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2791 if (! NILP (entity
))
2794 FONT_ADD_LOG ("match", work
, entity
);
2799 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2800 opened font object. */
2803 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2805 struct font_driver_list
*driver_list
;
2806 Lisp_Object objlist
, size
, val
, font_object
;
2808 int min_width
, height
;
2809 int scaled_pixel_size
= pixel_size
;
2811 font_assert (FONT_ENTITY_P (entity
));
2812 size
= AREF (entity
, FONT_SIZE_INDEX
);
2813 if (XINT (size
) != 0)
2814 scaled_pixel_size
= pixel_size
= XINT (size
);
2815 else if (CONSP (Vface_font_rescale_alist
))
2816 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2818 val
= AREF (entity
, FONT_TYPE_INDEX
);
2819 for (driver_list
= f
->font_driver_list
;
2820 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2821 driver_list
= driver_list
->next
);
2825 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2826 objlist
= XCDR (objlist
))
2828 Lisp_Object fn
= XCAR (objlist
);
2829 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2830 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2832 if (driver_list
->driver
->cached_font_ok
== NULL
2833 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2838 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2839 if (!NILP (font_object
))
2840 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2841 FONT_ADD_LOG ("open", entity
, font_object
);
2842 if (NILP (font_object
))
2844 ASET (entity
, FONT_OBJLIST_INDEX
,
2845 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2848 font
= XFONT_OBJECT (font_object
);
2849 min_width
= (font
->min_width
? font
->min_width
2850 : font
->average_width
? font
->average_width
2851 : font
->space_width
? font
->space_width
2853 height
= (font
->height
? font
->height
: 1);
2854 #ifdef HAVE_WINDOW_SYSTEM
2855 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2856 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2858 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2859 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2860 fonts_changed_p
= 1;
2864 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2865 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2866 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2867 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2875 /* Close FONT_OBJECT that is opened on frame F. */
2878 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2880 struct font
*font
= XFONT_OBJECT (font_object
);
2882 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2883 /* Already closed. */
2885 FONT_ADD_LOG ("close", font_object
, Qnil
);
2886 font
->driver
->close (f
, font
);
2887 #ifdef HAVE_WINDOW_SYSTEM
2888 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2889 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2895 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2896 FONT is a font-entity and it must be opened to check. */
2899 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2903 if (FONT_ENTITY_P (font
))
2905 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2906 struct font_driver_list
*driver_list
;
2908 for (driver_list
= f
->font_driver_list
;
2909 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2910 driver_list
= driver_list
->next
);
2913 if (! driver_list
->driver
->has_char
)
2915 return driver_list
->driver
->has_char (font
, c
);
2918 font_assert (FONT_OBJECT_P (font
));
2919 fontp
= XFONT_OBJECT (font
);
2920 if (fontp
->driver
->has_char
)
2922 int result
= fontp
->driver
->has_char (font
, c
);
2927 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2931 /* Return the glyph ID of FONT_OBJECT for character C. */
2934 font_encode_char (Lisp_Object font_object
, int c
)
2938 font_assert (FONT_OBJECT_P (font_object
));
2939 font
= XFONT_OBJECT (font_object
);
2940 return font
->driver
->encode_char (font
, c
);
2944 /* Return the name of FONT_OBJECT. */
2947 font_get_name (Lisp_Object font_object
)
2949 font_assert (FONT_OBJECT_P (font_object
));
2950 return AREF (font_object
, FONT_NAME_INDEX
);
2954 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2955 could not be parsed by font_parse_name, return Qnil. */
2958 font_spec_from_name (Lisp_Object font_name
)
2960 Lisp_Object spec
= Ffont_spec (0, NULL
);
2962 CHECK_STRING (font_name
);
2963 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2965 font_put_extra (spec
, QCname
, font_name
);
2966 font_put_extra (spec
, QCuser_spec
, font_name
);
2972 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2974 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2979 if (! NILP (Ffont_get (font
, QCname
)))
2981 font
= copy_font_spec (font
);
2982 font_put_extra (font
, QCname
, Qnil
);
2985 if (NILP (AREF (font
, prop
))
2986 && prop
!= FONT_FAMILY_INDEX
2987 && prop
!= FONT_FOUNDRY_INDEX
2988 && prop
!= FONT_WIDTH_INDEX
2989 && prop
!= FONT_SIZE_INDEX
)
2991 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
2992 font
= copy_font_spec (font
);
2993 ASET (font
, prop
, Qnil
);
2994 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2996 if (prop
== FONT_FAMILY_INDEX
)
2998 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2999 /* If we are setting the font family, we must also clear
3000 FONT_WIDTH_INDEX to avoid rejecting families that lack
3001 support for some widths. */
3002 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3004 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3005 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3006 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3007 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3008 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3009 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3011 else if (prop
== FONT_SIZE_INDEX
)
3013 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3014 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3015 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3017 else if (prop
== FONT_WIDTH_INDEX
)
3018 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3019 attrs
[LFACE_FONT_INDEX
] = font
;
3022 /* Select a font from ENTITIES (list of font-entity vectors) that
3023 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3026 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3028 Lisp_Object font_entity
;
3031 FRAME_PTR f
= XFRAME (frame
);
3033 if (NILP (XCDR (entities
))
3034 && ASIZE (XCAR (entities
)) == 1)
3036 font_entity
= AREF (XCAR (entities
), 0);
3038 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3043 /* Sort fonts by properties specified in ATTRS. */
3044 prefer
= scratch_font_prefer
;
3046 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3047 ASET (prefer
, i
, Qnil
);
3048 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3050 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3052 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3053 ASET (prefer
, i
, AREF (face_font
, i
));
3055 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3056 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3057 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3058 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3059 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3060 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3061 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3063 return font_sort_entities (entities
, prefer
, frame
, c
);
3066 /* Return a font-entity that satisfies SPEC and is the best match for
3067 face's font related attributes in ATTRS. C, if not negative, is a
3068 character that the entity must support. */
3071 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3074 Lisp_Object frame
, entities
, val
;
3075 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3079 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3080 if (NILP (registry
[0]))
3082 registry
[0] = DEFAULT_ENCODING
;
3083 registry
[1] = Qascii_0
;
3084 registry
[2] = null_vector
;
3087 registry
[1] = null_vector
;
3089 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3091 struct charset
*encoding
, *repertory
;
3093 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3094 &encoding
, &repertory
) < 0)
3097 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3099 else if (c
> encoding
->max_char
)
3103 work
= copy_font_spec (spec
);
3104 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3105 XSETFRAME (frame
, f
);
3106 pixel_size
= font_pixel_size (f
, spec
);
3107 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3109 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3111 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3113 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3114 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3115 if (! NILP (foundry
[0]))
3116 foundry
[1] = null_vector
;
3117 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3119 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3120 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3122 foundry
[2] = null_vector
;
3125 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3127 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3128 if (! NILP (adstyle
[0]))
3129 adstyle
[1] = null_vector
;
3130 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3132 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3134 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3136 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3138 adstyle
[2] = null_vector
;
3141 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3144 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3147 val
= AREF (work
, FONT_FAMILY_INDEX
);
3148 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3150 val
= attrs
[LFACE_FAMILY_INDEX
];
3151 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3155 family
= alloca ((sizeof family
[0]) * 2);
3157 family
[1] = null_vector
; /* terminator. */
3162 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3163 /* Font family names are case-sensitive under NS. */
3171 if (! NILP (alters
))
3173 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3174 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3175 family
[i
] = XCAR (alters
);
3176 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3178 family
[i
] = null_vector
;
3182 family
= alloca ((sizeof family
[0]) * 3);
3185 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3187 family
[i
] = null_vector
;
3191 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3193 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3194 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3196 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3197 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3199 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3200 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3202 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3203 entities
= font_list_entities (frame
, work
);
3204 if (! NILP (entities
))
3206 val
= font_select_entity (frame
, entities
,
3207 attrs
, pixel_size
, c
);
3220 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3224 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3225 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3226 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3227 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3228 size
= font_pixel_size (f
, spec
);
3232 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3233 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3236 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3237 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3238 if (INTEGERP (height
))
3241 abort(); /* We should never end up here. */
3245 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3249 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3250 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3254 return font_open_entity (f
, entity
, size
);
3258 /* Find a font that satisfies SPEC and is the best match for
3259 face's attributes in ATTRS on FRAME, and return the opened
3263 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3265 Lisp_Object entity
, name
;
3267 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3270 /* No font is listed for SPEC, but each font-backend may have
3271 different criteria about "font matching". So, try it. */
3272 entity
= font_matching_entity (f
, attrs
, spec
);
3276 /* Don't lose the original name that was put in initially. We need
3277 it to re-apply the font when font parameters (like hinting or dpi) have
3279 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3282 name
= Ffont_get (spec
, QCuser_spec
);
3283 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3289 /* Make FACE on frame F ready to use the font opened for FACE. */
3292 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3294 if (face
->font
->driver
->prepare_face
)
3295 face
->font
->driver
->prepare_face (f
, face
);
3299 /* Make FACE on frame F stop using the font opened for FACE. */
3302 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3304 if (face
->font
->driver
->done_face
)
3305 face
->font
->driver
->done_face (f
, face
);
3310 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3311 font is found, return Qnil. */
3314 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3316 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3318 /* We set up the default font-related attributes of a face to prefer
3320 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3321 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3322 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3324 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3326 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3328 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3330 return font_load_for_lface (f
, attrs
, spec
);
3334 /* Open a font that matches NAME on frame F. If no proper font is
3335 found, return Qnil. */
3338 font_open_by_name (FRAME_PTR f
, const char *name
)
3340 Lisp_Object args
[2];
3341 Lisp_Object spec
, ret
;
3344 args
[1] = make_unibyte_string (name
, strlen (name
));
3345 spec
= Ffont_spec (2, args
);
3346 ret
= font_open_by_spec (f
, spec
);
3347 /* Do not lose name originally put in. */
3349 font_put_extra (ret
, QCuser_spec
, args
[1]);
3355 /* Register font-driver DRIVER. This function is used in two ways.
3357 The first is with frame F non-NULL. In this case, make DRIVER
3358 available (but not yet activated) on F. All frame creators
3359 (e.g. Fx_create_frame) must call this function at least once with
3360 an available font-driver.
3362 The second is with frame F NULL. In this case, DRIVER is globally
3363 registered in the variable `font_driver_list'. All font-driver
3364 implementations must call this function in its syms_of_XXXX
3365 (e.g. syms_of_xfont). */
3368 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3370 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3371 struct font_driver_list
*prev
, *list
;
3373 if (f
&& ! driver
->draw
)
3374 error ("Unusable font driver for a frame: %s",
3375 SDATA (SYMBOL_NAME (driver
->type
)));
3377 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3378 if (EQ (list
->driver
->type
, driver
->type
))
3379 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3381 list
= xmalloc (sizeof (struct font_driver_list
));
3383 list
->driver
= driver
;
3388 f
->font_driver_list
= list
;
3390 font_driver_list
= list
;
3396 free_font_driver_list (FRAME_PTR f
)
3398 struct font_driver_list
*list
, *next
;
3400 for (list
= f
->font_driver_list
; list
; list
= next
)
3405 f
->font_driver_list
= NULL
;
3409 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3410 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3411 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3413 A caller must free all realized faces if any in advance. The
3414 return value is a list of font backends actually made used on
3418 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3420 Lisp_Object active_drivers
= Qnil
;
3421 struct font_driver_list
*list
;
3423 /* At first, turn off non-requested drivers, and turn on requested
3425 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3427 struct font_driver
*driver
= list
->driver
;
3428 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3433 if (driver
->end_for_frame
)
3434 driver
->end_for_frame (f
);
3435 font_finish_cache (f
, driver
);
3440 if (! driver
->start_for_frame
3441 || driver
->start_for_frame (f
) == 0)
3443 font_prepare_cache (f
, driver
);
3450 if (NILP (new_drivers
))
3453 if (! EQ (new_drivers
, Qt
))
3455 /* Re-order the driver list according to new_drivers. */
3456 struct font_driver_list
**list_table
, **next
;
3460 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3461 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3463 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3464 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3467 list_table
[i
++] = list
;
3469 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3471 list_table
[i
++] = list
;
3472 list_table
[i
] = NULL
;
3474 next
= &f
->font_driver_list
;
3475 for (i
= 0; list_table
[i
]; i
++)
3477 *next
= list_table
[i
];
3478 next
= &(*next
)->next
;
3482 if (! f
->font_driver_list
->on
)
3483 { /* None of the drivers is enabled: enable them all.
3484 Happens if you set the list of drivers to (xft x) in your .emacs
3485 and then use it under w32 or ns. */
3486 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3488 struct font_driver
*driver
= list
->driver
;
3489 eassert (! list
->on
);
3490 if (! driver
->start_for_frame
3491 || driver
->start_for_frame (f
) == 0)
3493 font_prepare_cache (f
, driver
);
3500 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3502 active_drivers
= nconc2 (active_drivers
,
3503 Fcons (list
->driver
->type
, Qnil
));
3504 return active_drivers
;
3508 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3510 struct font_data_list
*list
, *prev
;
3512 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3513 prev
= list
, list
= list
->next
)
3514 if (list
->driver
== driver
)
3521 prev
->next
= list
->next
;
3523 f
->font_data_list
= list
->next
;
3531 list
= xmalloc (sizeof (struct font_data_list
));
3532 list
->driver
= driver
;
3533 list
->next
= f
->font_data_list
;
3534 f
->font_data_list
= list
;
3542 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3544 struct font_data_list
*list
;
3546 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3547 if (list
->driver
== driver
)
3555 /* Sets attributes on a font. Any properties that appear in ALIST and
3556 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3557 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3558 arrays of strings. This function is intended for use by the font
3559 drivers to implement their specific font_filter_properties. */
3561 font_filter_properties (Lisp_Object font
,
3563 const char *const boolean_properties
[],
3564 const char *const non_boolean_properties
[])
3569 /* Set boolean values to Qt or Qnil */
3570 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3571 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3573 Lisp_Object key
= XCAR (XCAR (it
));
3574 Lisp_Object val
= XCDR (XCAR (it
));
3575 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3577 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3579 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3580 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3583 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3584 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3585 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3586 || strcmp ("Off", str
) == 0)
3591 Ffont_put (font
, key
, val
);
3595 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3596 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3598 Lisp_Object key
= XCAR (XCAR (it
));
3599 Lisp_Object val
= XCDR (XCAR (it
));
3600 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3601 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3602 Ffont_put (font
, key
, val
);
3607 /* Return the font used to draw character C by FACE at buffer position
3608 POS in window W. If STRING is non-nil, it is a string containing C
3609 at index POS. If C is negative, get C from the current buffer or
3613 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3618 Lisp_Object font_object
;
3620 multibyte
= (NILP (string
)
3621 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3622 : STRING_MULTIBYTE (string
));
3629 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3631 c
= FETCH_CHAR (pos_byte
);
3634 c
= FETCH_BYTE (pos
);
3640 multibyte
= STRING_MULTIBYTE (string
);
3643 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3645 str
= SDATA (string
) + pos_byte
;
3646 c
= STRING_CHAR (str
);
3649 c
= SDATA (string
)[pos
];
3653 f
= XFRAME (w
->frame
);
3654 if (! FRAME_WINDOW_P (f
))
3661 if (STRINGP (string
))
3662 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3663 DEFAULT_FACE_ID
, 0);
3665 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3667 face
= FACE_FROM_ID (f
, face_id
);
3671 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3672 face
= FACE_FROM_ID (f
, face_id
);
3677 XSETFONT (font_object
, face
->font
);
3682 #ifdef HAVE_WINDOW_SYSTEM
3684 /* Check how many characters after POS (at most to *LIMIT) can be
3685 displayed by the same font in the window W. FACE, if non-NULL, is
3686 the face selected for the character at POS. If STRING is not nil,
3687 it is the string to check instead of the current buffer. In that
3688 case, FACE must be not NULL.
3690 The return value is the font-object for the character at POS.
3691 *LIMIT is set to the position where that font can't be used.
3693 It is assured that the current buffer (or STRING) is multibyte. */
3696 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3698 EMACS_INT pos_byte
, ignore
;
3700 Lisp_Object font_object
= Qnil
;
3704 pos_byte
= CHAR_TO_BYTE (pos
);
3709 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3711 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3717 pos_byte
= string_char_to_byte (string
, pos
);
3720 while (pos
< *limit
)
3722 Lisp_Object category
;
3725 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3727 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3728 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3729 if (EQ (category
, QCf
)
3730 || CHAR_VARIATION_SELECTOR_P (c
))
3732 if (NILP (font_object
))
3734 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3735 if (NILP (font_object
))
3739 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3749 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3750 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3751 Return nil otherwise.
3752 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3753 which kind of font it is. It must be one of `font-spec', `font-entity',
3755 (Lisp_Object object
, Lisp_Object extra_type
)
3757 if (NILP (extra_type
))
3758 return (FONTP (object
) ? Qt
: Qnil
);
3759 if (EQ (extra_type
, Qfont_spec
))
3760 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3761 if (EQ (extra_type
, Qfont_entity
))
3762 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3763 if (EQ (extra_type
, Qfont_object
))
3764 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3765 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3768 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3769 doc
: /* Return a newly created font-spec with arguments as properties.
3771 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3772 valid font property name listed below:
3774 `:family', `:weight', `:slant', `:width'
3776 They are the same as face attributes of the same name. See
3777 `set-face-attribute'.
3781 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3785 VALUE must be a string or a symbol specifying the additional
3786 typographic style information of a font, e.g. ``sans''.
3790 VALUE must be a string or a symbol specifying the charset registry and
3791 encoding of a font, e.g. ``iso8859-1''.
3795 VALUE must be a non-negative integer or a floating point number
3796 specifying the font size. It specifies the font size in pixels (if
3797 VALUE is an integer), or in points (if VALUE is a float).
3801 VALUE must be a string of XLFD-style or fontconfig-style font name.
3805 VALUE must be a symbol representing a script that the font must
3806 support. It may be a symbol representing a subgroup of a script
3807 listed in the variable `script-representative-chars'.
3811 VALUE must be a symbol of two-letter ISO-639 language names,
3816 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3817 required OpenType features.
3819 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3820 LANGSYS-TAG: OpenType language system tag symbol,
3821 or nil for the default language system.
3822 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3823 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3825 GSUB and GPOS may contain `nil' element. In such a case, the font
3826 must not have any of the remaining elements.
3828 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3829 be an OpenType font whose GPOS table of `thai' script's default
3830 language system must contain `mark' feature.
3832 usage: (font-spec ARGS...) */)
3833 (ptrdiff_t nargs
, Lisp_Object
*args
)
3835 Lisp_Object spec
= font_make_spec ();
3838 for (i
= 0; i
< nargs
; i
+= 2)
3840 Lisp_Object key
= args
[i
], val
;
3844 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3847 if (EQ (key
, QCname
))
3850 font_parse_name (SSDATA (val
), spec
);
3851 font_put_extra (spec
, key
, val
);
3855 int idx
= get_font_prop_index (key
);
3859 val
= font_prop_validate (idx
, Qnil
, val
);
3860 if (idx
< FONT_EXTRA_INDEX
)
3861 ASET (spec
, idx
, val
);
3863 font_put_extra (spec
, key
, val
);
3866 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3872 /* Return a copy of FONT as a font-spec. */
3874 copy_font_spec (Lisp_Object font
)
3876 Lisp_Object new_spec
, tail
, prev
, extra
;
3880 new_spec
= font_make_spec ();
3881 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3882 ASET (new_spec
, i
, AREF (font
, i
));
3883 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3884 /* We must remove :font-entity property. */
3885 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3886 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3889 extra
= XCDR (extra
);
3891 XSETCDR (prev
, XCDR (tail
));
3894 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3898 /* Merge font-specs FROM and TO, and return a new font-spec.
3899 Every specified property in FROM overrides the corresponding
3902 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3904 Lisp_Object extra
, tail
;
3909 to
= copy_font_spec (to
);
3910 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3911 ASET (to
, i
, AREF (from
, i
));
3912 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3913 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3914 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3916 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3919 XSETCDR (slot
, XCDR (XCAR (tail
)));
3921 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3923 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3927 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3928 doc
: /* Return the value of FONT's property KEY.
3929 FONT is a font-spec, a font-entity, or a font-object.
3930 KEY is any symbol, but these are reserved for specific meanings:
3931 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3932 :size, :name, :script, :otf
3933 See the documentation of `font-spec' for their meanings.
3934 In addition, if FONT is a font-entity or a font-object, values of
3935 :script and :otf are different from those of a font-spec as below:
3937 The value of :script may be a list of scripts that are supported by the font.
3939 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3940 representing the OpenType features supported by the font by this form:
3941 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3942 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3944 (Lisp_Object font
, Lisp_Object key
)
3952 idx
= get_font_prop_index (key
);
3953 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3954 return font_style_symbolic (font
, idx
, 0);
3955 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3956 return AREF (font
, idx
);
3957 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3958 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3960 struct font
*fontp
= XFONT_OBJECT (font
);
3962 if (fontp
->driver
->otf_capability
)
3963 val
= fontp
->driver
->otf_capability (fontp
);
3965 val
= Fcons (Qnil
, Qnil
);
3972 #ifdef HAVE_WINDOW_SYSTEM
3974 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3975 doc
: /* Return a plist of face attributes generated by FONT.
3976 FONT is a font name, a font-spec, a font-entity, or a font-object.
3977 The return value is a list of the form
3979 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3981 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3982 compatible with `set-face-attribute'. Some of these key-attribute pairs
3983 may be omitted from the list if they are not specified by FONT.
3985 The optional argument FRAME specifies the frame that the face attributes
3986 are to be displayed on. If omitted, the selected frame is used. */)
3987 (Lisp_Object font
, Lisp_Object frame
)
3990 Lisp_Object plist
[10];
3995 frame
= selected_frame
;
3996 CHECK_LIVE_FRAME (frame
);
4001 int fontset
= fs_query_fontset (font
, 0);
4002 Lisp_Object name
= font
;
4004 font
= fontset_ascii (fontset
);
4005 font
= font_spec_from_name (name
);
4007 signal_error ("Invalid font name", name
);
4009 else if (! FONTP (font
))
4010 signal_error ("Invalid font object", font
);
4012 val
= AREF (font
, FONT_FAMILY_INDEX
);
4015 plist
[n
++] = QCfamily
;
4016 plist
[n
++] = SYMBOL_NAME (val
);
4019 val
= AREF (font
, FONT_SIZE_INDEX
);
4022 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4023 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4024 plist
[n
++] = QCheight
;
4025 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4027 else if (FLOATP (val
))
4029 plist
[n
++] = QCheight
;
4030 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4033 val
= FONT_WEIGHT_FOR_FACE (font
);
4036 plist
[n
++] = QCweight
;
4040 val
= FONT_SLANT_FOR_FACE (font
);
4043 plist
[n
++] = QCslant
;
4047 val
= FONT_WIDTH_FOR_FACE (font
);
4050 plist
[n
++] = QCwidth
;
4054 return Flist (n
, plist
);
4059 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4060 doc
: /* Set one property of FONT: give property KEY value VAL.
4061 FONT is a font-spec, a font-entity, or a font-object.
4063 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4064 accepted by the function `font-spec' (which see), VAL must be what
4065 allowed in `font-spec'.
4067 If FONT is a font-entity or a font-object, KEY must not be the one
4068 accepted by `font-spec'. */)
4069 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4073 idx
= get_font_prop_index (prop
);
4074 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4076 CHECK_FONT_SPEC (font
);
4077 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4081 if (EQ (prop
, QCname
)
4082 || EQ (prop
, QCscript
)
4083 || EQ (prop
, QClang
)
4084 || EQ (prop
, QCotf
))
4085 CHECK_FONT_SPEC (font
);
4088 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4093 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4094 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4095 Optional 2nd argument FRAME specifies the target frame.
4096 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4097 Optional 4th argument PREFER, if non-nil, is a font-spec to
4098 control the order of the returned list. Fonts are sorted by
4099 how close they are to PREFER. */)
4100 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4102 Lisp_Object vec
, list
;
4106 frame
= selected_frame
;
4107 CHECK_LIVE_FRAME (frame
);
4108 CHECK_FONT_SPEC (font_spec
);
4116 if (! NILP (prefer
))
4117 CHECK_FONT_SPEC (prefer
);
4119 list
= font_list_entities (frame
, font_spec
);
4122 if (NILP (XCDR (list
))
4123 && ASIZE (XCAR (list
)) == 1)
4124 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4126 if (! NILP (prefer
))
4127 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4129 vec
= font_vconcat_entity_vectors (list
);
4130 if (n
== 0 || n
>= ASIZE (vec
))
4132 Lisp_Object args
[2];
4136 list
= Fappend (2, args
);
4140 for (list
= Qnil
, n
--; n
>= 0; n
--)
4141 list
= Fcons (AREF (vec
, n
), list
);
4146 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4147 doc
: /* List available font families on the current frame.
4148 Optional argument FRAME, if non-nil, specifies the target frame. */)
4152 struct font_driver_list
*driver_list
;
4156 frame
= selected_frame
;
4157 CHECK_LIVE_FRAME (frame
);
4160 for (driver_list
= f
->font_driver_list
; driver_list
;
4161 driver_list
= driver_list
->next
)
4162 if (driver_list
->driver
->list_family
)
4164 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4165 Lisp_Object tail
= list
;
4167 for (; CONSP (val
); val
= XCDR (val
))
4168 if (NILP (Fmemq (XCAR (val
), tail
))
4169 && SYMBOLP (XCAR (val
)))
4170 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4175 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4176 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4177 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4178 (Lisp_Object font_spec
, Lisp_Object frame
)
4180 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4187 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4188 doc
: /* Return XLFD name of FONT.
4189 FONT is a font-spec, font-entity, or font-object.
4190 If the name is too long for XLFD (maximum 255 chars), return nil.
4191 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4192 the consecutive wildcards are folded into one. */)
4193 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4200 if (FONT_OBJECT_P (font
))
4202 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4204 if (STRINGP (font_name
)
4205 && SDATA (font_name
)[0] == '-')
4207 if (NILP (fold_wildcards
))
4209 strcpy (name
, SSDATA (font_name
));
4212 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4214 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4217 if (! NILP (fold_wildcards
))
4219 char *p0
= name
, *p1
;
4221 while ((p1
= strstr (p0
, "-*-*")))
4223 strcpy (p1
, p1
+ 2);
4228 return build_string (name
);
4231 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4232 doc
: /* Clear font cache. */)
4235 Lisp_Object list
, frame
;
4237 FOR_EACH_FRAME (list
, frame
)
4239 FRAME_PTR f
= XFRAME (frame
);
4240 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4242 for (; driver_list
; driver_list
= driver_list
->next
)
4243 if (driver_list
->on
)
4245 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4246 Lisp_Object val
, tmp
;
4250 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4252 font_assert (! NILP (val
));
4253 tmp
= XCDR (XCAR (val
));
4254 if (XINT (XCAR (tmp
)) == 0)
4256 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4257 XSETCDR (cache
, XCDR (val
));
4267 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4269 struct font
*font
= XFONT_OBJECT (font_object
);
4271 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4272 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4273 struct font_metrics metrics
;
4275 LGLYPH_SET_CODE (glyph
, ecode
);
4277 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4278 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4279 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4280 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4281 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4282 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4286 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4287 doc
: /* Shape the glyph-string GSTRING.
4288 Shaping means substituting glyphs and/or adjusting positions of glyphs
4289 to get the correct visual image of character sequences set in the
4290 header of the glyph-string.
4292 If the shaping was successful, the value is GSTRING itself or a newly
4293 created glyph-string. Otherwise, the value is nil. */)
4294 (Lisp_Object gstring
)
4297 Lisp_Object font_object
, n
, glyph
;
4298 EMACS_INT i
, j
, from
, to
;
4300 if (! composition_gstring_p (gstring
))
4301 signal_error ("Invalid glyph-string: ", gstring
);
4302 if (! NILP (LGSTRING_ID (gstring
)))
4304 font_object
= LGSTRING_FONT (gstring
);
4305 CHECK_FONT_OBJECT (font_object
);
4306 font
= XFONT_OBJECT (font_object
);
4307 if (! font
->driver
->shape
)
4310 /* Try at most three times with larger gstring each time. */
4311 for (i
= 0; i
< 3; i
++)
4313 n
= font
->driver
->shape (gstring
);
4316 gstring
= larger_vector (gstring
,
4317 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4320 if (i
== 3 || XINT (n
) == 0)
4322 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4323 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4325 glyph
= LGSTRING_GLYPH (gstring
, 0);
4326 from
= LGLYPH_FROM (glyph
);
4327 to
= LGLYPH_TO (glyph
);
4328 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4330 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4334 if (NILP (LGLYPH_ADJUSTMENT (this)))
4339 glyph
= LGSTRING_GLYPH (gstring
, j
);
4340 LGLYPH_SET_FROM (glyph
, from
);
4341 LGLYPH_SET_TO (glyph
, to
);
4343 from
= LGLYPH_FROM (this);
4344 to
= LGLYPH_TO (this);
4349 if (from
> LGLYPH_FROM (this))
4350 from
= LGLYPH_FROM (this);
4351 if (to
< LGLYPH_TO (this))
4352 to
= LGLYPH_TO (this);
4358 glyph
= LGSTRING_GLYPH (gstring
, j
);
4359 LGLYPH_SET_FROM (glyph
, from
);
4360 LGLYPH_SET_TO (glyph
, to
);
4362 return composition_gstring_put_cache (gstring
, XINT (n
));
4365 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4367 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4368 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4370 VARIATION-SELECTOR is a character code of variation selection
4371 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4372 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4373 (Lisp_Object font_object
, Lisp_Object character
)
4375 unsigned variations
[256];
4380 CHECK_FONT_OBJECT (font_object
);
4381 CHECK_CHARACTER (character
);
4382 font
= XFONT_OBJECT (font_object
);
4383 if (! font
->driver
->get_variation_glyphs
)
4385 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4389 for (i
= 0; i
< 255; i
++)
4392 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4393 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4394 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4401 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4402 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4403 OTF-FEATURES specifies which features to apply in this format:
4404 (SCRIPT LANGSYS GSUB GPOS)
4406 SCRIPT is a symbol specifying a script tag of OpenType,
4407 LANGSYS is a symbol specifying a langsys tag of OpenType,
4408 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4410 If LANGYS is nil, the default langsys is selected.
4412 The features are applied in the order they appear in the list. The
4413 symbol `*' means to apply all available features not present in this
4414 list, and the remaining features are ignored. For instance, (vatu
4415 pstf * haln) is to apply vatu and pstf in this order, then to apply
4416 all available features other than vatu, pstf, and haln.
4418 The features are applied to the glyphs in the range FROM and TO of
4419 the glyph-string GSTRING-IN.
4421 If some feature is actually applicable, the resulting glyphs are
4422 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4423 this case, the value is the number of produced glyphs.
4425 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4428 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4429 produced in GSTRING-OUT, and the value is nil.
4431 See the documentation of `composition-get-gstring' for the format of
4433 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4435 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4440 check_otf_features (otf_features
);
4441 CHECK_FONT_OBJECT (font_object
);
4442 font
= XFONT_OBJECT (font_object
);
4443 if (! font
->driver
->otf_drive
)
4444 error ("Font backend %s can't drive OpenType GSUB table",
4445 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4446 CHECK_CONS (otf_features
);
4447 CHECK_SYMBOL (XCAR (otf_features
));
4448 val
= XCDR (otf_features
);
4449 CHECK_SYMBOL (XCAR (val
));
4450 val
= XCDR (otf_features
);
4453 len
= check_gstring (gstring_in
);
4454 CHECK_VECTOR (gstring_out
);
4455 CHECK_NATNUM (from
);
4457 CHECK_NATNUM (index
);
4459 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4460 args_out_of_range_3 (from
, to
, make_number (len
));
4461 if (XINT (index
) >= ASIZE (gstring_out
))
4462 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4463 num
= font
->driver
->otf_drive (font
, otf_features
,
4464 gstring_in
, XINT (from
), XINT (to
),
4465 gstring_out
, XINT (index
), 0);
4468 return make_number (num
);
4471 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4473 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4474 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4476 (SCRIPT LANGSYS FEATURE ...)
4477 See the documentation of `font-drive-otf' for more detail.
4479 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4480 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4481 character code corresponding to the glyph or nil if there's no
4482 corresponding character. */)
4483 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4486 Lisp_Object gstring_in
, gstring_out
, g
;
4487 Lisp_Object alternates
;
4490 CHECK_FONT_GET_OBJECT (font_object
, font
);
4491 if (! font
->driver
->otf_drive
)
4492 error ("Font backend %s can't drive OpenType GSUB table",
4493 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4494 CHECK_CHARACTER (character
);
4495 CHECK_CONS (otf_features
);
4497 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4498 g
= LGSTRING_GLYPH (gstring_in
, 0);
4499 LGLYPH_SET_CHAR (g
, XINT (character
));
4500 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4501 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4502 gstring_out
, 0, 1)) < 0)
4503 gstring_out
= Ffont_make_gstring (font_object
,
4504 make_number (ASIZE (gstring_out
) * 2));
4506 for (i
= 0; i
< num
; i
++)
4508 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4509 int c
= LGLYPH_CHAR (g
);
4510 unsigned code
= LGLYPH_CODE (g
);
4512 alternates
= Fcons (Fcons (make_number (code
),
4513 c
> 0 ? make_number (c
) : Qnil
),
4516 return Fnreverse (alternates
);
4522 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4523 doc
: /* Open FONT-ENTITY. */)
4524 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4528 CHECK_FONT_ENTITY (font_entity
);
4530 frame
= selected_frame
;
4531 CHECK_LIVE_FRAME (frame
);
4534 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4537 CHECK_NUMBER_OR_FLOAT (size
);
4539 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4541 isize
= XINT (size
);
4545 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4548 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4549 doc
: /* Close FONT-OBJECT. */)
4550 (Lisp_Object font_object
, Lisp_Object frame
)
4552 CHECK_FONT_OBJECT (font_object
);
4554 frame
= selected_frame
;
4555 CHECK_LIVE_FRAME (frame
);
4556 font_close_object (XFRAME (frame
), font_object
);
4560 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4561 doc
: /* Return information about FONT-OBJECT.
4562 The value is a vector:
4563 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4566 NAME is the font name, a string (or nil if the font backend doesn't
4569 FILENAME is the font file name, a string (or nil if the font backend
4570 doesn't provide a file name).
4572 PIXEL-SIZE is a pixel size by which the font is opened.
4574 SIZE is a maximum advance width of the font in pixels.
4576 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4579 CAPABILITY is a list whose first element is a symbol representing the
4580 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4581 remaining elements describe the details of the font capability.
4583 If the font is OpenType font, the form of the list is
4584 \(opentype GSUB GPOS)
4585 where GSUB shows which "GSUB" features the font supports, and GPOS
4586 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4587 lists of the format:
4588 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4590 If the font is not OpenType font, currently the length of the form is
4593 SCRIPT is a symbol representing OpenType script tag.
4595 LANGSYS is a symbol representing OpenType langsys tag, or nil
4596 representing the default langsys.
4598 FEATURE is a symbol representing OpenType feature tag.
4600 If the font is not OpenType font, CAPABILITY is nil. */)
4601 (Lisp_Object font_object
)
4606 CHECK_FONT_GET_OBJECT (font_object
, font
);
4608 val
= Fmake_vector (make_number (9), Qnil
);
4609 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4610 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4611 ASET (val
, 2, make_number (font
->pixel_size
));
4612 ASET (val
, 3, make_number (font
->max_width
));
4613 ASET (val
, 4, make_number (font
->ascent
));
4614 ASET (val
, 5, make_number (font
->descent
));
4615 ASET (val
, 6, make_number (font
->space_width
));
4616 ASET (val
, 7, make_number (font
->average_width
));
4617 if (font
->driver
->otf_capability
)
4618 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4622 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4624 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4625 FROM and TO are positions (integers or markers) specifying a region
4626 of the current buffer.
4627 If the optional fourth arg OBJECT is not nil, it is a string or a
4628 vector containing the target characters.
4630 Each element is a vector containing information of a glyph in this format:
4631 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4633 FROM is an index numbers of a character the glyph corresponds to.
4634 TO is the same as FROM.
4635 C is the character of the glyph.
4636 CODE is the glyph-code of C in FONT-OBJECT.
4637 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4638 ADJUSTMENT is always nil.
4639 If FONT-OBJECT doesn't have a glyph for a character,
4640 the corresponding element is nil. */)
4641 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4646 Lisp_Object
*chars
, vec
;
4649 CHECK_FONT_GET_OBJECT (font_object
, font
);
4652 EMACS_INT charpos
, bytepos
;
4654 validate_region (&from
, &to
);
4657 len
= XFASTINT (to
) - XFASTINT (from
);
4658 SAFE_ALLOCA_LISP (chars
, len
);
4659 charpos
= XFASTINT (from
);
4660 bytepos
= CHAR_TO_BYTE (charpos
);
4661 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4664 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4665 chars
[i
] = make_number (c
);
4668 else if (STRINGP (object
))
4670 const unsigned char *p
;
4672 CHECK_NUMBER (from
);
4674 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4675 || XINT (to
) > SCHARS (object
))
4676 args_out_of_range_3 (object
, from
, to
);
4679 len
= XFASTINT (to
) - XFASTINT (from
);
4680 SAFE_ALLOCA_LISP (chars
, len
);
4682 if (STRING_MULTIBYTE (object
))
4683 for (i
= 0; i
< len
; i
++)
4685 int c
= STRING_CHAR_ADVANCE (p
);
4686 chars
[i
] = make_number (c
);
4689 for (i
= 0; i
< len
; i
++)
4690 chars
[i
] = make_number (p
[i
]);
4694 CHECK_VECTOR (object
);
4695 CHECK_NUMBER (from
);
4697 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4698 || XINT (to
) > ASIZE (object
))
4699 args_out_of_range_3 (object
, from
, to
);
4702 len
= XFASTINT (to
) - XFASTINT (from
);
4703 for (i
= 0; i
< len
; i
++)
4705 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4706 CHECK_CHARACTER (elt
);
4708 chars
= &(AREF (object
, XFASTINT (from
)));
4711 vec
= Fmake_vector (make_number (len
), Qnil
);
4712 for (i
= 0; i
< len
; i
++)
4715 int c
= XFASTINT (chars
[i
]);
4717 struct font_metrics metrics
;
4719 code
= font
->driver
->encode_char (font
, c
);
4720 if (code
== FONT_INVALID_CODE
)
4722 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4723 LGLYPH_SET_FROM (g
, i
);
4724 LGLYPH_SET_TO (g
, i
);
4725 LGLYPH_SET_CHAR (g
, c
);
4726 LGLYPH_SET_CODE (g
, code
);
4727 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4728 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4729 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4730 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4731 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4732 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4735 if (! VECTORP (object
))
4740 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4741 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4742 FONT is a font-spec, font-entity, or font-object. */)
4743 (Lisp_Object spec
, Lisp_Object font
)
4745 CHECK_FONT_SPEC (spec
);
4748 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4751 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4752 doc
: /* Return a font-object for displaying a character at POSITION.
4753 Optional second arg WINDOW, if non-nil, is a window displaying
4754 the current buffer. It defaults to the currently selected window. */)
4755 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4762 CHECK_NUMBER_COERCE_MARKER (position
);
4763 pos
= XINT (position
);
4764 if (pos
< BEGV
|| pos
>= ZV
)
4765 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4769 CHECK_NUMBER (position
);
4770 CHECK_STRING (string
);
4771 pos
= XINT (position
);
4772 if (pos
< 0 || pos
>= SCHARS (string
))
4773 args_out_of_range (string
, position
);
4776 window
= selected_window
;
4777 CHECK_LIVE_WINDOW (window
);
4778 w
= XWINDOW (window
);
4780 return font_at (-1, pos
, NULL
, w
, string
);
4784 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4785 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4786 The value is a number of glyphs drawn.
4787 Type C-l to recover what previously shown. */)
4788 (Lisp_Object font_object
, Lisp_Object string
)
4790 Lisp_Object frame
= selected_frame
;
4791 FRAME_PTR f
= XFRAME (frame
);
4797 CHECK_FONT_GET_OBJECT (font_object
, font
);
4798 CHECK_STRING (string
);
4799 len
= SCHARS (string
);
4800 code
= alloca (sizeof (unsigned) * len
);
4801 for (i
= 0; i
< len
; i
++)
4803 Lisp_Object ch
= Faref (string
, make_number (i
));
4807 code
[i
] = font
->driver
->encode_char (font
, c
);
4808 if (code
[i
] == FONT_INVALID_CODE
)
4811 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4813 if (font
->driver
->prepare_face
)
4814 font
->driver
->prepare_face (f
, face
);
4815 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4816 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4817 if (font
->driver
->done_face
)
4818 font
->driver
->done_face (f
, face
);
4820 return make_number (len
);
4824 #endif /* FONT_DEBUG */
4826 #ifdef HAVE_WINDOW_SYSTEM
4828 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4829 doc
: /* Return information about a font named NAME on frame FRAME.
4830 If FRAME is omitted or nil, use the selected frame.
4831 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4832 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4834 OPENED-NAME is the name used for opening the font,
4835 FULL-NAME is the full name of the font,
4836 SIZE is the pixelsize of the font,
4837 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4838 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4839 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4840 how to compose characters.
4841 If the named font is not yet loaded, return nil. */)
4842 (Lisp_Object name
, Lisp_Object frame
)
4847 Lisp_Object font_object
;
4849 (*check_window_system_func
) ();
4852 CHECK_STRING (name
);
4854 frame
= selected_frame
;
4855 CHECK_LIVE_FRAME (frame
);
4860 int fontset
= fs_query_fontset (name
, 0);
4863 name
= fontset_ascii (fontset
);
4864 font_object
= font_open_by_name (f
, SSDATA (name
));
4866 else if (FONT_OBJECT_P (name
))
4868 else if (FONT_ENTITY_P (name
))
4869 font_object
= font_open_entity (f
, name
, 0);
4872 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4873 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4875 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4877 if (NILP (font_object
))
4879 font
= XFONT_OBJECT (font_object
);
4881 info
= Fmake_vector (make_number (7), Qnil
);
4882 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4883 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4884 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4885 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4886 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4887 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4888 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4891 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4892 close it now. Perhaps, we should manage font-objects
4893 by `reference-count'. */
4894 font_close_object (f
, font_object
);
4901 #define BUILD_STYLE_TABLE(TBL) \
4902 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4905 build_style_table (const struct table_entry
*entry
, int nelement
)
4908 Lisp_Object table
, elt
;
4910 table
= Fmake_vector (make_number (nelement
), Qnil
);
4911 for (i
= 0; i
< nelement
; i
++)
4913 for (j
= 0; entry
[i
].names
[j
]; j
++);
4914 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4915 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4916 for (j
= 0; entry
[i
].names
[j
]; j
++)
4917 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4918 ASET (table
, i
, elt
);
4923 /* The deferred font-log data of the form [ACTION ARG RESULT].
4924 If ACTION is not nil, that is added to the log when font_add_log is
4925 called next time. At that time, ACTION is set back to nil. */
4926 static Lisp_Object Vfont_log_deferred
;
4928 /* Prepend the font-related logging data in Vfont_log if it is not
4929 `t'. ACTION describes a kind of font-related action (e.g. listing,
4930 opening), ARG is the argument for the action, and RESULT is the
4931 result of the action. */
4933 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4938 if (EQ (Vfont_log
, Qt
))
4940 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4942 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4944 ASET (Vfont_log_deferred
, 0, Qnil
);
4945 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4946 AREF (Vfont_log_deferred
, 2));
4951 Lisp_Object tail
, elt
;
4952 Lisp_Object equalstr
= build_string ("=");
4954 val
= Ffont_xlfd_name (arg
, Qt
);
4955 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4959 if (EQ (XCAR (elt
), QCscript
)
4960 && SYMBOLP (XCDR (elt
)))
4961 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4962 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4963 else if (EQ (XCAR (elt
), QClang
)
4964 && SYMBOLP (XCDR (elt
)))
4965 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4966 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4967 else if (EQ (XCAR (elt
), QCotf
)
4968 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4969 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4971 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4977 && VECTORP (XCAR (result
))
4978 && ASIZE (XCAR (result
)) > 0
4979 && FONTP (AREF (XCAR (result
), 0)))
4980 result
= font_vconcat_entity_vectors (result
);
4983 val
= Ffont_xlfd_name (result
, Qt
);
4984 if (! FONT_SPEC_P (result
))
4985 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4986 build_string (":"), val
);
4989 else if (CONSP (result
))
4992 result
= Fcopy_sequence (result
);
4993 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4997 val
= Ffont_xlfd_name (val
, Qt
);
4998 XSETCAR (tail
, val
);
5001 else if (VECTORP (result
))
5003 result
= Fcopy_sequence (result
);
5004 for (i
= 0; i
< ASIZE (result
); i
++)
5006 val
= AREF (result
, i
);
5008 val
= Ffont_xlfd_name (val
, Qt
);
5009 ASET (result
, i
, val
);
5012 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5015 /* Record a font-related logging data to be added to Vfont_log when
5016 font_add_log is called next time. ACTION, ARG, RESULT are the same
5020 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5022 if (EQ (Vfont_log
, Qt
))
5024 ASET (Vfont_log_deferred
, 0, build_string (action
));
5025 ASET (Vfont_log_deferred
, 1, arg
);
5026 ASET (Vfont_log_deferred
, 2, result
);
5032 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5033 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5034 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5035 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5036 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5037 /* Note that the other elements in sort_shift_bits are not used. */
5039 staticpro (&font_charset_alist
);
5040 font_charset_alist
= Qnil
;
5042 DEFSYM (Qopentype
, "opentype");
5044 DEFSYM (Qascii_0
, "ascii-0");
5045 DEFSYM (Qiso8859_1
, "iso8859-1");
5046 DEFSYM (Qiso10646_1
, "iso10646-1");
5047 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5048 DEFSYM (Qunicode_sip
, "unicode-sip");
5052 DEFSYM (QCotf
, ":otf");
5053 DEFSYM (QClang
, ":lang");
5054 DEFSYM (QCscript
, ":script");
5055 DEFSYM (QCantialias
, ":antialias");
5057 DEFSYM (QCfoundry
, ":foundry");
5058 DEFSYM (QCadstyle
, ":adstyle");
5059 DEFSYM (QCregistry
, ":registry");
5060 DEFSYM (QCspacing
, ":spacing");
5061 DEFSYM (QCdpi
, ":dpi");
5062 DEFSYM (QCscalable
, ":scalable");
5063 DEFSYM (QCavgwidth
, ":avgwidth");
5064 DEFSYM (QCfont_entity
, ":font-entity");
5065 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5075 DEFSYM (QCuser_spec
, "user-spec");
5077 staticpro (&null_vector
);
5078 null_vector
= Fmake_vector (make_number (0), Qnil
);
5080 staticpro (&scratch_font_spec
);
5081 scratch_font_spec
= Ffont_spec (0, NULL
);
5082 staticpro (&scratch_font_prefer
);
5083 scratch_font_prefer
= Ffont_spec (0, NULL
);
5085 staticpro (&Vfont_log_deferred
);
5086 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5090 staticpro (&otf_list
);
5092 #endif /* HAVE_LIBOTF */
5096 defsubr (&Sfont_spec
);
5097 defsubr (&Sfont_get
);
5098 #ifdef HAVE_WINDOW_SYSTEM
5099 defsubr (&Sfont_face_attributes
);
5101 defsubr (&Sfont_put
);
5102 defsubr (&Slist_fonts
);
5103 defsubr (&Sfont_family_list
);
5104 defsubr (&Sfind_font
);
5105 defsubr (&Sfont_xlfd_name
);
5106 defsubr (&Sclear_font_cache
);
5107 defsubr (&Sfont_shape_gstring
);
5108 defsubr (&Sfont_variation_glyphs
);
5110 defsubr (&Sfont_drive_otf
);
5111 defsubr (&Sfont_otf_alternates
);
5115 defsubr (&Sopen_font
);
5116 defsubr (&Sclose_font
);
5117 defsubr (&Squery_font
);
5118 defsubr (&Sfont_get_glyphs
);
5119 defsubr (&Sfont_match_p
);
5120 defsubr (&Sfont_at
);
5122 defsubr (&Sdraw_string
);
5124 #endif /* FONT_DEBUG */
5125 #ifdef HAVE_WINDOW_SYSTEM
5126 defsubr (&Sfont_info
);
5129 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5131 Alist of fontname patterns vs the corresponding encoding and repertory info.
5132 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5133 where ENCODING is a charset or a char-table,
5134 and REPERTORY is a charset, a char-table, or nil.
5136 If ENCODING and REPERTORY are the same, the element can have the form
5137 \(REGEXP . ENCODING).
5139 ENCODING is for converting a character to a glyph code of the font.
5140 If ENCODING is a charset, encoding a character by the charset gives
5141 the corresponding glyph code. If ENCODING is a char-table, looking up
5142 the table by a character gives the corresponding glyph code.
5144 REPERTORY specifies a repertory of characters supported by the font.
5145 If REPERTORY is a charset, all characters beloging to the charset are
5146 supported. If REPERTORY is a char-table, all characters who have a
5147 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5148 gets the repertory information by an opened font and ENCODING. */);
5149 Vfont_encoding_alist
= Qnil
;
5151 /* FIXME: These 3 vars are not quite what they appear: setq on them
5152 won't have any effect other than disconnect them from the style
5153 table used by the font display code. So we make them read-only,
5154 to avoid this confusing situation. */
5156 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5157 doc
: /* Vector of valid font weight values.
5158 Each element has the form:
5159 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5160 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5161 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5162 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5164 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5165 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5166 See `font-weight-table' for the format of the vector. */);
5167 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5168 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5170 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5171 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5172 See `font-weight-table' for the format of the vector. */);
5173 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5174 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5176 staticpro (&font_style_table
);
5177 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5178 ASET (font_style_table
, 0, Vfont_weight_table
);
5179 ASET (font_style_table
, 1, Vfont_slant_table
);
5180 ASET (font_style_table
, 2, Vfont_width_table
);
5182 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5183 *Logging list of font related actions and results.
5184 The value t means to suppress the logging.
5185 The initial value is set to nil if the environment variable
5186 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5189 #ifdef HAVE_WINDOW_SYSTEM
5190 #ifdef HAVE_FREETYPE
5192 #ifdef HAVE_X_WINDOWS
5197 #endif /* HAVE_XFT */
5198 #endif /* HAVE_X_WINDOWS */
5199 #else /* not HAVE_FREETYPE */
5200 #ifdef HAVE_X_WINDOWS
5202 #endif /* HAVE_X_WINDOWS */
5203 #endif /* not HAVE_FREETYPE */
5206 #endif /* HAVE_BDFFONT */
5209 #endif /* WINDOWSNT */
5212 #endif /* HAVE_NS */
5213 #endif /* HAVE_WINDOW_SYSTEM */
5219 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;