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 symbol and the corresponding charsets
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 "*", it returns nil.
230 If FORCE_SYMBOL is zero and all characters in STR are digits, it
231 returns an integer. Otherwise, it returns 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 suite our purpose. */
256 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 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 a 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 validaters. 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 validater 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 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 restring 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 int 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 int 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
;
1547 Lisp_Object styles
[3];
1548 const char *style_names
[3] = { "weight", "slant", "width" };
1551 family
= AREF (font
, FONT_FAMILY_INDEX
);
1552 if (! NILP (family
))
1554 if (SYMBOLP (family
))
1556 family
= SYMBOL_NAME (family
);
1557 len
+= SBYTES (family
);
1563 val
= AREF (font
, FONT_SIZE_INDEX
);
1566 if (XINT (val
) != 0)
1567 pixel_size
= XINT (val
);
1569 len
+= 21; /* for ":pixelsize=NUM" */
1576 point_size
= (int) XFLOAT_DATA (val
);
1577 len
+= 11; /* for "-NUM" */
1580 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1581 if (! NILP (foundry
))
1583 if (SYMBOLP (foundry
))
1585 foundry
= SYMBOL_NAME (foundry
);
1586 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1592 for (i
= 0; i
< 3; i
++)
1594 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1595 if (! NILP (styles
[i
]))
1596 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1597 SDATA (SYMBOL_NAME (styles
[i
])));
1600 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1601 len
+= sprintf (work
, ":dpi=%"pI
"d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1602 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1603 len
+= strlen (":spacing=100");
1604 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1605 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1606 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1608 Lisp_Object key
= XCAR (XCAR (tail
)), value
= XCDR (XCAR (tail
));
1610 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1611 if (STRINGP (value
))
1612 len
+= SBYTES (value
);
1613 else if (INTEGERP (value
))
1614 len
+= sprintf (work
, "%"pI
"d", XINT (value
));
1615 else if (SYMBOLP (value
))
1616 len
+= (NILP (value
) ? 5 : 4); /* for "false" or "true" */
1622 if (! NILP (family
))
1623 p
+= sprintf (p
, "%s", SDATA (family
));
1627 p
+= sprintf (p
, "%d", point_size
);
1629 p
+= sprintf (p
, "-%d", point_size
);
1631 else if (pixel_size
> 0)
1632 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1633 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1634 p
+= sprintf (p
, ":foundry=%s",
1635 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1636 for (i
= 0; i
< 3; i
++)
1637 if (! NILP (styles
[i
]))
1638 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1639 SDATA (SYMBOL_NAME (styles
[i
])));
1640 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1641 p
+= sprintf (p
, ":dpi=%"pI
"d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1642 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1643 p
+= sprintf (p
, ":spacing=%"pI
"d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1644 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1646 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1647 p
+= sprintf (p
, ":scalable=true");
1649 p
+= sprintf (p
, ":scalable=false");
1654 /* Parse NAME (null terminated) and store information in FONT
1655 (font-spec or font-entity). If NAME is successfully parsed, return
1656 0. Otherwise return -1. */
1659 font_parse_name (char *name
, Lisp_Object font
)
1661 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1662 return font_parse_xlfd (name
, font
);
1663 return font_parse_fcname (name
, font
);
1667 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1668 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1672 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1678 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1680 CHECK_STRING (family
);
1681 len
= SBYTES (family
);
1682 p0
= SSDATA (family
);
1683 p1
= strchr (p0
, '-');
1686 if ((*p0
!= '*' && p1
- p0
> 0)
1687 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1688 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1691 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1694 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1696 if (! NILP (registry
))
1698 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1699 CHECK_STRING (registry
);
1700 len
= SBYTES (registry
);
1701 p0
= SSDATA (registry
);
1702 p1
= strchr (p0
, '-');
1705 if (SDATA (registry
)[len
- 1] == '*')
1706 registry
= concat2 (registry
, build_string ("-*"));
1708 registry
= concat2 (registry
, build_string ("*-*"));
1710 registry
= Fdowncase (registry
);
1711 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1716 /* This part (through the next ^L) is still experimental and not
1717 tested much. We may drastically change codes. */
1723 #define LGSTRING_HEADER_SIZE 6
1724 #define LGSTRING_GLYPH_SIZE 8
1727 check_gstring (gstring
)
1728 Lisp_Object gstring
;
1733 CHECK_VECTOR (gstring
);
1734 val
= AREF (gstring
, 0);
1736 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1738 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1739 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1740 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1741 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1742 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1743 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1744 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1745 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1746 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1747 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1748 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1750 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1752 val
= LGSTRING_GLYPH (gstring
, i
);
1754 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1756 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1758 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1759 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1760 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1761 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1762 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1763 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1764 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1765 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1767 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1769 if (ASIZE (val
) < 3)
1771 for (j
= 0; j
< 3; j
++)
1772 CHECK_NUMBER (AREF (val
, j
));
1777 error ("Invalid glyph-string format");
1782 check_otf_features (otf_features
)
1783 Lisp_Object otf_features
;
1787 CHECK_CONS (otf_features
);
1788 CHECK_SYMBOL (XCAR (otf_features
));
1789 otf_features
= XCDR (otf_features
);
1790 CHECK_CONS (otf_features
);
1791 CHECK_SYMBOL (XCAR (otf_features
));
1792 otf_features
= XCDR (otf_features
);
1793 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1795 CHECK_SYMBOL (Fcar (val
));
1796 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1797 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1799 otf_features
= XCDR (otf_features
);
1800 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1802 CHECK_SYMBOL (Fcar (val
));
1803 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1804 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1811 Lisp_Object otf_list
;
1814 otf_tag_symbol (tag
)
1819 OTF_tag_name (tag
, name
);
1820 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1827 Lisp_Object val
= Fassoc (file
, otf_list
);
1831 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1834 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1835 val
= make_save_value (otf
, 0);
1836 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1842 /* Return a list describing which scripts/languages FONT supports by
1843 which GSUB/GPOS features of OpenType tables. See the comment of
1844 (struct font_driver).otf_capability. */
1847 font_otf_capability (font
)
1851 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1854 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1857 for (i
= 0; i
< 2; i
++)
1859 OTF_GSUB_GPOS
*gsub_gpos
;
1860 Lisp_Object script_list
= Qnil
;
1863 if (OTF_get_features (otf
, i
== 0) < 0)
1865 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1866 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1868 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1869 Lisp_Object langsys_list
= Qnil
;
1870 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1873 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1875 OTF_LangSys
*langsys
;
1876 Lisp_Object feature_list
= Qnil
;
1877 Lisp_Object langsys_tag
;
1880 if (k
== script
->LangSysCount
)
1882 langsys
= &script
->DefaultLangSys
;
1887 langsys
= script
->LangSys
+ k
;
1889 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1891 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1893 OTF_Feature
*feature
1894 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1895 Lisp_Object feature_tag
1896 = otf_tag_symbol (feature
->FeatureTag
);
1898 feature_list
= Fcons (feature_tag
, feature_list
);
1900 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1903 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1908 XSETCAR (capability
, script_list
);
1910 XSETCDR (capability
, script_list
);
1916 /* Parse OTF features in SPEC and write a proper features spec string
1917 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1918 assured that the sufficient memory has already allocated for
1922 generate_otf_features (spec
, features
)
1932 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1938 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1943 else if (! asterisk
)
1945 val
= SYMBOL_NAME (val
);
1946 p
+= sprintf (p
, "%s", SDATA (val
));
1950 val
= SYMBOL_NAME (val
);
1951 p
+= sprintf (p
, "~%s", SDATA (val
));
1955 error ("OTF spec too long");
1959 font_otf_DeviceTable (device_table
)
1960 OTF_DeviceTable
*device_table
;
1962 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1964 return Fcons (make_number (len
),
1965 make_unibyte_string (device_table
->DeltaValue
, len
));
1969 font_otf_ValueRecord (value_format
, value_record
)
1971 OTF_ValueRecord
*value_record
;
1973 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1975 if (value_format
& OTF_XPlacement
)
1976 ASET (val
, 0, make_number (value_record
->XPlacement
));
1977 if (value_format
& OTF_YPlacement
)
1978 ASET (val
, 1, make_number (value_record
->YPlacement
));
1979 if (value_format
& OTF_XAdvance
)
1980 ASET (val
, 2, make_number (value_record
->XAdvance
));
1981 if (value_format
& OTF_YAdvance
)
1982 ASET (val
, 3, make_number (value_record
->YAdvance
));
1983 if (value_format
& OTF_XPlaDevice
)
1984 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1985 if (value_format
& OTF_YPlaDevice
)
1986 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1987 if (value_format
& OTF_XAdvDevice
)
1988 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1989 if (value_format
& OTF_YAdvDevice
)
1990 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1995 font_otf_Anchor (anchor
)
2000 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2001 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2002 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2003 if (anchor
->AnchorFormat
== 2)
2004 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2007 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2008 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2012 #endif /* HAVE_LIBOTF */
2018 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2019 static int font_compare (const void *, const void *);
2020 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2024 font_rescale_ratio (Lisp_Object font_entity
)
2026 Lisp_Object tail
, elt
;
2027 Lisp_Object name
= Qnil
;
2029 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2032 if (FLOATP (XCDR (elt
)))
2034 if (STRINGP (XCAR (elt
)))
2037 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2038 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2039 return XFLOAT_DATA (XCDR (elt
));
2041 else if (FONT_SPEC_P (XCAR (elt
)))
2043 if (font_match_p (XCAR (elt
), font_entity
))
2044 return XFLOAT_DATA (XCDR (elt
));
2051 /* We sort fonts by scoring each of them against a specified
2052 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2053 the value is, the closer the font is to the font-spec.
2055 The lowest 2 bits of the score is used for driver type. The font
2056 available by the most preferred font driver is 0.
2058 Each 7-bit in the higher 28 bits are used for numeric properties
2059 WEIGHT, SLANT, WIDTH, and SIZE. */
2061 /* How many bits to shift to store the difference value of each font
2062 property in a score. Note that flots for FONT_TYPE_INDEX and
2063 FONT_REGISTRY_INDEX are not used. */
2064 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2066 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2067 The return value indicates how different ENTITY is compared with
2071 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2076 /* Score three style numeric fields. Maximum difference is 127. */
2077 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2078 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2080 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2081 - (XINT (spec_prop
[i
]) >> 8));
2084 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2087 /* Score the size. Maximum difference is 127. */
2088 i
= FONT_SIZE_INDEX
;
2089 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2090 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2092 /* We use the higher 6-bit for the actual size difference. The
2093 lowest bit is set if the DPI is different. */
2095 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2097 if (CONSP (Vface_font_rescale_alist
))
2098 pixel_size
*= font_rescale_ratio (entity
);
2099 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2103 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2104 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2106 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2107 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2109 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2116 /* Concatenate all elements of LIST into one vector. LIST is a list
2117 of font-entity vectors. */
2120 font_vconcat_entity_vectors (Lisp_Object list
)
2122 int nargs
= XINT (Flength (list
));
2123 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2126 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2127 args
[i
] = XCAR (list
);
2128 return Fvconcat (nargs
, args
);
2132 /* The structure for elements being sorted by qsort. */
2133 struct font_sort_data
2136 int font_driver_preference
;
2141 /* The comparison function for qsort. */
2144 font_compare (const void *d1
, const void *d2
)
2146 const struct font_sort_data
*data1
= d1
;
2147 const struct font_sort_data
*data2
= d2
;
2149 if (data1
->score
< data2
->score
)
2151 else if (data1
->score
> data2
->score
)
2153 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2157 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2158 If PREFER specifies a point-size, calculate the corresponding
2159 pixel-size from QCdpi property of PREFER or from the Y-resolution
2160 of FRAME before sorting.
2162 If BEST-ONLY is nonzero, return the best matching entity (that
2163 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2164 if BEST-ONLY is negative). Otherwise, return the sorted result as
2165 a single vector of font-entities.
2167 This function does no optimization for the case that the total
2168 number of elements is 1. The caller should avoid calling this in
2172 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2174 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2176 struct font_sort_data
*data
;
2177 unsigned best_score
;
2178 Lisp_Object best_entity
;
2179 struct frame
*f
= XFRAME (frame
);
2180 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2183 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2184 prefer_prop
[i
] = AREF (prefer
, i
);
2185 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2186 prefer_prop
[FONT_SIZE_INDEX
]
2187 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2189 if (NILP (XCDR (list
)))
2191 /* What we have to take care of is this single vector. */
2193 maxlen
= ASIZE (vec
);
2197 /* We don't have to perform sort, so there's no need of creating
2198 a single vector. But, we must find the length of the longest
2201 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2202 if (maxlen
< ASIZE (XCAR (tail
)))
2203 maxlen
= ASIZE (XCAR (tail
));
2207 /* We have to create a single vector to sort it. */
2208 vec
= font_vconcat_entity_vectors (list
);
2209 maxlen
= ASIZE (vec
);
2212 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2213 best_score
= 0xFFFFFFFF;
2216 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2218 int font_driver_preference
= 0;
2219 Lisp_Object current_font_driver
;
2225 /* We are sure that the length of VEC > 0. */
2226 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2227 /* Score the elements. */
2228 for (i
= 0; i
< len
; i
++)
2230 data
[i
].entity
= AREF (vec
, i
);
2232 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2234 ? font_score (data
[i
].entity
, prefer_prop
)
2236 if (best_only
&& best_score
> data
[i
].score
)
2238 best_score
= data
[i
].score
;
2239 best_entity
= data
[i
].entity
;
2240 if (best_score
== 0)
2243 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2245 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2246 font_driver_preference
++;
2248 data
[i
].font_driver_preference
= font_driver_preference
;
2251 /* Sort if necessary. */
2254 qsort (data
, len
, sizeof *data
, font_compare
);
2255 for (i
= 0; i
< len
; i
++)
2256 ASET (vec
, i
, data
[i
].entity
);
2265 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2270 /* API of Font Service Layer. */
2272 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2273 sort_shift_bits. Finternal_set_font_selection_order calls this
2274 function with font_sort_order after setting up it. */
2277 font_update_sort_order (int *order
)
2281 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2283 int xlfd_idx
= order
[i
];
2285 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2286 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2287 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2288 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2289 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2290 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2292 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2297 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2302 table
= assq_no_quit (script
, table
);
2305 table
= XCDR (table
);
2306 if (! NILP (langsys
))
2308 table
= assq_no_quit (langsys
, table
);
2314 val
= assq_no_quit (Qnil
, table
);
2316 table
= XCAR (table
);
2320 table
= XCDR (table
);
2321 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2323 if (NILP (XCAR (features
)))
2328 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2334 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2337 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2339 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2341 script
= XCAR (spec
);
2345 langsys
= XCAR (spec
);
2356 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2357 XCAR (otf_capability
)))
2359 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2360 XCDR (otf_capability
)))
2367 /* Check if FONT (font-entity or font-object) matches with the font
2368 specification SPEC. */
2371 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2373 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2374 Lisp_Object extra
, font_extra
;
2377 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2378 if (! NILP (AREF (spec
, i
))
2379 && ! NILP (AREF (font
, i
))
2380 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2382 props
= XFONT_SPEC (spec
)->props
;
2383 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2385 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2386 prop
[i
] = AREF (spec
, i
);
2387 prop
[FONT_SIZE_INDEX
]
2388 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2392 if (font_score (font
, props
) > 0)
2394 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2395 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2396 for (; CONSP (extra
); extra
= XCDR (extra
))
2398 Lisp_Object key
= XCAR (XCAR (extra
));
2399 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2401 if (EQ (key
, QClang
))
2403 val2
= assq_no_quit (key
, font_extra
);
2412 if (NILP (Fmemq (val
, val2
)))
2417 ? NILP (Fmemq (val
, XCDR (val2
)))
2421 else if (EQ (key
, QCscript
))
2423 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2429 /* All characters in the list must be supported. */
2430 for (; CONSP (val2
); val2
= XCDR (val2
))
2432 if (! NATNUMP (XCAR (val2
)))
2434 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2435 == FONT_INVALID_CODE
)
2439 else if (VECTORP (val2
))
2441 /* At most one character in the vector must be supported. */
2442 for (i
= 0; i
< ASIZE (val2
); i
++)
2444 if (! NATNUMP (AREF (val2
, i
)))
2446 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2447 != FONT_INVALID_CODE
)
2450 if (i
== ASIZE (val2
))
2455 else if (EQ (key
, QCotf
))
2459 if (! FONT_OBJECT_P (font
))
2461 fontp
= XFONT_OBJECT (font
);
2462 if (! fontp
->driver
->otf_capability
)
2464 val2
= fontp
->driver
->otf_capability (fontp
);
2465 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2476 Each font backend has the callback function get_cache, and it
2477 returns a cons cell of which cdr part can be freely used for
2478 caching fonts. The cons cell may be shared by multiple frames
2479 and/or multiple font drivers. So, we arrange the cdr part as this:
2481 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2483 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2484 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2485 cons (FONT-SPEC FONT-ENTITY ...). */
2487 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2488 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2489 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2490 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2491 struct font_driver
*);
2494 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2496 Lisp_Object cache
, val
;
2498 cache
= driver
->get_cache (f
);
2500 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2504 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2505 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2509 val
= XCDR (XCAR (val
));
2510 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2516 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2518 Lisp_Object cache
, val
, tmp
;
2521 cache
= driver
->get_cache (f
);
2523 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2524 cache
= val
, val
= XCDR (val
);
2525 font_assert (! NILP (val
));
2526 tmp
= XCDR (XCAR (val
));
2527 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2528 if (XINT (XCAR (tmp
)) == 0)
2530 font_clear_cache (f
, XCAR (val
), driver
);
2531 XSETCDR (cache
, XCDR (val
));
2537 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2539 Lisp_Object val
= driver
->get_cache (f
);
2540 Lisp_Object type
= driver
->type
;
2542 font_assert (CONSP (val
));
2543 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2544 font_assert (CONSP (val
));
2545 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2546 val
= XCDR (XCAR (val
));
2550 static int num_fonts
;
2553 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2555 Lisp_Object tail
, elt
;
2556 Lisp_Object tail2
, entity
;
2558 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2559 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2562 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2563 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2565 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2567 entity
= XCAR (tail2
);
2569 if (FONT_ENTITY_P (entity
)
2570 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2572 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2574 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2576 Lisp_Object val
= XCAR (objlist
);
2577 struct font
*font
= XFONT_OBJECT (val
);
2579 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2581 font_assert (font
&& driver
== font
->driver
);
2582 driver
->close (f
, font
);
2586 if (driver
->free_entity
)
2587 driver
->free_entity (entity
);
2592 XSETCDR (cache
, Qnil
);
2596 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2598 /* Check each font-entity in VEC, and return a list of font-entities
2599 that satisfy this condition:
2600 (1) matches with SPEC and SIZE if SPEC is not nil, and
2601 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2605 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2607 Lisp_Object entity
, val
;
2608 enum font_property_index prop
;
2611 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2613 entity
= AREF (vec
, i
);
2614 if (! NILP (Vface_ignored_fonts
))
2617 Lisp_Object tail
, regexp
;
2619 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2621 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2623 regexp
= XCAR (tail
);
2624 if (STRINGP (regexp
)
2625 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2634 val
= Fcons (entity
, val
);
2637 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2638 if (INTEGERP (AREF (spec
, prop
))
2639 && ((XINT (AREF (spec
, prop
)) >> 8)
2640 != (XINT (AREF (entity
, prop
)) >> 8)))
2641 prop
= FONT_SPEC_MAX
;
2642 if (prop
< FONT_SPEC_MAX
2644 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2646 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2649 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2650 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2651 prop
= FONT_SPEC_MAX
;
2653 if (prop
< FONT_SPEC_MAX
2654 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2655 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2656 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2657 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2658 prop
= FONT_SPEC_MAX
;
2659 if (prop
< FONT_SPEC_MAX
2660 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2661 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2662 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2663 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2664 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2665 prop
= FONT_SPEC_MAX
;
2666 if (prop
< FONT_SPEC_MAX
)
2667 val
= Fcons (entity
, val
);
2669 return (Fvconcat (1, &val
));
2673 /* Return a list of vectors of font-entities matching with SPEC on
2674 FRAME. Each elements in the list is a vector of entities from the
2675 same font-driver. */
2678 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2680 FRAME_PTR f
= XFRAME (frame
);
2681 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2682 Lisp_Object ftype
, val
;
2683 Lisp_Object list
= Qnil
;
2685 int need_filtering
= 0;
2688 font_assert (FONT_SPEC_P (spec
));
2690 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2691 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2692 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2693 size
= font_pixel_size (f
, spec
);
2697 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2698 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2699 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2700 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2701 if (i
!= FONT_SPACING_INDEX
)
2703 ASET (scratch_font_spec
, i
, Qnil
);
2704 if (! NILP (AREF (spec
, i
)))
2707 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2708 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2710 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2712 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2714 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2716 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2717 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2724 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2728 val
= Fvconcat (1, &val
);
2729 copy
= copy_font_spec (scratch_font_spec
);
2730 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2731 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2735 || ! NILP (Vface_ignored_fonts
)))
2736 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2737 if (ASIZE (val
) > 0)
2738 list
= Fcons (val
, list
);
2741 list
= Fnreverse (list
);
2742 FONT_ADD_LOG ("list", spec
, list
);
2747 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2748 nil, is an array of face's attributes, which specifies preferred
2749 font-related attributes. */
2752 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2754 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2755 Lisp_Object ftype
, size
, entity
;
2757 Lisp_Object work
= copy_font_spec (spec
);
2759 XSETFRAME (frame
, f
);
2760 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2761 size
= AREF (spec
, FONT_SIZE_INDEX
);
2764 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2765 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2766 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2767 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2770 for (; driver_list
; driver_list
= driver_list
->next
)
2772 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2774 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2777 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2778 entity
= assoc_no_quit (work
, XCDR (cache
));
2780 entity
= XCDR (entity
);
2783 entity
= driver_list
->driver
->match (frame
, work
);
2784 copy
= copy_font_spec (work
);
2785 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2786 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2788 if (! NILP (entity
))
2791 FONT_ADD_LOG ("match", work
, entity
);
2796 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2797 opened font object. */
2800 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2802 struct font_driver_list
*driver_list
;
2803 Lisp_Object objlist
, size
, val
, font_object
;
2805 int min_width
, height
;
2806 int scaled_pixel_size
= pixel_size
;
2808 font_assert (FONT_ENTITY_P (entity
));
2809 size
= AREF (entity
, FONT_SIZE_INDEX
);
2810 if (XINT (size
) != 0)
2811 scaled_pixel_size
= pixel_size
= XINT (size
);
2812 else if (CONSP (Vface_font_rescale_alist
))
2813 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2815 val
= AREF (entity
, FONT_TYPE_INDEX
);
2816 for (driver_list
= f
->font_driver_list
;
2817 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2818 driver_list
= driver_list
->next
);
2822 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2823 objlist
= XCDR (objlist
))
2825 Lisp_Object fn
= XCAR (objlist
);
2826 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2827 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2829 if (driver_list
->driver
->cached_font_ok
== NULL
2830 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2835 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2836 if (!NILP (font_object
))
2837 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2838 FONT_ADD_LOG ("open", entity
, font_object
);
2839 if (NILP (font_object
))
2841 ASET (entity
, FONT_OBJLIST_INDEX
,
2842 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2845 font
= XFONT_OBJECT (font_object
);
2846 min_width
= (font
->min_width
? font
->min_width
2847 : font
->average_width
? font
->average_width
2848 : font
->space_width
? font
->space_width
2850 height
= (font
->height
? font
->height
: 1);
2851 #ifdef HAVE_WINDOW_SYSTEM
2852 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2853 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2855 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2856 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2857 fonts_changed_p
= 1;
2861 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2862 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2863 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2864 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2872 /* Close FONT_OBJECT that is opened on frame F. */
2875 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2877 struct font
*font
= XFONT_OBJECT (font_object
);
2879 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2880 /* Already closed. */
2882 FONT_ADD_LOG ("close", font_object
, Qnil
);
2883 font
->driver
->close (f
, font
);
2884 #ifdef HAVE_WINDOW_SYSTEM
2885 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2886 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2892 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2893 FONT is a font-entity and it must be opened to check. */
2896 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2900 if (FONT_ENTITY_P (font
))
2902 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2903 struct font_driver_list
*driver_list
;
2905 for (driver_list
= f
->font_driver_list
;
2906 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2907 driver_list
= driver_list
->next
);
2910 if (! driver_list
->driver
->has_char
)
2912 return driver_list
->driver
->has_char (font
, c
);
2915 font_assert (FONT_OBJECT_P (font
));
2916 fontp
= XFONT_OBJECT (font
);
2917 if (fontp
->driver
->has_char
)
2919 int result
= fontp
->driver
->has_char (font
, c
);
2924 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2928 /* Return the glyph ID of FONT_OBJECT for character C. */
2931 font_encode_char (Lisp_Object font_object
, int c
)
2935 font_assert (FONT_OBJECT_P (font_object
));
2936 font
= XFONT_OBJECT (font_object
);
2937 return font
->driver
->encode_char (font
, c
);
2941 /* Return the name of FONT_OBJECT. */
2944 font_get_name (Lisp_Object font_object
)
2946 font_assert (FONT_OBJECT_P (font_object
));
2947 return AREF (font_object
, FONT_NAME_INDEX
);
2951 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2952 could not be parsed by font_parse_name, return Qnil. */
2955 font_spec_from_name (Lisp_Object font_name
)
2957 Lisp_Object spec
= Ffont_spec (0, NULL
);
2959 CHECK_STRING (font_name
);
2960 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2962 font_put_extra (spec
, QCname
, font_name
);
2963 font_put_extra (spec
, QCuser_spec
, font_name
);
2969 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2971 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2976 if (! NILP (Ffont_get (font
, QCname
)))
2978 font
= copy_font_spec (font
);
2979 font_put_extra (font
, QCname
, Qnil
);
2982 if (NILP (AREF (font
, prop
))
2983 && prop
!= FONT_FAMILY_INDEX
2984 && prop
!= FONT_FOUNDRY_INDEX
2985 && prop
!= FONT_WIDTH_INDEX
2986 && prop
!= FONT_SIZE_INDEX
)
2988 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
2989 font
= copy_font_spec (font
);
2990 ASET (font
, prop
, Qnil
);
2991 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2993 if (prop
== FONT_FAMILY_INDEX
)
2995 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2996 /* If we are setting the font family, we must also clear
2997 FONT_WIDTH_INDEX to avoid rejecting families that lack
2998 support for some widths. */
2999 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3001 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3002 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3003 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3004 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3005 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3006 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3008 else if (prop
== FONT_SIZE_INDEX
)
3010 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3011 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3012 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3014 else if (prop
== FONT_WIDTH_INDEX
)
3015 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3016 attrs
[LFACE_FONT_INDEX
] = font
;
3019 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3020 supports C and matches best with ATTRS and PIXEL_SIZE. */
3023 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3025 Lisp_Object font_entity
;
3028 FRAME_PTR f
= XFRAME (frame
);
3030 if (NILP (XCDR (entities
))
3031 && ASIZE (XCAR (entities
)) == 1)
3033 font_entity
= AREF (XCAR (entities
), 0);
3035 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3040 /* Sort fonts by properties specified in ATTRS. */
3041 prefer
= scratch_font_prefer
;
3043 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3044 ASET (prefer
, i
, Qnil
);
3045 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3047 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3049 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3050 ASET (prefer
, i
, AREF (face_font
, i
));
3052 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3053 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3054 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3055 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3056 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3057 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3058 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3060 return font_sort_entities (entities
, prefer
, frame
, c
);
3063 /* Return a font-entity satisfying SPEC and best matching with face's
3064 font related attributes in ATTRS. C, if not negative, is a
3065 character that the entity must support. */
3068 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3071 Lisp_Object frame
, entities
, val
;
3072 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3076 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3077 if (NILP (registry
[0]))
3079 registry
[0] = DEFAULT_ENCODING
;
3080 registry
[1] = Qascii_0
;
3081 registry
[2] = null_vector
;
3084 registry
[1] = null_vector
;
3086 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3088 struct charset
*encoding
, *repertory
;
3090 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3091 &encoding
, &repertory
) < 0)
3094 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3096 else if (c
> encoding
->max_char
)
3100 work
= copy_font_spec (spec
);
3101 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3102 XSETFRAME (frame
, f
);
3103 pixel_size
= font_pixel_size (f
, spec
);
3104 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3106 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3108 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3110 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3111 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3112 if (! NILP (foundry
[0]))
3113 foundry
[1] = null_vector
;
3114 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3116 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3117 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3119 foundry
[2] = null_vector
;
3122 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3124 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3125 if (! NILP (adstyle
[0]))
3126 adstyle
[1] = null_vector
;
3127 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3129 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3131 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3133 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3135 adstyle
[2] = null_vector
;
3138 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3141 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3144 val
= AREF (work
, FONT_FAMILY_INDEX
);
3145 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3147 val
= attrs
[LFACE_FAMILY_INDEX
];
3148 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3152 family
= alloca ((sizeof family
[0]) * 2);
3154 family
[1] = null_vector
; /* terminator. */
3159 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3160 /* Font family names are case-sensitive under NS. */
3168 if (! NILP (alters
))
3170 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3171 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3172 family
[i
] = XCAR (alters
);
3173 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3175 family
[i
] = null_vector
;
3179 family
= alloca ((sizeof family
[0]) * 3);
3182 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3184 family
[i
] = null_vector
;
3188 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3190 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3191 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3193 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3194 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3196 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3197 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3199 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3200 entities
= font_list_entities (frame
, work
);
3201 if (! NILP (entities
))
3203 val
= font_select_entity (frame
, entities
,
3204 attrs
, pixel_size
, c
);
3217 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3221 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3222 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3223 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3224 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3225 size
= font_pixel_size (f
, spec
);
3229 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3230 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3233 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3234 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3235 if (INTEGERP (height
))
3238 abort(); /* We should never end up here. */
3242 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3246 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3247 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3251 return font_open_entity (f
, entity
, size
);
3255 /* Find a font satisfying SPEC and best matching with face's
3256 attributes in ATTRS on FRAME, and return the opened
3260 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3262 Lisp_Object entity
, name
;
3264 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3267 /* No font is listed for SPEC, but each font-backend may have
3268 the different criteria about "font matching". So, try
3270 entity
= font_matching_entity (f
, attrs
, spec
);
3274 /* Don't lose the original name that was put in initially. We need
3275 it to re-apply the font when font parameters (like hinting or dpi) have
3277 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3280 name
= Ffont_get (spec
, QCuser_spec
);
3281 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3287 /* Make FACE on frame F ready to use the font opened for FACE. */
3290 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3292 if (face
->font
->driver
->prepare_face
)
3293 face
->font
->driver
->prepare_face (f
, face
);
3297 /* Make FACE on frame F stop using the font opened for FACE. */
3300 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3302 if (face
->font
->driver
->done_face
)
3303 face
->font
->driver
->done_face (f
, face
);
3308 /* Open a font matching with font-spec SPEC on frame F. If no proper
3309 font is found, return Qnil. */
3312 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3314 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3316 /* We set up the default font-related attributes of a face to prefer
3318 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3319 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3320 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3322 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3324 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3326 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3328 return font_load_for_lface (f
, attrs
, spec
);
3332 /* Open a font matching with NAME on frame F. If no proper font is
3333 found, return Qnil. */
3336 font_open_by_name (FRAME_PTR f
, const char *name
)
3338 Lisp_Object args
[2];
3339 Lisp_Object spec
, ret
;
3342 args
[1] = make_unibyte_string (name
, strlen (name
));
3343 spec
= Ffont_spec (2, args
);
3344 ret
= font_open_by_spec (f
, spec
);
3345 /* Do not lose name originally put in. */
3347 font_put_extra (ret
, QCuser_spec
, args
[1]);
3353 /* Register font-driver DRIVER. This function is used in two ways.
3355 The first is with frame F non-NULL. In this case, make DRIVER
3356 available (but not yet activated) on F. All frame creaters
3357 (e.g. Fx_create_frame) must call this function at least once with
3358 an available font-driver.
3360 The second is with frame F NULL. In this case, DRIVER is globally
3361 registered in the variable `font_driver_list'. All font-driver
3362 implementations must call this function in its syms_of_XXXX
3363 (e.g. syms_of_xfont). */
3366 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3368 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3369 struct font_driver_list
*prev
, *list
;
3371 if (f
&& ! driver
->draw
)
3372 error ("Unusable font driver for a frame: %s",
3373 SDATA (SYMBOL_NAME (driver
->type
)));
3375 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3376 if (EQ (list
->driver
->type
, driver
->type
))
3377 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3379 list
= xmalloc (sizeof (struct font_driver_list
));
3381 list
->driver
= driver
;
3386 f
->font_driver_list
= list
;
3388 font_driver_list
= list
;
3394 free_font_driver_list (FRAME_PTR f
)
3396 struct font_driver_list
*list
, *next
;
3398 for (list
= f
->font_driver_list
; list
; list
= next
)
3403 f
->font_driver_list
= NULL
;
3407 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3408 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3409 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3411 A caller must free all realized faces if any in advance. The
3412 return value is a list of font backends actually made used on
3416 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3418 Lisp_Object active_drivers
= Qnil
;
3419 struct font_driver_list
*list
;
3421 /* At first, turn off non-requested drivers, and turn on requested
3423 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3425 struct font_driver
*driver
= list
->driver
;
3426 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3431 if (driver
->end_for_frame
)
3432 driver
->end_for_frame (f
);
3433 font_finish_cache (f
, driver
);
3438 if (! driver
->start_for_frame
3439 || driver
->start_for_frame (f
) == 0)
3441 font_prepare_cache (f
, driver
);
3448 if (NILP (new_drivers
))
3451 if (! EQ (new_drivers
, Qt
))
3453 /* Re-order the driver list according to new_drivers. */
3454 struct font_driver_list
**list_table
, **next
;
3458 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3459 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3461 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3462 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3465 list_table
[i
++] = list
;
3467 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3469 list_table
[i
++] = list
;
3470 list_table
[i
] = NULL
;
3472 next
= &f
->font_driver_list
;
3473 for (i
= 0; list_table
[i
]; i
++)
3475 *next
= list_table
[i
];
3476 next
= &(*next
)->next
;
3480 if (! f
->font_driver_list
->on
)
3481 { /* None of the drivers is enabled: enable them all.
3482 Happens if you set the list of drivers to (xft x) in your .emacs
3483 and then use it under w32 or ns. */
3484 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3486 struct font_driver
*driver
= list
->driver
;
3487 eassert (! list
->on
);
3488 if (! driver
->start_for_frame
3489 || driver
->start_for_frame (f
) == 0)
3491 font_prepare_cache (f
, driver
);
3498 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3500 active_drivers
= nconc2 (active_drivers
,
3501 Fcons (list
->driver
->type
, Qnil
));
3502 return active_drivers
;
3506 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3508 struct font_data_list
*list
, *prev
;
3510 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3511 prev
= list
, list
= list
->next
)
3512 if (list
->driver
== driver
)
3519 prev
->next
= list
->next
;
3521 f
->font_data_list
= list
->next
;
3529 list
= xmalloc (sizeof (struct font_data_list
));
3530 list
->driver
= driver
;
3531 list
->next
= f
->font_data_list
;
3532 f
->font_data_list
= list
;
3540 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3542 struct font_data_list
*list
;
3544 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3545 if (list
->driver
== driver
)
3553 /* Sets attributes on a font. Any properties that appear in ALIST and
3554 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3555 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3556 arrays of strings. This function is intended for use by the font
3557 drivers to implement their specific font_filter_properties. */
3559 font_filter_properties (Lisp_Object font
,
3561 const char *const boolean_properties
[],
3562 const char *const non_boolean_properties
[])
3567 /* Set boolean values to Qt or Qnil */
3568 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3569 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3571 Lisp_Object key
= XCAR (XCAR (it
));
3572 Lisp_Object val
= XCDR (XCAR (it
));
3573 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3575 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3577 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3578 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3581 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3582 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3583 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3584 || strcmp ("Off", str
) == 0)
3589 Ffont_put (font
, key
, val
);
3593 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3594 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3596 Lisp_Object key
= XCAR (XCAR (it
));
3597 Lisp_Object val
= XCDR (XCAR (it
));
3598 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3599 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3600 Ffont_put (font
, key
, val
);
3605 /* Return the font used to draw character C by FACE at buffer position
3606 POS in window W. If STRING is non-nil, it is a string containing C
3607 at index POS. If C is negative, get C from the current buffer or
3611 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3616 Lisp_Object font_object
;
3618 multibyte
= (NILP (string
)
3619 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3620 : STRING_MULTIBYTE (string
));
3627 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3629 c
= FETCH_CHAR (pos_byte
);
3632 c
= FETCH_BYTE (pos
);
3638 multibyte
= STRING_MULTIBYTE (string
);
3641 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3643 str
= SDATA (string
) + pos_byte
;
3644 c
= STRING_CHAR (str
);
3647 c
= SDATA (string
)[pos
];
3651 f
= XFRAME (w
->frame
);
3652 if (! FRAME_WINDOW_P (f
))
3659 if (STRINGP (string
))
3660 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3661 DEFAULT_FACE_ID
, 0);
3663 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3665 face
= FACE_FROM_ID (f
, face_id
);
3669 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3670 face
= FACE_FROM_ID (f
, face_id
);
3675 XSETFONT (font_object
, face
->font
);
3680 #ifdef HAVE_WINDOW_SYSTEM
3682 /* Check how many characters after POS (at most to *LIMIT) can be
3683 displayed by the same font on the window W. FACE, if non-NULL, is
3684 the face selected for the character at POS. If STRING is not nil,
3685 it is the string to check instead of the current buffer. In that
3686 case, FACE must be not NULL.
3688 The return value is the font-object for the character at POS.
3689 *LIMIT is set to the position where that font can't be used.
3691 It is assured that the current buffer (or STRING) is multibyte. */
3694 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3696 EMACS_INT pos_byte
, ignore
;
3698 Lisp_Object font_object
= Qnil
;
3702 pos_byte
= CHAR_TO_BYTE (pos
);
3707 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3709 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3715 pos_byte
= string_char_to_byte (string
, pos
);
3718 while (pos
< *limit
)
3720 Lisp_Object category
;
3723 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3725 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3726 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3727 if (EQ (category
, QCf
)
3728 || CHAR_VARIATION_SELECTOR_P (c
))
3730 if (NILP (font_object
))
3732 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3733 if (NILP (font_object
))
3737 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3747 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3748 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3749 Return nil otherwise.
3750 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3751 which kind of font it is. It must be one of `font-spec', `font-entity',
3753 (Lisp_Object object
, Lisp_Object extra_type
)
3755 if (NILP (extra_type
))
3756 return (FONTP (object
) ? Qt
: Qnil
);
3757 if (EQ (extra_type
, Qfont_spec
))
3758 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3759 if (EQ (extra_type
, Qfont_entity
))
3760 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3761 if (EQ (extra_type
, Qfont_object
))
3762 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3763 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3766 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3767 doc
: /* Return a newly created font-spec with arguments as properties.
3769 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3770 valid font property name listed below:
3772 `:family', `:weight', `:slant', `:width'
3774 They are the same as face attributes of the same name. See
3775 `set-face-attribute'.
3779 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3783 VALUE must be a string or a symbol specifying the additional
3784 typographic style information of a font, e.g. ``sans''.
3788 VALUE must be a string or a symbol specifying the charset registry and
3789 encoding of a font, e.g. ``iso8859-1''.
3793 VALUE must be a non-negative integer or a floating point number
3794 specifying the font size. It specifies the font size in pixels (if
3795 VALUE is an integer), or in points (if VALUE is a float).
3799 VALUE must be a string of XLFD-style or fontconfig-style font name.
3803 VALUE must be a symbol representing a script that the font must
3804 support. It may be a symbol representing a subgroup of a script
3805 listed in the variable `script-representative-chars'.
3809 VALUE must be a symbol of two-letter ISO-639 language names,
3814 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3815 required OpenType features.
3817 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3818 LANGSYS-TAG: OpenType language system tag symbol,
3819 or nil for the default language system.
3820 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3821 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3823 GSUB and GPOS may contain `nil' element. In such a case, the font
3824 must not have any of the remaining elements.
3826 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3827 be an OpenType font, and whose GPOS table of `thai' script's default
3828 language system must contain `mark' feature.
3830 usage: (font-spec ARGS...) */)
3831 (size_t nargs
, Lisp_Object
*args
)
3833 Lisp_Object spec
= font_make_spec ();
3836 for (i
= 0; i
< nargs
; i
+= 2)
3838 Lisp_Object key
= args
[i
], val
;
3842 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3845 if (EQ (key
, QCname
))
3848 font_parse_name (SSDATA (val
), spec
);
3849 font_put_extra (spec
, key
, val
);
3853 int idx
= get_font_prop_index (key
);
3857 val
= font_prop_validate (idx
, Qnil
, val
);
3858 if (idx
< FONT_EXTRA_INDEX
)
3859 ASET (spec
, idx
, val
);
3861 font_put_extra (spec
, key
, val
);
3864 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3870 /* Return a copy of FONT as a font-spec. */
3872 copy_font_spec (Lisp_Object font
)
3874 Lisp_Object new_spec
, tail
, prev
, extra
;
3878 new_spec
= font_make_spec ();
3879 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3880 ASET (new_spec
, i
, AREF (font
, i
));
3881 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3882 /* We must remove :font-entity property. */
3883 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3884 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3887 extra
= XCDR (extra
);
3889 XSETCDR (prev
, XCDR (tail
));
3892 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3896 /* Merge font-specs FROM and TO, and return a new font-spec.
3897 Every specified property in FROM overrides the corresponding
3900 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3902 Lisp_Object extra
, tail
;
3907 to
= copy_font_spec (to
);
3908 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3909 ASET (to
, i
, AREF (from
, i
));
3910 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3911 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3912 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3914 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3917 XSETCDR (slot
, XCDR (XCAR (tail
)));
3919 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3921 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3925 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3926 doc
: /* Return the value of FONT's property KEY.
3927 FONT is a font-spec, a font-entity, or a font-object.
3928 KEY is any symbol, but these are reserved for specific meanings:
3929 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3930 :size, :name, :script, :otf
3931 See the documentation of `font-spec' for their meanings.
3932 In addition, if FONT is a font-entity or a font-object, values of
3933 :script and :otf are different from those of a font-spec as below:
3935 The value of :script may be a list of scripts that are supported by the font.
3937 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3938 representing the OpenType features supported by the font by this form:
3939 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3940 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3942 (Lisp_Object font
, Lisp_Object key
)
3950 idx
= get_font_prop_index (key
);
3951 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3952 return font_style_symbolic (font
, idx
, 0);
3953 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3954 return AREF (font
, idx
);
3955 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3956 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3958 struct font
*fontp
= XFONT_OBJECT (font
);
3960 if (fontp
->driver
->otf_capability
)
3961 val
= fontp
->driver
->otf_capability (fontp
);
3963 val
= Fcons (Qnil
, Qnil
);
3970 #ifdef HAVE_WINDOW_SYSTEM
3972 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3973 doc
: /* Return a plist of face attributes generated by FONT.
3974 FONT is a font name, a font-spec, a font-entity, or a font-object.
3975 The return value is a list of the form
3977 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3979 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3980 compatible with `set-face-attribute'. Some of these key-attribute pairs
3981 may be omitted from the list if they are not specified by FONT.
3983 The optional argument FRAME specifies the frame that the face attributes
3984 are to be displayed on. If omitted, the selected frame is used. */)
3985 (Lisp_Object font
, Lisp_Object frame
)
3988 Lisp_Object plist
[10];
3993 frame
= selected_frame
;
3994 CHECK_LIVE_FRAME (frame
);
3999 int fontset
= fs_query_fontset (font
, 0);
4000 Lisp_Object name
= font
;
4002 font
= fontset_ascii (fontset
);
4003 font
= font_spec_from_name (name
);
4005 signal_error ("Invalid font name", name
);
4007 else if (! FONTP (font
))
4008 signal_error ("Invalid font object", font
);
4010 val
= AREF (font
, FONT_FAMILY_INDEX
);
4013 plist
[n
++] = QCfamily
;
4014 plist
[n
++] = SYMBOL_NAME (val
);
4017 val
= AREF (font
, FONT_SIZE_INDEX
);
4020 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4021 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4022 plist
[n
++] = QCheight
;
4023 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4025 else if (FLOATP (val
))
4027 plist
[n
++] = QCheight
;
4028 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4031 val
= FONT_WEIGHT_FOR_FACE (font
);
4034 plist
[n
++] = QCweight
;
4038 val
= FONT_SLANT_FOR_FACE (font
);
4041 plist
[n
++] = QCslant
;
4045 val
= FONT_WIDTH_FOR_FACE (font
);
4048 plist
[n
++] = QCwidth
;
4052 return Flist (n
, plist
);
4057 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4058 doc
: /* Set one property of FONT: give property KEY value VAL.
4059 FONT is a font-spec, a font-entity, or a font-object.
4061 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4062 accepted by the function `font-spec' (which see), VAL must be what
4063 allowed in `font-spec'.
4065 If FONT is a font-entity or a font-object, KEY must not be the one
4066 accepted by `font-spec'. */)
4067 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4071 idx
= get_font_prop_index (prop
);
4072 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4074 CHECK_FONT_SPEC (font
);
4075 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4079 if (EQ (prop
, QCname
)
4080 || EQ (prop
, QCscript
)
4081 || EQ (prop
, QClang
)
4082 || EQ (prop
, QCotf
))
4083 CHECK_FONT_SPEC (font
);
4086 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4091 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4092 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4093 Optional 2nd argument FRAME specifies the target frame.
4094 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4095 Optional 4th argument PREFER, if non-nil, is a font-spec to
4096 control the order of the returned list. Fonts are sorted by
4097 how close they are to PREFER. */)
4098 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4100 Lisp_Object vec
, list
;
4104 frame
= selected_frame
;
4105 CHECK_LIVE_FRAME (frame
);
4106 CHECK_FONT_SPEC (font_spec
);
4114 if (! NILP (prefer
))
4115 CHECK_FONT_SPEC (prefer
);
4117 list
= font_list_entities (frame
, font_spec
);
4120 if (NILP (XCDR (list
))
4121 && ASIZE (XCAR (list
)) == 1)
4122 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4124 if (! NILP (prefer
))
4125 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4127 vec
= font_vconcat_entity_vectors (list
);
4128 if (n
== 0 || n
>= ASIZE (vec
))
4130 Lisp_Object args
[2];
4134 list
= Fappend (2, args
);
4138 for (list
= Qnil
, n
--; n
>= 0; n
--)
4139 list
= Fcons (AREF (vec
, n
), list
);
4144 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4145 doc
: /* List available font families on the current frame.
4146 Optional argument FRAME, if non-nil, specifies the target frame. */)
4150 struct font_driver_list
*driver_list
;
4154 frame
= selected_frame
;
4155 CHECK_LIVE_FRAME (frame
);
4158 for (driver_list
= f
->font_driver_list
; driver_list
;
4159 driver_list
= driver_list
->next
)
4160 if (driver_list
->driver
->list_family
)
4162 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4163 Lisp_Object tail
= list
;
4165 for (; CONSP (val
); val
= XCDR (val
))
4166 if (NILP (Fmemq (XCAR (val
), tail
))
4167 && SYMBOLP (XCAR (val
)))
4168 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4173 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4174 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4175 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4176 (Lisp_Object font_spec
, Lisp_Object frame
)
4178 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4185 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4186 doc
: /* Return XLFD name of FONT.
4187 FONT is a font-spec, font-entity, or font-object.
4188 If the name is too long for XLFD (maximum 255 chars), return nil.
4189 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4190 the consecutive wildcards are folded to one. */)
4191 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4198 if (FONT_OBJECT_P (font
))
4200 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4202 if (STRINGP (font_name
)
4203 && SDATA (font_name
)[0] == '-')
4205 if (NILP (fold_wildcards
))
4207 strcpy (name
, SSDATA (font_name
));
4210 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4212 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4215 if (! NILP (fold_wildcards
))
4217 char *p0
= name
, *p1
;
4219 while ((p1
= strstr (p0
, "-*-*")))
4221 strcpy (p1
, p1
+ 2);
4226 return build_string (name
);
4229 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4230 doc
: /* Clear font cache. */)
4233 Lisp_Object list
, frame
;
4235 FOR_EACH_FRAME (list
, frame
)
4237 FRAME_PTR f
= XFRAME (frame
);
4238 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4240 for (; driver_list
; driver_list
= driver_list
->next
)
4241 if (driver_list
->on
)
4243 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4244 Lisp_Object val
, tmp
;
4248 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4250 font_assert (! NILP (val
));
4251 tmp
= XCDR (XCAR (val
));
4252 if (XINT (XCAR (tmp
)) == 0)
4254 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4255 XSETCDR (cache
, XCDR (val
));
4265 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4267 struct font
*font
= XFONT_OBJECT (font_object
);
4269 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4270 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4271 struct font_metrics metrics
;
4273 LGLYPH_SET_CODE (glyph
, ecode
);
4275 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4276 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4277 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4278 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4279 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4280 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4284 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4285 doc
: /* Shape the glyph-string GSTRING.
4286 Shaping means substituting glyphs and/or adjusting positions of glyphs
4287 to get the correct visual image of character sequences set in the
4288 header of the glyph-string.
4290 If the shaping was successful, the value is GSTRING itself or a newly
4291 created glyph-string. Otherwise, the value is nil. */)
4292 (Lisp_Object gstring
)
4295 Lisp_Object font_object
, n
, glyph
;
4298 if (! composition_gstring_p (gstring
))
4299 signal_error ("Invalid glyph-string: ", gstring
);
4300 if (! NILP (LGSTRING_ID (gstring
)))
4302 font_object
= LGSTRING_FONT (gstring
);
4303 CHECK_FONT_OBJECT (font_object
);
4304 font
= XFONT_OBJECT (font_object
);
4305 if (! font
->driver
->shape
)
4308 /* Try at most three times with larger gstring each time. */
4309 for (i
= 0; i
< 3; i
++)
4311 n
= font
->driver
->shape (gstring
);
4314 gstring
= larger_vector (gstring
,
4315 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4318 if (i
== 3 || XINT (n
) == 0)
4320 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4321 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4323 glyph
= LGSTRING_GLYPH (gstring
, 0);
4324 from
= LGLYPH_FROM (glyph
);
4325 to
= LGLYPH_TO (glyph
);
4326 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4328 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4332 if (NILP (LGLYPH_ADJUSTMENT (this)))
4337 glyph
= LGSTRING_GLYPH (gstring
, j
);
4338 LGLYPH_SET_FROM (glyph
, from
);
4339 LGLYPH_SET_TO (glyph
, to
);
4341 from
= LGLYPH_FROM (this);
4342 to
= LGLYPH_TO (this);
4347 if (from
> LGLYPH_FROM (this))
4348 from
= LGLYPH_FROM (this);
4349 if (to
< LGLYPH_TO (this))
4350 to
= LGLYPH_TO (this);
4356 glyph
= LGSTRING_GLYPH (gstring
, j
);
4357 LGLYPH_SET_FROM (glyph
, from
);
4358 LGLYPH_SET_TO (glyph
, to
);
4360 return composition_gstring_put_cache (gstring
, XINT (n
));
4363 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4365 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4366 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4368 VARIATION-SELECTOR is a character code of variation selection
4369 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4370 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4371 (Lisp_Object font_object
, Lisp_Object character
)
4373 unsigned variations
[256];
4378 CHECK_FONT_OBJECT (font_object
);
4379 CHECK_CHARACTER (character
);
4380 font
= XFONT_OBJECT (font_object
);
4381 if (! font
->driver
->get_variation_glyphs
)
4383 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4387 for (i
= 0; i
< 255; i
++)
4391 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4392 /* Stops GCC whining about limited range of data type. */
4393 EMACS_INT var
= variations
[i
];
4395 if (var
> MOST_POSITIVE_FIXNUM
)
4396 code
= Fcons (make_number ((variations
[i
]) >> 16),
4397 make_number ((variations
[i
]) & 0xFFFF));
4399 code
= make_number (variations
[i
]);
4400 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4407 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4408 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4409 OTF-FEATURES specifies which features to apply in this format:
4410 (SCRIPT LANGSYS GSUB GPOS)
4412 SCRIPT is a symbol specifying a script tag of OpenType,
4413 LANGSYS is a symbol specifying a langsys tag of OpenType,
4414 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4416 If LANGYS is nil, the default langsys is selected.
4418 The features are applied in the order they appear in the list. The
4419 symbol `*' means to apply all available features not present in this
4420 list, and the remaining features are ignored. For instance, (vatu
4421 pstf * haln) is to apply vatu and pstf in this order, then to apply
4422 all available features other than vatu, pstf, and haln.
4424 The features are applied to the glyphs in the range FROM and TO of
4425 the glyph-string GSTRING-IN.
4427 If some feature is actually applicable, the resulting glyphs are
4428 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4429 this case, the value is the number of produced glyphs.
4431 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4434 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4435 produced in GSTRING-OUT, and the value is nil.
4437 See the documentation of `font-make-gstring' for the format of
4439 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4441 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4446 check_otf_features (otf_features
);
4447 CHECK_FONT_OBJECT (font_object
);
4448 font
= XFONT_OBJECT (font_object
);
4449 if (! font
->driver
->otf_drive
)
4450 error ("Font backend %s can't drive OpenType GSUB table",
4451 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4452 CHECK_CONS (otf_features
);
4453 CHECK_SYMBOL (XCAR (otf_features
));
4454 val
= XCDR (otf_features
);
4455 CHECK_SYMBOL (XCAR (val
));
4456 val
= XCDR (otf_features
);
4459 len
= check_gstring (gstring_in
);
4460 CHECK_VECTOR (gstring_out
);
4461 CHECK_NATNUM (from
);
4463 CHECK_NATNUM (index
);
4465 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4466 args_out_of_range_3 (from
, to
, make_number (len
));
4467 if (XINT (index
) >= ASIZE (gstring_out
))
4468 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4469 num
= font
->driver
->otf_drive (font
, otf_features
,
4470 gstring_in
, XINT (from
), XINT (to
),
4471 gstring_out
, XINT (index
), 0);
4474 return make_number (num
);
4477 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4479 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4480 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4482 (SCRIPT LANGSYS FEATURE ...)
4483 See the documentation of `font-drive-otf' for more detail.
4485 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4486 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4487 character code corresponding to the glyph or nil if there's no
4488 corresponding character. */)
4489 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4492 Lisp_Object gstring_in
, gstring_out
, g
;
4493 Lisp_Object alternates
;
4496 CHECK_FONT_GET_OBJECT (font_object
, font
);
4497 if (! font
->driver
->otf_drive
)
4498 error ("Font backend %s can't drive OpenType GSUB table",
4499 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4500 CHECK_CHARACTER (character
);
4501 CHECK_CONS (otf_features
);
4503 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4504 g
= LGSTRING_GLYPH (gstring_in
, 0);
4505 LGLYPH_SET_CHAR (g
, XINT (character
));
4506 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4507 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4508 gstring_out
, 0, 1)) < 0)
4509 gstring_out
= Ffont_make_gstring (font_object
,
4510 make_number (ASIZE (gstring_out
) * 2));
4512 for (i
= 0; i
< num
; i
++)
4514 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4515 int c
= LGLYPH_CHAR (g
);
4516 unsigned code
= LGLYPH_CODE (g
);
4518 alternates
= Fcons (Fcons (make_number (code
),
4519 c
> 0 ? make_number (c
) : Qnil
),
4522 return Fnreverse (alternates
);
4528 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4529 doc
: /* Open FONT-ENTITY. */)
4530 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4534 CHECK_FONT_ENTITY (font_entity
);
4536 frame
= selected_frame
;
4537 CHECK_LIVE_FRAME (frame
);
4540 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4543 CHECK_NUMBER_OR_FLOAT (size
);
4545 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4547 isize
= XINT (size
);
4551 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4554 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4555 doc
: /* Close FONT-OBJECT. */)
4556 (Lisp_Object font_object
, Lisp_Object frame
)
4558 CHECK_FONT_OBJECT (font_object
);
4560 frame
= selected_frame
;
4561 CHECK_LIVE_FRAME (frame
);
4562 font_close_object (XFRAME (frame
), font_object
);
4566 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4567 doc
: /* Return information about FONT-OBJECT.
4568 The value is a vector:
4569 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4572 NAME is a string of the font name (or nil if the font backend doesn't
4575 FILENAME is a string of the font file (or nil if the font backend
4576 doesn't provide a file name).
4578 PIXEL-SIZE is a pixel size by which the font is opened.
4580 SIZE is a maximum advance width of the font in pixels.
4582 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4585 CAPABILITY is a list whose first element is a symbol representing the
4586 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4587 remaining elements describe the details of the font capability.
4589 If the font is OpenType font, the form of the list is
4590 \(opentype GSUB GPOS)
4591 where GSUB shows which "GSUB" features the font supports, and GPOS
4592 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4593 lists of the format:
4594 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4596 If the font is not OpenType font, currently the length of the form is
4599 SCRIPT is a symbol representing OpenType script tag.
4601 LANGSYS is a symbol representing OpenType langsys tag, or nil
4602 representing the default langsys.
4604 FEATURE is a symbol representing OpenType feature tag.
4606 If the font is not OpenType font, CAPABILITY is nil. */)
4607 (Lisp_Object font_object
)
4612 CHECK_FONT_GET_OBJECT (font_object
, font
);
4614 val
= Fmake_vector (make_number (9), Qnil
);
4615 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4616 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4617 ASET (val
, 2, make_number (font
->pixel_size
));
4618 ASET (val
, 3, make_number (font
->max_width
));
4619 ASET (val
, 4, make_number (font
->ascent
));
4620 ASET (val
, 5, make_number (font
->descent
));
4621 ASET (val
, 6, make_number (font
->space_width
));
4622 ASET (val
, 7, make_number (font
->average_width
));
4623 if (font
->driver
->otf_capability
)
4624 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4628 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4630 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4631 FROM and TO are positions (integers or markers) specifying a region
4632 of the current buffer.
4633 If the optional fourth arg OBJECT is not nil, it is a string or a
4634 vector containing the target characters.
4636 Each element is a vector containing information of a glyph in this format:
4637 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4639 FROM is an index numbers of a character the glyph corresponds to.
4640 TO is the same as FROM.
4641 C is the character of the glyph.
4642 CODE is the glyph-code of C in FONT-OBJECT.
4643 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4644 ADJUSTMENT is always nil.
4645 If FONT-OBJECT doesn't have a glyph for a character,
4646 the corresponding element is nil. */)
4647 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4652 Lisp_Object
*chars
, vec
;
4655 CHECK_FONT_GET_OBJECT (font_object
, font
);
4658 EMACS_INT charpos
, bytepos
;
4660 validate_region (&from
, &to
);
4663 len
= XFASTINT (to
) - XFASTINT (from
);
4664 SAFE_ALLOCA_LISP (chars
, len
);
4665 charpos
= XFASTINT (from
);
4666 bytepos
= CHAR_TO_BYTE (charpos
);
4667 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4670 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4671 chars
[i
] = make_number (c
);
4674 else if (STRINGP (object
))
4676 const unsigned char *p
;
4678 CHECK_NUMBER (from
);
4680 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4681 || XINT (to
) > SCHARS (object
))
4682 args_out_of_range_3 (object
, from
, to
);
4685 len
= XFASTINT (to
) - XFASTINT (from
);
4686 SAFE_ALLOCA_LISP (chars
, len
);
4688 if (STRING_MULTIBYTE (object
))
4689 for (i
= 0; i
< len
; i
++)
4691 int c
= STRING_CHAR_ADVANCE (p
);
4692 chars
[i
] = make_number (c
);
4695 for (i
= 0; i
< len
; i
++)
4696 chars
[i
] = make_number (p
[i
]);
4700 CHECK_VECTOR (object
);
4701 CHECK_NUMBER (from
);
4703 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4704 || XINT (to
) > ASIZE (object
))
4705 args_out_of_range_3 (object
, from
, to
);
4708 len
= XFASTINT (to
) - XFASTINT (from
);
4709 for (i
= 0; i
< len
; i
++)
4711 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4712 CHECK_CHARACTER (elt
);
4714 chars
= &(AREF (object
, XFASTINT (from
)));
4717 vec
= Fmake_vector (make_number (len
), Qnil
);
4718 for (i
= 0; i
< len
; i
++)
4721 int c
= XFASTINT (chars
[i
]);
4723 struct font_metrics metrics
;
4725 code
= font
->driver
->encode_char (font
, c
);
4726 if (code
== FONT_INVALID_CODE
)
4728 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4729 LGLYPH_SET_FROM (g
, i
);
4730 LGLYPH_SET_TO (g
, i
);
4731 LGLYPH_SET_CHAR (g
, c
);
4732 LGLYPH_SET_CODE (g
, code
);
4733 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4734 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4735 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4736 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4737 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4738 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4741 if (! VECTORP (object
))
4746 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4747 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4748 FONT is a font-spec, font-entity, or font-object. */)
4749 (Lisp_Object spec
, Lisp_Object font
)
4751 CHECK_FONT_SPEC (spec
);
4754 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4757 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4758 doc
: /* Return a font-object for displaying a character at POSITION.
4759 Optional second arg WINDOW, if non-nil, is a window displaying
4760 the current buffer. It defaults to the currently selected window. */)
4761 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4768 CHECK_NUMBER_COERCE_MARKER (position
);
4769 pos
= XINT (position
);
4770 if (pos
< BEGV
|| pos
>= ZV
)
4771 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4775 CHECK_NUMBER (position
);
4776 CHECK_STRING (string
);
4777 pos
= XINT (position
);
4778 if (pos
< 0 || pos
>= SCHARS (string
))
4779 args_out_of_range (string
, position
);
4782 window
= selected_window
;
4783 CHECK_LIVE_WINDOW (window
);
4784 w
= XWINDOW (window
);
4786 return font_at (-1, pos
, NULL
, w
, string
);
4790 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4791 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4792 The value is a number of glyphs drawn.
4793 Type C-l to recover what previously shown. */)
4794 (Lisp_Object font_object
, Lisp_Object string
)
4796 Lisp_Object frame
= selected_frame
;
4797 FRAME_PTR f
= XFRAME (frame
);
4803 CHECK_FONT_GET_OBJECT (font_object
, font
);
4804 CHECK_STRING (string
);
4805 len
= SCHARS (string
);
4806 code
= alloca (sizeof (unsigned) * len
);
4807 for (i
= 0; i
< len
; i
++)
4809 Lisp_Object ch
= Faref (string
, make_number (i
));
4813 code
[i
] = font
->driver
->encode_char (font
, c
);
4814 if (code
[i
] == FONT_INVALID_CODE
)
4817 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4819 if (font
->driver
->prepare_face
)
4820 font
->driver
->prepare_face (f
, face
);
4821 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4822 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4823 if (font
->driver
->done_face
)
4824 font
->driver
->done_face (f
, face
);
4826 return make_number (len
);
4830 #endif /* FONT_DEBUG */
4832 #ifdef HAVE_WINDOW_SYSTEM
4834 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4835 doc
: /* Return information about a font named NAME on frame FRAME.
4836 If FRAME is omitted or nil, use the selected frame.
4837 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4838 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4840 OPENED-NAME is the name used for opening the font,
4841 FULL-NAME is the full name of the font,
4842 SIZE is the pixelsize of the font,
4843 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4844 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4845 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4846 how to compose characters.
4847 If the named font is not yet loaded, return nil. */)
4848 (Lisp_Object name
, Lisp_Object frame
)
4853 Lisp_Object font_object
;
4855 (*check_window_system_func
) ();
4858 CHECK_STRING (name
);
4860 frame
= selected_frame
;
4861 CHECK_LIVE_FRAME (frame
);
4866 int fontset
= fs_query_fontset (name
, 0);
4869 name
= fontset_ascii (fontset
);
4870 font_object
= font_open_by_name (f
, SSDATA (name
));
4872 else if (FONT_OBJECT_P (name
))
4874 else if (FONT_ENTITY_P (name
))
4875 font_object
= font_open_entity (f
, name
, 0);
4878 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4879 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4881 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4883 if (NILP (font_object
))
4885 font
= XFONT_OBJECT (font_object
);
4887 info
= Fmake_vector (make_number (7), Qnil
);
4888 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4889 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4890 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4891 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4892 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4893 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4894 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4897 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4898 close it now. Perhaps, we should manage font-objects
4899 by `reference-count'. */
4900 font_close_object (f
, font_object
);
4907 #define BUILD_STYLE_TABLE(TBL) \
4908 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4911 build_style_table (const struct table_entry
*entry
, int nelement
)
4914 Lisp_Object table
, elt
;
4916 table
= Fmake_vector (make_number (nelement
), Qnil
);
4917 for (i
= 0; i
< nelement
; i
++)
4919 for (j
= 0; entry
[i
].names
[j
]; j
++);
4920 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4921 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4922 for (j
= 0; entry
[i
].names
[j
]; j
++)
4923 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4924 ASET (table
, i
, elt
);
4929 /* The deferred font-log data of the form [ACTION ARG RESULT].
4930 If ACTION is not nil, that is added to the log when font_add_log is
4931 called next time. At that time, ACTION is set back to nil. */
4932 static Lisp_Object Vfont_log_deferred
;
4934 /* Prepend the font-related logging data in Vfont_log if it is not
4935 `t'. ACTION describes a kind of font-related action (e.g. listing,
4936 opening), ARG is the argument for the action, and RESULT is the
4937 result of the action. */
4939 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4944 if (EQ (Vfont_log
, Qt
))
4946 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4948 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4950 ASET (Vfont_log_deferred
, 0, Qnil
);
4951 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4952 AREF (Vfont_log_deferred
, 2));
4957 Lisp_Object tail
, elt
;
4958 Lisp_Object equalstr
= build_string ("=");
4960 val
= Ffont_xlfd_name (arg
, Qt
);
4961 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4965 if (EQ (XCAR (elt
), QCscript
)
4966 && SYMBOLP (XCDR (elt
)))
4967 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4968 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4969 else if (EQ (XCAR (elt
), QClang
)
4970 && SYMBOLP (XCDR (elt
)))
4971 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4972 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4973 else if (EQ (XCAR (elt
), QCotf
)
4974 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4975 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4977 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4983 && VECTORP (XCAR (result
))
4984 && ASIZE (XCAR (result
)) > 0
4985 && FONTP (AREF (XCAR (result
), 0)))
4986 result
= font_vconcat_entity_vectors (result
);
4989 val
= Ffont_xlfd_name (result
, Qt
);
4990 if (! FONT_SPEC_P (result
))
4991 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4992 build_string (":"), val
);
4995 else if (CONSP (result
))
4998 result
= Fcopy_sequence (result
);
4999 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5003 val
= Ffont_xlfd_name (val
, Qt
);
5004 XSETCAR (tail
, val
);
5007 else if (VECTORP (result
))
5009 result
= Fcopy_sequence (result
);
5010 for (i
= 0; i
< ASIZE (result
); i
++)
5012 val
= AREF (result
, i
);
5014 val
= Ffont_xlfd_name (val
, Qt
);
5015 ASET (result
, i
, val
);
5018 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5021 /* Record a font-related logging data to be added to Vfont_log when
5022 font_add_log is called next time. ACTION, ARG, RESULT are the same
5026 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5028 if (EQ (Vfont_log
, Qt
))
5030 ASET (Vfont_log_deferred
, 0, build_string (action
));
5031 ASET (Vfont_log_deferred
, 1, arg
);
5032 ASET (Vfont_log_deferred
, 2, result
);
5038 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5039 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5040 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5041 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5042 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5043 /* Note that the other elements in sort_shift_bits are not used. */
5045 staticpro (&font_charset_alist
);
5046 font_charset_alist
= Qnil
;
5048 DEFSYM (Qopentype
, "opentype");
5050 DEFSYM (Qascii_0
, "ascii-0");
5051 DEFSYM (Qiso8859_1
, "iso8859-1");
5052 DEFSYM (Qiso10646_1
, "iso10646-1");
5053 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5054 DEFSYM (Qunicode_sip
, "unicode-sip");
5058 DEFSYM (QCotf
, ":otf");
5059 DEFSYM (QClang
, ":lang");
5060 DEFSYM (QCscript
, ":script");
5061 DEFSYM (QCantialias
, ":antialias");
5063 DEFSYM (QCfoundry
, ":foundry");
5064 DEFSYM (QCadstyle
, ":adstyle");
5065 DEFSYM (QCregistry
, ":registry");
5066 DEFSYM (QCspacing
, ":spacing");
5067 DEFSYM (QCdpi
, ":dpi");
5068 DEFSYM (QCscalable
, ":scalable");
5069 DEFSYM (QCavgwidth
, ":avgwidth");
5070 DEFSYM (QCfont_entity
, ":font-entity");
5071 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5081 DEFSYM (QCuser_spec
, "user-spec");
5083 staticpro (&null_vector
);
5084 null_vector
= Fmake_vector (make_number (0), Qnil
);
5086 staticpro (&scratch_font_spec
);
5087 scratch_font_spec
= Ffont_spec (0, NULL
);
5088 staticpro (&scratch_font_prefer
);
5089 scratch_font_prefer
= Ffont_spec (0, NULL
);
5091 staticpro (&Vfont_log_deferred
);
5092 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5096 staticpro (&otf_list
);
5098 #endif /* HAVE_LIBOTF */
5102 defsubr (&Sfont_spec
);
5103 defsubr (&Sfont_get
);
5104 #ifdef HAVE_WINDOW_SYSTEM
5105 defsubr (&Sfont_face_attributes
);
5107 defsubr (&Sfont_put
);
5108 defsubr (&Slist_fonts
);
5109 defsubr (&Sfont_family_list
);
5110 defsubr (&Sfind_font
);
5111 defsubr (&Sfont_xlfd_name
);
5112 defsubr (&Sclear_font_cache
);
5113 defsubr (&Sfont_shape_gstring
);
5114 defsubr (&Sfont_variation_glyphs
);
5116 defsubr (&Sfont_drive_otf
);
5117 defsubr (&Sfont_otf_alternates
);
5121 defsubr (&Sopen_font
);
5122 defsubr (&Sclose_font
);
5123 defsubr (&Squery_font
);
5124 defsubr (&Sfont_get_glyphs
);
5125 defsubr (&Sfont_match_p
);
5126 defsubr (&Sfont_at
);
5128 defsubr (&Sdraw_string
);
5130 #endif /* FONT_DEBUG */
5131 #ifdef HAVE_WINDOW_SYSTEM
5132 defsubr (&Sfont_info
);
5135 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5137 Alist of fontname patterns vs the corresponding encoding and repertory info.
5138 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5139 where ENCODING is a charset or a char-table,
5140 and REPERTORY is a charset, a char-table, or nil.
5142 If ENCODING and REPERTORY are the same, the element can have the form
5143 \(REGEXP . ENCODING).
5145 ENCODING is for converting a character to a glyph code of the font.
5146 If ENCODING is a charset, encoding a character by the charset gives
5147 the corresponding glyph code. If ENCODING is a char-table, looking up
5148 the table by a character gives the corresponding glyph code.
5150 REPERTORY specifies a repertory of characters supported by the font.
5151 If REPERTORY is a charset, all characters beloging to the charset are
5152 supported. If REPERTORY is a char-table, all characters who have a
5153 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5154 gets the repertory information by an opened font and ENCODING. */);
5155 Vfont_encoding_alist
= Qnil
;
5157 /* FIXME: These 3 vars are not quite what they appear: setq on them
5158 won't have any effect other than disconnect them from the style
5159 table used by the font display code. So we make them read-only,
5160 to avoid this confusing situation. */
5162 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5163 doc
: /* Vector of valid font weight values.
5164 Each element has the form:
5165 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5166 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5167 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5168 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5170 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5171 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5172 See `font-weight-table' for the format of the vector. */);
5173 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5174 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5176 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5177 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5178 See `font-weight-table' for the format of the vector. */);
5179 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5180 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5182 staticpro (&font_style_table
);
5183 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5184 ASET (font_style_table
, 0, Vfont_weight_table
);
5185 ASET (font_style_table
, 1, Vfont_slant_table
);
5186 ASET (font_style_table
, 2, Vfont_width_table
);
5188 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5189 *Logging list of font related actions and results.
5190 The value t means to suppress the logging.
5191 The initial value is set to nil if the environment variable
5192 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5195 #ifdef HAVE_WINDOW_SYSTEM
5196 #ifdef HAVE_FREETYPE
5198 #ifdef HAVE_X_WINDOWS
5203 #endif /* HAVE_XFT */
5204 #endif /* HAVE_X_WINDOWS */
5205 #else /* not HAVE_FREETYPE */
5206 #ifdef HAVE_X_WINDOWS
5208 #endif /* HAVE_X_WINDOWS */
5209 #endif /* not HAVE_FREETYPE */
5212 #endif /* HAVE_BDFFONT */
5215 #endif /* WINDOWSNT */
5218 #endif /* HAVE_NS */
5219 #endif /* HAVE_WINDOW_SYSTEM */
5225 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;