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
, QCfc_unknown_spec
;
129 /* Symbols representing values of font spacing property. */
130 Lisp_Object Qc
, Qm
, Qp
, Qd
;
131 /* Special ADSTYLE properties to avoid fonts used for Latin
132 characters; used in xfont.c and ftfont.c. */
133 Lisp_Object Qja
, Qko
;
135 Lisp_Object QCuser_spec
;
137 /* Alist of font registry symbol and the corresponding charsets
138 information. The information is retrieved from
139 Vfont_encoding_alist on demand.
141 Eash element has the form:
142 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
146 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
147 encodes a character code to a glyph code of a font, and
148 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
149 character is supported by a font.
151 The latter form means that the information for REGISTRY couldn't be
153 static Lisp_Object font_charset_alist
;
155 /* List of all font drivers. Each font-backend (XXXfont.c) calls
156 register_font_driver in syms_of_XXXfont to register its font-driver
158 static struct font_driver_list
*font_driver_list
;
162 /* Creaters of font-related Lisp object. */
165 font_make_spec (void)
167 Lisp_Object font_spec
;
168 struct font_spec
*spec
169 = ((struct font_spec
*)
170 allocate_pseudovector (VECSIZE (struct font_spec
),
171 FONT_SPEC_MAX
, PVEC_FONT
));
172 XSETFONT (font_spec
, spec
);
177 font_make_entity (void)
179 Lisp_Object font_entity
;
180 struct font_entity
*entity
181 = ((struct font_entity
*)
182 allocate_pseudovector (VECSIZE (struct font_entity
),
183 FONT_ENTITY_MAX
, PVEC_FONT
));
184 XSETFONT (font_entity
, entity
);
188 /* Create a font-object whose structure size is SIZE. If ENTITY is
189 not nil, copy properties from ENTITY to the font-object. If
190 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
192 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
194 Lisp_Object font_object
;
196 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
199 XSETFONT (font_object
, font
);
203 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
204 font
->props
[i
] = AREF (entity
, i
);
205 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
206 font
->props
[FONT_EXTRA_INDEX
]
207 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
210 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
216 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
217 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
218 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
220 static unsigned font_encode_char (Lisp_Object
, int);
222 /* Number of registered font drivers. */
223 static int num_font_drivers
;
226 /* Return a Lispy value of a font property value at STR and LEN bytes.
227 If STR is "*", it returns nil.
228 If FORCE_SYMBOL is zero and all characters in STR are digits, it
229 returns an integer. Otherwise, it returns a symbol interned from
233 font_intern_prop (const char *str
, int len
, int force_symbol
)
238 EMACS_INT nbytes
, nchars
;
240 if (len
== 1 && *str
== '*')
242 if (!force_symbol
&& len
>=1 && isdigit (*str
))
244 for (i
= 1; i
< len
; i
++)
245 if (! isdigit (str
[i
]))
248 return make_number (atoi (str
));
251 /* The following code is copied from the function intern (in
252 lread.c), and modified to suite our purpose. */
254 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
255 obarray
= check_obarray (obarray
);
256 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
257 if (len
== nchars
|| len
!= nbytes
)
258 /* CONTENTS contains no multibyte sequences or contains an invalid
259 multibyte sequence. We'll make a unibyte string. */
260 tem
= oblookup (obarray
, str
, len
, len
);
262 tem
= oblookup (obarray
, str
, nchars
, len
);
265 if (len
== nchars
|| len
!= nbytes
)
266 tem
= make_unibyte_string (str
, len
);
268 tem
= make_multibyte_string (str
, nchars
, len
);
269 return Fintern (tem
, obarray
);
272 /* Return a pixel size of font-spec SPEC on frame F. */
275 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
277 #ifdef HAVE_WINDOW_SYSTEM
278 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
287 font_assert (FLOATP (size
));
288 point_size
= XFLOAT_DATA (size
);
289 val
= AREF (spec
, FONT_DPI_INDEX
);
294 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
302 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
303 font vector. If VAL is not valid (i.e. not registered in
304 font_style_table), return -1 if NOERROR is zero, and return a
305 proper index if NOERROR is nonzero. In that case, register VAL in
306 font_style_table if VAL is a symbol, and return a closest index if
307 VAL is an integer. */
310 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
312 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
313 int len
= ASIZE (table
);
319 Lisp_Object args
[2], elt
;
321 /* At first try exact match. */
322 for (i
= 0; i
< len
; i
++)
323 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
324 if (EQ (val
, AREF (AREF (table
, i
), j
)))
325 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
326 | (i
<< 4) | (j
- 1));
327 /* Try also with case-folding match. */
328 s
= SSDATA (SYMBOL_NAME (val
));
329 for (i
= 0; i
< len
; i
++)
330 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
332 elt
= AREF (AREF (table
, i
), j
);
333 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
334 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
335 | (i
<< 4) | (j
- 1));
341 elt
= Fmake_vector (make_number (2), make_number (100));
344 args
[1] = Fmake_vector (make_number (1), elt
);
345 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
346 return (100 << 8) | (i
<< 4);
351 int numeric
= XINT (val
);
353 for (i
= 0, last_n
= -1; i
< len
; i
++)
355 int n
= XINT (AREF (AREF (table
, i
), 0));
358 return (n
<< 8) | (i
<< 4);
363 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
364 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
370 return ((last_n
<< 8) | ((i
- 1) << 4));
375 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
377 Lisp_Object val
= AREF (font
, prop
);
378 Lisp_Object table
, elt
;
383 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
384 i
= XINT (val
) & 0xFF;
385 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
386 elt
= AREF (table
, ((i
>> 4) & 0xF));
387 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
388 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
391 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
392 FONTNAME. ENCODING is a charset symbol that specifies the encoding
393 of the font. REPERTORY is a charset symbol or nil. */
396 find_font_encoding (Lisp_Object fontname
)
398 Lisp_Object tail
, elt
;
400 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
404 && STRINGP (XCAR (elt
))
405 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
406 && (SYMBOLP (XCDR (elt
))
407 ? CHARSETP (XCDR (elt
))
408 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
414 /* Return encoding charset and repertory charset for REGISTRY in
415 ENCODING and REPERTORY correspondingly. If correct information for
416 REGISTRY is available, return 0. Otherwise return -1. */
419 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
422 int encoding_id
, repertory_id
;
424 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
430 encoding_id
= XINT (XCAR (val
));
431 repertory_id
= XINT (XCDR (val
));
435 val
= find_font_encoding (SYMBOL_NAME (registry
));
436 if (SYMBOLP (val
) && CHARSETP (val
))
438 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
440 else if (CONSP (val
))
442 if (! CHARSETP (XCAR (val
)))
444 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
445 if (NILP (XCDR (val
)))
449 if (! CHARSETP (XCDR (val
)))
451 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
456 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
458 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
462 *encoding
= CHARSET_FROM_ID (encoding_id
);
464 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
469 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
474 /* Font property value validaters. See the comment of
475 font_property_table for the meaning of the arguments. */
477 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
478 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
479 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
480 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
481 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
482 static int get_font_prop_index (Lisp_Object
);
485 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
488 val
= Fintern (val
, Qnil
);
491 else if (EQ (prop
, QCregistry
))
492 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
498 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
500 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
501 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
507 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
511 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
513 if ((n
& 0xF) + 1 >= ASIZE (elt
))
515 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
519 else if (SYMBOLP (val
))
521 int n
= font_style_to_value (prop
, val
, 0);
523 val
= n
>= 0 ? make_number (n
) : Qerror
;
531 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
533 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
538 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
540 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
542 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
544 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
546 if (spacing
== 'c' || spacing
== 'C')
547 return make_number (FONT_SPACING_CHARCELL
);
548 if (spacing
== 'm' || spacing
== 'M')
549 return make_number (FONT_SPACING_MONO
);
550 if (spacing
== 'p' || spacing
== 'P')
551 return make_number (FONT_SPACING_PROPORTIONAL
);
552 if (spacing
== 'd' || spacing
== 'D')
553 return make_number (FONT_SPACING_DUAL
);
559 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
561 Lisp_Object tail
, tmp
;
564 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
565 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
566 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
569 if (! SYMBOLP (XCAR (val
)))
574 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
576 for (i
= 0; i
< 2; i
++)
583 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
584 if (! SYMBOLP (XCAR (tmp
)))
592 /* Structure of known font property keys and validater of the
596 /* Pointer to the key symbol. */
598 /* Function to validate PROP's value VAL, or NULL if any value is
599 ok. The value is VAL or its regularized value if VAL is valid,
600 and Qerror if not. */
601 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
602 } font_property_table
[] =
603 { { &QCtype
, font_prop_validate_symbol
},
604 { &QCfoundry
, font_prop_validate_symbol
},
605 { &QCfamily
, font_prop_validate_symbol
},
606 { &QCadstyle
, font_prop_validate_symbol
},
607 { &QCregistry
, font_prop_validate_symbol
},
608 { &QCweight
, font_prop_validate_style
},
609 { &QCslant
, font_prop_validate_style
},
610 { &QCwidth
, font_prop_validate_style
},
611 { &QCsize
, font_prop_validate_non_neg
},
612 { &QCdpi
, font_prop_validate_non_neg
},
613 { &QCspacing
, font_prop_validate_spacing
},
614 { &QCavgwidth
, font_prop_validate_non_neg
},
615 /* The order of the above entries must match with enum
616 font_property_index. */
617 { &QClang
, font_prop_validate_symbol
},
618 { &QCscript
, font_prop_validate_symbol
},
619 { &QCotf
, font_prop_validate_otf
}
622 /* Size (number of elements) of the above table. */
623 #define FONT_PROPERTY_TABLE_SIZE \
624 ((sizeof font_property_table) / (sizeof *font_property_table))
626 /* Return an index number of font property KEY or -1 if KEY is not an
627 already known property. */
630 get_font_prop_index (Lisp_Object key
)
634 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
635 if (EQ (key
, *font_property_table
[i
].key
))
640 /* Validate the font property. The property key is specified by the
641 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
642 signal an error. The value is VAL or the regularized one. */
645 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
647 Lisp_Object validated
;
652 prop
= *font_property_table
[idx
].key
;
655 idx
= get_font_prop_index (prop
);
659 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
660 if (EQ (validated
, Qerror
))
661 signal_error ("invalid font property", Fcons (prop
, val
));
666 /* Store VAL as a value of extra font property PROP in FONT while
667 keeping the sorting order. Don't check the validity of VAL. */
670 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
672 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
673 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
677 Lisp_Object prev
= Qnil
;
680 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
681 prev
= extra
, extra
= XCDR (extra
);
684 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
686 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
692 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
697 /* Font name parser and unparser */
699 static int parse_matrix (const char *);
700 static int font_expand_wildcards (Lisp_Object
*, int);
701 static int font_parse_name (char *, Lisp_Object
);
703 /* An enumerator for each field of an XLFD font name. */
704 enum xlfd_field_index
723 /* An enumerator for mask bit corresponding to each XLFD field. */
726 XLFD_FOUNDRY_MASK
= 0x0001,
727 XLFD_FAMILY_MASK
= 0x0002,
728 XLFD_WEIGHT_MASK
= 0x0004,
729 XLFD_SLANT_MASK
= 0x0008,
730 XLFD_SWIDTH_MASK
= 0x0010,
731 XLFD_ADSTYLE_MASK
= 0x0020,
732 XLFD_PIXEL_MASK
= 0x0040,
733 XLFD_POINT_MASK
= 0x0080,
734 XLFD_RESX_MASK
= 0x0100,
735 XLFD_RESY_MASK
= 0x0200,
736 XLFD_SPACING_MASK
= 0x0400,
737 XLFD_AVGWIDTH_MASK
= 0x0800,
738 XLFD_REGISTRY_MASK
= 0x1000,
739 XLFD_ENCODING_MASK
= 0x2000
743 /* Parse P pointing the pixel/point size field of the form
744 `[A B C D]' which specifies a transformation matrix:
750 by which all glyphs of the font are transformed. The spec says
751 that scalar value N for the pixel/point size is equivalent to:
752 A = N * resx/resy, B = C = 0, D = N.
754 Return the scalar value N if the form is valid. Otherwise return
758 parse_matrix (const char *p
)
764 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
767 matrix
[i
] = - strtod (p
+ 1, &end
);
769 matrix
[i
] = strtod (p
, &end
);
772 return (i
== 4 ? (int) matrix
[3] : -1);
775 /* Expand a wildcard field in FIELD (the first N fields are filled) to
776 multiple fields to fill in all 14 XLFD fields while restring a
777 field position by its contents. */
780 font_expand_wildcards (Lisp_Object
*field
, int n
)
783 Lisp_Object tmp
[XLFD_LAST_INDEX
];
784 /* Array of information about where this element can go. Nth
785 element is for Nth element of FIELD. */
787 /* Minimum possible field. */
789 /* Maxinum possible field. */
791 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
793 } range
[XLFD_LAST_INDEX
];
795 int range_from
, range_to
;
798 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
799 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
800 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
801 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
802 | XLFD_AVGWIDTH_MASK)
803 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
805 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
806 field. The value is shifted to left one bit by one in the
808 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
809 range_mask
= (range_mask
<< 1) | 1;
811 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
812 position-based retriction for FIELD[I]. */
813 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
814 i
++, range_from
++, range_to
++, range_mask
<<= 1)
816 Lisp_Object val
= field
[i
];
822 range
[i
].from
= range_from
;
823 range
[i
].to
= range_to
;
824 range
[i
].mask
= range_mask
;
828 /* The triplet FROM, TO, and MASK is a value-based
829 retriction for FIELD[I]. */
835 int numeric
= XINT (val
);
838 from
= to
= XLFD_ENCODING_INDEX
,
839 mask
= XLFD_ENCODING_MASK
;
840 else if (numeric
== 0)
841 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
842 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
843 else if (numeric
<= 48)
844 from
= to
= XLFD_PIXEL_INDEX
,
845 mask
= XLFD_PIXEL_MASK
;
847 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
848 mask
= XLFD_LARGENUM_MASK
;
850 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
851 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
852 mask
= XLFD_NULL_MASK
;
854 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
857 Lisp_Object name
= SYMBOL_NAME (val
);
859 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
860 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
861 mask
= XLFD_REGENC_MASK
;
863 from
= to
= XLFD_ENCODING_INDEX
,
864 mask
= XLFD_ENCODING_MASK
;
866 else if (range_from
<= XLFD_WEIGHT_INDEX
867 && range_to
>= XLFD_WEIGHT_INDEX
868 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
869 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
870 else if (range_from
<= XLFD_SLANT_INDEX
871 && range_to
>= XLFD_SLANT_INDEX
872 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
873 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
874 else if (range_from
<= XLFD_SWIDTH_INDEX
875 && range_to
>= XLFD_SWIDTH_INDEX
876 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
877 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
880 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
881 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
883 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
884 mask
= XLFD_SYMBOL_MASK
;
887 /* Merge position-based and value-based restrictions. */
889 while (from
< range_from
)
890 mask
&= ~(1 << from
++);
891 while (from
< 14 && ! (mask
& (1 << from
)))
893 while (to
> range_to
)
894 mask
&= ~(1 << to
--);
895 while (to
>= 0 && ! (mask
& (1 << to
)))
899 range
[i
].from
= from
;
901 range
[i
].mask
= mask
;
903 if (from
> range_from
|| to
< range_to
)
905 /* The range is narrowed by value-based restrictions.
906 Reflect it to the other fields. */
908 /* Following fields should be after FROM. */
910 /* Preceding fields should be before TO. */
911 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
913 /* Check FROM for non-wildcard field. */
914 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
916 while (range
[j
].from
< from
)
917 range
[j
].mask
&= ~(1 << range
[j
].from
++);
918 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
920 range
[j
].from
= from
;
923 from
= range
[j
].from
;
924 if (range
[j
].to
> to
)
926 while (range
[j
].to
> to
)
927 range
[j
].mask
&= ~(1 << range
[j
].to
--);
928 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
941 /* Decide all fileds from restrictions in RANGE. */
942 for (i
= j
= 0; i
< n
; i
++)
944 if (j
< range
[i
].from
)
946 if (i
== 0 || ! NILP (tmp
[i
- 1]))
947 /* None of TMP[X] corresponds to Jth field. */
949 for (; j
< range
[i
].from
; j
++)
954 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
956 for (; j
< XLFD_LAST_INDEX
; j
++)
958 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
959 field
[XLFD_ENCODING_INDEX
]
960 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
965 /* Parse NAME (null terminated) as XLFD and store information in FONT
966 (font-spec or font-entity). Size property of FONT is set as
968 specified XLFD fields FONT property
969 --------------------- -------------
970 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
971 POINT_SIZE and RESY calculated pixel size (Lisp integer)
972 POINT_SIZE POINT_SIZE/10 (Lisp float)
974 If NAME is successfully parsed, return 0. Otherwise return -1.
976 FONT is usually a font-spec, but when this function is called from
977 X font backend driver, it is a font-entity. In that case, NAME is
978 a fully specified XLFD. */
981 font_parse_xlfd (char *name
, Lisp_Object font
)
983 int len
= strlen (name
);
985 char *f
[XLFD_LAST_INDEX
+ 1];
989 if (len
> 255 || !len
)
990 /* Maximum XLFD name length is 255. */
992 /* Accept "*-.." as a fully specified XLFD. */
993 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
994 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
997 for (p
= name
+ i
; *p
; p
++)
1001 if (i
== XLFD_LAST_INDEX
)
1006 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1007 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1009 if (i
== XLFD_LAST_INDEX
)
1011 /* Fully specified XLFD. */
1014 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1015 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1016 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1017 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1019 val
= INTERN_FIELD_SYM (i
);
1022 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1024 ASET (font
, j
, make_number (n
));
1027 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1028 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1029 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1031 ASET (font
, FONT_REGISTRY_INDEX
,
1032 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1033 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1035 p
= f
[XLFD_PIXEL_INDEX
];
1036 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1037 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1040 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1042 ASET (font
, FONT_SIZE_INDEX
, val
);
1043 else if (FONT_ENTITY_P (font
))
1047 double point_size
= -1;
1049 font_assert (FONT_SPEC_P (font
));
1050 p
= f
[XLFD_POINT_INDEX
];
1052 point_size
= parse_matrix (p
);
1053 else if (isdigit (*p
))
1054 point_size
= atoi (p
), point_size
/= 10;
1055 if (point_size
>= 0)
1056 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1060 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1061 if (! NILP (val
) && ! INTEGERP (val
))
1063 ASET (font
, FONT_DPI_INDEX
, val
);
1064 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1067 val
= font_prop_validate_spacing (QCspacing
, val
);
1068 if (! INTEGERP (val
))
1070 ASET (font
, FONT_SPACING_INDEX
, val
);
1072 p
= f
[XLFD_AVGWIDTH_INDEX
];
1075 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1076 if (! NILP (val
) && ! INTEGERP (val
))
1078 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1082 int wild_card_found
= 0;
1083 Lisp_Object prop
[XLFD_LAST_INDEX
];
1085 if (FONT_ENTITY_P (font
))
1087 for (j
= 0; j
< i
; j
++)
1091 if (f
[j
][1] && f
[j
][1] != '-')
1094 wild_card_found
= 1;
1097 prop
[j
] = INTERN_FIELD (j
);
1099 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1101 if (! wild_card_found
)
1103 if (font_expand_wildcards (prop
, i
) < 0)
1106 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1107 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1108 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1109 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1110 if (! NILP (prop
[i
]))
1112 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1114 ASET (font
, j
, make_number (n
));
1116 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1117 val
= prop
[XLFD_REGISTRY_INDEX
];
1120 val
= prop
[XLFD_ENCODING_INDEX
];
1122 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1124 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1125 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1127 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1128 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1130 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1132 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1133 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1134 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1136 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1138 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1141 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1142 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1143 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1145 val
= font_prop_validate_spacing (QCspacing
,
1146 prop
[XLFD_SPACING_INDEX
]);
1147 if (! INTEGERP (val
))
1149 ASET (font
, FONT_SPACING_INDEX
, val
);
1151 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1152 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1158 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1159 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1160 0, use PIXEL_SIZE instead. */
1163 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1166 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1170 font_assert (FONTP (font
));
1172 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1175 if (i
== FONT_ADSTYLE_INDEX
)
1176 j
= XLFD_ADSTYLE_INDEX
;
1177 else if (i
== FONT_REGISTRY_INDEX
)
1178 j
= XLFD_REGISTRY_INDEX
;
1179 val
= AREF (font
, i
);
1182 if (j
== XLFD_REGISTRY_INDEX
)
1183 f
[j
] = "*-*", len
+= 4;
1185 f
[j
] = "*", len
+= 2;
1190 val
= SYMBOL_NAME (val
);
1191 if (j
== XLFD_REGISTRY_INDEX
1192 && ! strchr (SSDATA (val
), '-'))
1194 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1195 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1197 f
[j
] = p
= alloca (SBYTES (val
) + 3);
1198 sprintf (p
, "%s-*", SDATA (val
));
1199 len
+= SBYTES (val
) + 3;
1203 f
[j
] = p
= alloca (SBYTES (val
) + 4);
1204 sprintf (p
, "%s*-*", SDATA (val
));
1205 len
+= SBYTES (val
) + 4;
1209 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1213 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1216 val
= font_style_symbolic (font
, i
, 0);
1218 f
[j
] = "*", len
+= 2;
1221 val
= SYMBOL_NAME (val
);
1222 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1226 val
= AREF (font
, FONT_SIZE_INDEX
);
1227 font_assert (NUMBERP (val
) || NILP (val
));
1235 f
[XLFD_PIXEL_INDEX
] = p
= alloca (22);
1236 len
+= sprintf (p
, "%d-*", i
) + 1;
1239 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1241 else if (FLOATP (val
))
1243 i
= XFLOAT_DATA (val
) * 10;
1244 f
[XLFD_PIXEL_INDEX
] = p
= alloca (12);
1245 len
+= sprintf (p
, "*-%d", i
) + 1;
1248 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1250 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1252 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1253 f
[XLFD_RESX_INDEX
] = p
= alloca (22);
1254 len
+= sprintf (p
, "%d-%d", i
, i
) + 1;
1257 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1258 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1260 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1262 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1263 : spacing
<= FONT_SPACING_DUAL
? "d"
1264 : spacing
<= FONT_SPACING_MONO
? "m"
1269 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1270 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1272 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (11);
1273 len
+= sprintf (p
, "%ld",
1274 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1277 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1278 len
++; /* for terminating '\0'. */
1281 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1282 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1283 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1284 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1285 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1286 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1287 f
[XLFD_REGISTRY_INDEX
]);
1290 /* Parse NAME (null terminated) and store information in FONT
1291 (font-spec or font-entity). NAME is supplied in either the
1292 Fontconfig or GTK font name format. If NAME is successfully
1293 parsed, return 0. Otherwise return -1.
1295 The fontconfig format is
1297 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1301 FAMILY [PROPS...] [SIZE]
1303 This function tries to guess which format it is. */
1306 font_parse_fcname (char *name
, Lisp_Object font
)
1309 char *size_beg
= NULL
, *size_end
= NULL
;
1310 char *props_beg
= NULL
, *family_end
= NULL
;
1311 int len
= strlen (name
);
1316 for (p
= name
; *p
; p
++)
1318 if (*p
== '\\' && p
[1])
1322 props_beg
= family_end
= p
;
1327 int decimal
= 0, size_found
= 1;
1328 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1331 if (*q
!= '.' || decimal
)
1350 Lisp_Object extra_props
= Qnil
;
1352 /* A fontconfig name with size and/or property data. */
1353 if (family_end
> name
)
1356 family
= font_intern_prop (name
, family_end
- name
, 1);
1357 ASET (font
, FONT_FAMILY_INDEX
, family
);
1361 double point_size
= strtod (size_beg
, &size_end
);
1362 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1363 if (*size_end
== ':' && size_end
[1])
1364 props_beg
= size_end
;
1368 /* Now parse ":KEY=VAL" patterns. */
1371 for (p
= props_beg
; *p
; p
= q
)
1373 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1376 /* Must be an enumerated value. */
1380 val
= font_intern_prop (p
, q
- p
, 1);
1382 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1383 && memcmp (p, STR, strlen (STR)) == 0)
1385 if (PROP_MATCH ("light")
1386 || PROP_MATCH ("medium")
1387 || PROP_MATCH ("demibold")
1388 || PROP_MATCH ("bold")
1389 || PROP_MATCH ("black"))
1390 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1391 else if (PROP_MATCH ("roman")
1392 || PROP_MATCH ("italic")
1393 || PROP_MATCH ("oblique"))
1394 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1395 else if (PROP_MATCH ("charcell"))
1396 ASET (font
, FONT_SPACING_INDEX
,
1397 make_number (FONT_SPACING_CHARCELL
));
1398 else if (PROP_MATCH ("mono"))
1399 ASET (font
, FONT_SPACING_INDEX
,
1400 make_number (FONT_SPACING_MONO
));
1401 else if (PROP_MATCH ("proportional"))
1402 ASET (font
, FONT_SPACING_INDEX
,
1403 make_number (FONT_SPACING_PROPORTIONAL
));
1412 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1413 prop
= FONT_SIZE_INDEX
;
1416 key
= font_intern_prop (p
, q
- p
, 1);
1417 prop
= get_font_prop_index (key
);
1421 for (q
= p
; *q
&& *q
!= ':'; q
++);
1422 val
= font_intern_prop (p
, q
- p
, 0);
1424 if (prop
>= FONT_FOUNDRY_INDEX
1425 && prop
< FONT_EXTRA_INDEX
)
1426 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1429 extra_props
= nconc2 (extra_props
,
1430 Fcons (Fcons (key
, val
), Qnil
));
1437 if (! NILP (extra_props
))
1439 struct font_driver_list
*driver_list
= font_driver_list
;
1440 for ( ; driver_list
; driver_list
= driver_list
->next
)
1441 if (driver_list
->driver
->filter_properties
)
1442 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1448 /* Either a fontconfig-style name with no size and property
1449 data, or a GTK-style name. */
1450 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1451 Lisp_Object width
= Qnil
, size
= Qnil
;
1455 /* Scan backwards from the end, looking for a size. */
1456 for (p
= name
+ len
- 1; p
>= name
; p
--)
1460 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1461 /* Found a font size. */
1462 size
= make_float (strtod (p
+ 1, NULL
));
1466 /* Now P points to the termination of the string, sans size.
1467 Scan backwards, looking for font properties. */
1468 for (; p
> name
; p
= q
)
1470 for (q
= p
- 1; q
>= name
; q
--)
1472 if (q
> name
&& *(q
-1) == '\\')
1473 --q
; /* Skip quoting backslashes. */
1479 word_len
= p
- word_start
;
1481 #define PROP_MATCH(STR) \
1482 (word_len == strlen (STR) \
1483 && memcmp (word_start, STR, strlen (STR)) == 0)
1484 #define PROP_SAVE(VAR, STR) \
1485 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1487 if (PROP_MATCH ("Ultra-Light"))
1488 PROP_SAVE (weight
, "ultra-light");
1489 else if (PROP_MATCH ("Light"))
1490 PROP_SAVE (weight
, "light");
1491 else if (PROP_MATCH ("Book"))
1492 PROP_SAVE (weight
, "book");
1493 else if (PROP_MATCH ("Medium"))
1494 PROP_SAVE (weight
, "medium");
1495 else if (PROP_MATCH ("Semi-Bold"))
1496 PROP_SAVE (weight
, "semi-bold");
1497 else if (PROP_MATCH ("Bold"))
1498 PROP_SAVE (weight
, "bold");
1499 else if (PROP_MATCH ("Italic"))
1500 PROP_SAVE (slant
, "italic");
1501 else if (PROP_MATCH ("Oblique"))
1502 PROP_SAVE (slant
, "oblique");
1503 else if (PROP_MATCH ("Semi-Condensed"))
1504 PROP_SAVE (width
, "semi-condensed");
1505 else if (PROP_MATCH ("Condensed"))
1506 PROP_SAVE (width
, "condensed");
1507 /* An unknown word must be part of the font name. */
1518 ASET (font
, FONT_FAMILY_INDEX
,
1519 font_intern_prop (name
, family_end
- name
, 1));
1521 ASET (font
, FONT_SIZE_INDEX
, size
);
1523 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1525 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1527 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1533 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1534 NAME (NBYTES length), and return the name length. If
1535 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1538 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1540 Lisp_Object family
, foundry
;
1541 Lisp_Object tail
, val
;
1545 Lisp_Object styles
[3];
1546 const char *style_names
[3] = { "weight", "slant", "width" };
1549 family
= AREF (font
, FONT_FAMILY_INDEX
);
1550 if (! NILP (family
))
1552 if (SYMBOLP (family
))
1554 family
= SYMBOL_NAME (family
);
1555 len
+= SBYTES (family
);
1561 val
= AREF (font
, FONT_SIZE_INDEX
);
1564 if (XINT (val
) != 0)
1565 pixel_size
= XINT (val
);
1567 len
+= 21; /* for ":pixelsize=NUM" */
1569 else if (FLOATP (val
))
1572 point_size
= (int) XFLOAT_DATA (val
);
1573 len
+= 11; /* for "-NUM" */
1576 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1577 if (! NILP (foundry
))
1579 if (SYMBOLP (foundry
))
1581 foundry
= SYMBOL_NAME (foundry
);
1582 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1588 for (i
= 0; i
< 3; i
++)
1590 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1591 if (! NILP (styles
[i
]))
1592 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1593 SDATA (SYMBOL_NAME (styles
[i
])));
1596 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1597 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1598 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1599 len
+= strlen (":spacing=100");
1600 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1601 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1602 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1604 Lisp_Object key
= XCAR (XCAR (tail
)), value
= XCDR (XCAR (tail
));
1606 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1607 if (STRINGP (value
))
1608 len
+= SBYTES (value
);
1609 else if (INTEGERP (value
))
1610 len
+= sprintf (work
, "%ld", (long) XINT (value
));
1611 else if (SYMBOLP (value
))
1612 len
+= (NILP (value
) ? 5 : 4); /* for "false" or "true" */
1618 if (! NILP (family
))
1619 p
+= sprintf (p
, "%s", SDATA (family
));
1623 p
+= sprintf (p
, "%d", point_size
);
1625 p
+= sprintf (p
, "-%d", point_size
);
1627 else if (pixel_size
> 0)
1628 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1629 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1630 p
+= sprintf (p
, ":foundry=%s",
1631 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1632 for (i
= 0; i
< 3; i
++)
1633 if (! NILP (styles
[i
]))
1634 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1635 SDATA (SYMBOL_NAME (styles
[i
])));
1636 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1637 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1638 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1639 p
+= sprintf (p
, ":spacing=%ld",
1640 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1641 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1643 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1644 p
+= sprintf (p
, ":scalable=true");
1646 p
+= sprintf (p
, ":scalable=false");
1651 /* Parse NAME (null terminated) and store information in FONT
1652 (font-spec or font-entity). If NAME is successfully parsed, return
1653 0. Otherwise return -1. */
1656 font_parse_name (char *name
, Lisp_Object font
)
1658 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1659 return font_parse_xlfd (name
, font
);
1660 return font_parse_fcname (name
, font
);
1664 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1665 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1669 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1675 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1677 CHECK_STRING (family
);
1678 len
= SBYTES (family
);
1679 p0
= SSDATA (family
);
1680 p1
= strchr (p0
, '-');
1683 if ((*p0
!= '*' && p1
- p0
> 0)
1684 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1685 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1688 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1691 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1693 if (! NILP (registry
))
1695 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1696 CHECK_STRING (registry
);
1697 len
= SBYTES (registry
);
1698 p0
= SSDATA (registry
);
1699 p1
= strchr (p0
, '-');
1702 if (SDATA (registry
)[len
- 1] == '*')
1703 registry
= concat2 (registry
, build_string ("-*"));
1705 registry
= concat2 (registry
, build_string ("*-*"));
1707 registry
= Fdowncase (registry
);
1708 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1713 /* This part (through the next ^L) is still experimental and not
1714 tested much. We may drastically change codes. */
1720 #define LGSTRING_HEADER_SIZE 6
1721 #define LGSTRING_GLYPH_SIZE 8
1724 check_gstring (gstring
)
1725 Lisp_Object gstring
;
1730 CHECK_VECTOR (gstring
);
1731 val
= AREF (gstring
, 0);
1733 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1735 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1736 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1737 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1738 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1739 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1740 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1741 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1742 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1743 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1744 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1745 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1747 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1749 val
= LGSTRING_GLYPH (gstring
, i
);
1751 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1753 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1755 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1756 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1757 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1758 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1759 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1760 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1761 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1762 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1764 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1766 if (ASIZE (val
) < 3)
1768 for (j
= 0; j
< 3; j
++)
1769 CHECK_NUMBER (AREF (val
, j
));
1774 error ("Invalid glyph-string format");
1779 check_otf_features (otf_features
)
1780 Lisp_Object otf_features
;
1784 CHECK_CONS (otf_features
);
1785 CHECK_SYMBOL (XCAR (otf_features
));
1786 otf_features
= XCDR (otf_features
);
1787 CHECK_CONS (otf_features
);
1788 CHECK_SYMBOL (XCAR (otf_features
));
1789 otf_features
= XCDR (otf_features
);
1790 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1792 CHECK_SYMBOL (Fcar (val
));
1793 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1794 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1796 otf_features
= XCDR (otf_features
);
1797 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1799 CHECK_SYMBOL (Fcar (val
));
1800 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1801 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1808 Lisp_Object otf_list
;
1811 otf_tag_symbol (tag
)
1816 OTF_tag_name (tag
, name
);
1817 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1824 Lisp_Object val
= Fassoc (file
, otf_list
);
1828 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1831 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1832 val
= make_save_value (otf
, 0);
1833 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1839 /* Return a list describing which scripts/languages FONT supports by
1840 which GSUB/GPOS features of OpenType tables. See the comment of
1841 (struct font_driver).otf_capability. */
1844 font_otf_capability (font
)
1848 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1851 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1854 for (i
= 0; i
< 2; i
++)
1856 OTF_GSUB_GPOS
*gsub_gpos
;
1857 Lisp_Object script_list
= Qnil
;
1860 if (OTF_get_features (otf
, i
== 0) < 0)
1862 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1863 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1865 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1866 Lisp_Object langsys_list
= Qnil
;
1867 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1870 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1872 OTF_LangSys
*langsys
;
1873 Lisp_Object feature_list
= Qnil
;
1874 Lisp_Object langsys_tag
;
1877 if (k
== script
->LangSysCount
)
1879 langsys
= &script
->DefaultLangSys
;
1884 langsys
= script
->LangSys
+ k
;
1886 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1888 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1890 OTF_Feature
*feature
1891 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1892 Lisp_Object feature_tag
1893 = otf_tag_symbol (feature
->FeatureTag
);
1895 feature_list
= Fcons (feature_tag
, feature_list
);
1897 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1900 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1905 XSETCAR (capability
, script_list
);
1907 XSETCDR (capability
, script_list
);
1913 /* Parse OTF features in SPEC and write a proper features spec string
1914 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1915 assured that the sufficient memory has already allocated for
1919 generate_otf_features (spec
, features
)
1929 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1935 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1940 else if (! asterisk
)
1942 val
= SYMBOL_NAME (val
);
1943 p
+= sprintf (p
, "%s", SDATA (val
));
1947 val
= SYMBOL_NAME (val
);
1948 p
+= sprintf (p
, "~%s", SDATA (val
));
1952 error ("OTF spec too long");
1956 font_otf_DeviceTable (device_table
)
1957 OTF_DeviceTable
*device_table
;
1959 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1961 return Fcons (make_number (len
),
1962 make_unibyte_string (device_table
->DeltaValue
, len
));
1966 font_otf_ValueRecord (value_format
, value_record
)
1968 OTF_ValueRecord
*value_record
;
1970 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1972 if (value_format
& OTF_XPlacement
)
1973 ASET (val
, 0, make_number (value_record
->XPlacement
));
1974 if (value_format
& OTF_YPlacement
)
1975 ASET (val
, 1, make_number (value_record
->YPlacement
));
1976 if (value_format
& OTF_XAdvance
)
1977 ASET (val
, 2, make_number (value_record
->XAdvance
));
1978 if (value_format
& OTF_YAdvance
)
1979 ASET (val
, 3, make_number (value_record
->YAdvance
));
1980 if (value_format
& OTF_XPlaDevice
)
1981 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1982 if (value_format
& OTF_YPlaDevice
)
1983 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1984 if (value_format
& OTF_XAdvDevice
)
1985 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1986 if (value_format
& OTF_YAdvDevice
)
1987 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1992 font_otf_Anchor (anchor
)
1997 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1998 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1999 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2000 if (anchor
->AnchorFormat
== 2)
2001 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2004 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2005 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2009 #endif /* HAVE_LIBOTF */
2015 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2016 static int font_compare (const void *, const void *);
2017 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2021 font_rescale_ratio (Lisp_Object font_entity
)
2023 Lisp_Object tail
, elt
;
2024 Lisp_Object name
= Qnil
;
2026 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2029 if (FLOATP (XCDR (elt
)))
2031 if (STRINGP (XCAR (elt
)))
2034 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2035 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2036 return XFLOAT_DATA (XCDR (elt
));
2038 else if (FONT_SPEC_P (XCAR (elt
)))
2040 if (font_match_p (XCAR (elt
), font_entity
))
2041 return XFLOAT_DATA (XCDR (elt
));
2048 /* We sort fonts by scoring each of them against a specified
2049 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2050 the value is, the closer the font is to the font-spec.
2052 The lowest 2 bits of the score is used for driver type. The font
2053 available by the most preferred font driver is 0.
2055 Each 7-bit in the higher 28 bits are used for numeric properties
2056 WEIGHT, SLANT, WIDTH, and SIZE. */
2058 /* How many bits to shift to store the difference value of each font
2059 property in a score. Note that flots for FONT_TYPE_INDEX and
2060 FONT_REGISTRY_INDEX are not used. */
2061 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2063 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2064 The return value indicates how different ENTITY is compared with
2068 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2073 /* Score three style numeric fields. Maximum difference is 127. */
2074 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2075 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2077 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2082 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2085 /* Score the size. Maximum difference is 127. */
2086 i
= FONT_SIZE_INDEX
;
2087 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2088 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2090 /* We use the higher 6-bit for the actual size difference. The
2091 lowest bit is set if the DPI is different. */
2093 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2095 if (CONSP (Vface_font_rescale_alist
))
2096 pixel_size
*= font_rescale_ratio (entity
);
2097 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2101 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2102 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2104 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2105 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2107 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2114 /* Concatenate all elements of LIST into one vector. LIST is a list
2115 of font-entity vectors. */
2118 font_vconcat_entity_vectors (Lisp_Object list
)
2120 int nargs
= XINT (Flength (list
));
2121 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2124 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2125 args
[i
] = XCAR (list
);
2126 return Fvconcat (nargs
, args
);
2130 /* The structure for elements being sorted by qsort. */
2131 struct font_sort_data
2134 int font_driver_preference
;
2139 /* The comparison function for qsort. */
2142 font_compare (const void *d1
, const void *d2
)
2144 const struct font_sort_data
*data1
= d1
;
2145 const struct font_sort_data
*data2
= d2
;
2147 if (data1
->score
< data2
->score
)
2149 else if (data1
->score
> data2
->score
)
2151 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2155 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2156 If PREFER specifies a point-size, calculate the corresponding
2157 pixel-size from QCdpi property of PREFER or from the Y-resolution
2158 of FRAME before sorting.
2160 If BEST-ONLY is nonzero, return the best matching entity (that
2161 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2162 if BEST-ONLY is negative). Otherwise, return the sorted result as
2163 a single vector of font-entities.
2165 This function does no optimization for the case that the total
2166 number of elements is 1. The caller should avoid calling this in
2170 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2172 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2174 struct font_sort_data
*data
;
2175 unsigned best_score
;
2176 Lisp_Object best_entity
;
2177 struct frame
*f
= XFRAME (frame
);
2178 Lisp_Object tail
, vec
;
2181 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2182 prefer_prop
[i
] = AREF (prefer
, i
);
2183 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2184 prefer_prop
[FONT_SIZE_INDEX
]
2185 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2187 if (NILP (XCDR (list
)))
2189 /* What we have to take care of is this single vector. */
2191 maxlen
= ASIZE (vec
);
2195 /* We don't have to perform sort, so there's no need of creating
2196 a single vector. But, we must find the length of the longest
2199 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2200 if (maxlen
< ASIZE (XCAR (tail
)))
2201 maxlen
= ASIZE (XCAR (tail
));
2205 /* We have to create a single vector to sort it. */
2206 vec
= font_vconcat_entity_vectors (list
);
2207 maxlen
= ASIZE (vec
);
2210 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2211 best_score
= 0xFFFFFFFF;
2214 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2216 int font_driver_preference
= 0;
2217 Lisp_Object current_font_driver
;
2223 /* We are sure that the length of VEC > 0. */
2224 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2225 /* Score the elements. */
2226 for (i
= 0; i
< len
; i
++)
2228 data
[i
].entity
= AREF (vec
, i
);
2230 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2232 ? font_score (data
[i
].entity
, prefer_prop
)
2234 if (best_only
&& best_score
> data
[i
].score
)
2236 best_score
= data
[i
].score
;
2237 best_entity
= data
[i
].entity
;
2238 if (best_score
== 0)
2241 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2243 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2244 font_driver_preference
++;
2246 data
[i
].font_driver_preference
= font_driver_preference
;
2249 /* Sort if necessary. */
2252 qsort (data
, len
, sizeof *data
, font_compare
);
2253 for (i
= 0; i
< len
; i
++)
2254 ASET (vec
, i
, data
[i
].entity
);
2263 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2268 /* API of Font Service Layer. */
2270 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2271 sort_shift_bits. Finternal_set_font_selection_order calls this
2272 function with font_sort_order after setting up it. */
2275 font_update_sort_order (int *order
)
2279 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2281 int xlfd_idx
= order
[i
];
2283 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2284 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2285 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2286 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2287 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2288 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2290 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2295 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2300 table
= assq_no_quit (script
, table
);
2303 table
= XCDR (table
);
2304 if (! NILP (langsys
))
2306 table
= assq_no_quit (langsys
, table
);
2312 val
= assq_no_quit (Qnil
, table
);
2314 table
= XCAR (table
);
2318 table
= XCDR (table
);
2319 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2321 if (NILP (XCAR (features
)))
2326 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2332 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2335 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2337 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2339 script
= XCAR (spec
);
2343 langsys
= XCAR (spec
);
2354 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2355 XCAR (otf_capability
)))
2357 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2358 XCDR (otf_capability
)))
2365 /* Check if FONT (font-entity or font-object) matches with the font
2366 specification SPEC. */
2369 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2371 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2372 Lisp_Object extra
, font_extra
;
2375 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2376 if (! NILP (AREF (spec
, i
))
2377 && ! NILP (AREF (font
, i
))
2378 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2380 props
= XFONT_SPEC (spec
)->props
;
2381 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2383 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2384 prop
[i
] = AREF (spec
, i
);
2385 prop
[FONT_SIZE_INDEX
]
2386 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2390 if (font_score (font
, props
) > 0)
2392 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2393 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2394 for (; CONSP (extra
); extra
= XCDR (extra
))
2396 Lisp_Object key
= XCAR (XCAR (extra
));
2397 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2399 if (EQ (key
, QClang
))
2401 val2
= assq_no_quit (key
, font_extra
);
2410 if (NILP (Fmemq (val
, val2
)))
2415 ? NILP (Fmemq (val
, XCDR (val2
)))
2419 else if (EQ (key
, QCscript
))
2421 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2427 /* All characters in the list must be supported. */
2428 for (; CONSP (val2
); val2
= XCDR (val2
))
2430 if (! NATNUMP (XCAR (val2
)))
2432 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2433 == FONT_INVALID_CODE
)
2437 else if (VECTORP (val2
))
2439 /* At most one character in the vector must be supported. */
2440 for (i
= 0; i
< ASIZE (val2
); i
++)
2442 if (! NATNUMP (AREF (val2
, i
)))
2444 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2445 != FONT_INVALID_CODE
)
2448 if (i
== ASIZE (val2
))
2453 else if (EQ (key
, QCotf
))
2457 if (! FONT_OBJECT_P (font
))
2459 fontp
= XFONT_OBJECT (font
);
2460 if (! fontp
->driver
->otf_capability
)
2462 val2
= fontp
->driver
->otf_capability (fontp
);
2463 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2474 Each font backend has the callback function get_cache, and it
2475 returns a cons cell of which cdr part can be freely used for
2476 caching fonts. The cons cell may be shared by multiple frames
2477 and/or multiple font drivers. So, we arrange the cdr part as this:
2479 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2481 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2482 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2483 cons (FONT-SPEC FONT-ENTITY ...). */
2485 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2486 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2487 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2488 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2489 struct font_driver
*);
2492 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2494 Lisp_Object cache
, val
;
2496 cache
= driver
->get_cache (f
);
2498 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2502 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2503 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2507 val
= XCDR (XCAR (val
));
2508 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2514 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2516 Lisp_Object cache
, val
, tmp
;
2519 cache
= driver
->get_cache (f
);
2521 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2522 cache
= val
, val
= XCDR (val
);
2523 font_assert (! NILP (val
));
2524 tmp
= XCDR (XCAR (val
));
2525 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2526 if (XINT (XCAR (tmp
)) == 0)
2528 font_clear_cache (f
, XCAR (val
), driver
);
2529 XSETCDR (cache
, XCDR (val
));
2535 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2537 Lisp_Object val
= driver
->get_cache (f
);
2538 Lisp_Object type
= driver
->type
;
2540 font_assert (CONSP (val
));
2541 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2542 font_assert (CONSP (val
));
2543 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2544 val
= XCDR (XCAR (val
));
2548 static int num_fonts
;
2551 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2553 Lisp_Object tail
, elt
;
2554 Lisp_Object tail2
, entity
;
2556 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2557 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2560 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2561 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2563 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2565 entity
= XCAR (tail2
);
2567 if (FONT_ENTITY_P (entity
)
2568 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2570 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2572 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2574 Lisp_Object val
= XCAR (objlist
);
2575 struct font
*font
= XFONT_OBJECT (val
);
2577 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2579 font_assert (font
&& driver
== font
->driver
);
2580 driver
->close (f
, font
);
2584 if (driver
->free_entity
)
2585 driver
->free_entity (entity
);
2590 XSETCDR (cache
, Qnil
);
2594 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2596 /* Check each font-entity in VEC, and return a list of font-entities
2597 that satisfy this condition:
2598 (1) matches with SPEC and SIZE if SPEC is not nil, and
2599 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2603 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2605 Lisp_Object entity
, val
;
2606 enum font_property_index prop
;
2609 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2611 entity
= AREF (vec
, i
);
2612 if (! NILP (Vface_ignored_fonts
))
2615 Lisp_Object tail
, regexp
;
2617 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2619 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2621 regexp
= XCAR (tail
);
2622 if (STRINGP (regexp
)
2623 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2632 val
= Fcons (entity
, val
);
2635 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2636 if (INTEGERP (AREF (spec
, prop
))
2637 && ((XINT (AREF (spec
, prop
)) >> 8)
2638 != (XINT (AREF (entity
, prop
)) >> 8)))
2639 prop
= FONT_SPEC_MAX
;
2640 if (prop
< FONT_SPEC_MAX
2642 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2644 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2647 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2648 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2649 prop
= FONT_SPEC_MAX
;
2651 if (prop
< FONT_SPEC_MAX
2652 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2653 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2654 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2655 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2656 prop
= FONT_SPEC_MAX
;
2657 if (prop
< FONT_SPEC_MAX
2658 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2659 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2660 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2661 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2662 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2663 prop
= FONT_SPEC_MAX
;
2664 if (prop
< FONT_SPEC_MAX
)
2665 val
= Fcons (entity
, val
);
2667 return (Fvconcat (1, &val
));
2671 /* Return a list of vectors of font-entities matching with SPEC on
2672 FRAME. Each elements in the list is a vector of entities from the
2673 same font-driver. */
2676 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2678 FRAME_PTR f
= XFRAME (frame
);
2679 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2680 Lisp_Object ftype
, val
;
2681 Lisp_Object list
= Qnil
;
2683 int need_filtering
= 0;
2686 font_assert (FONT_SPEC_P (spec
));
2688 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2689 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2690 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2691 size
= font_pixel_size (f
, spec
);
2695 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2696 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2697 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2698 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2700 ASET (scratch_font_spec
, i
, Qnil
);
2701 if (! NILP (AREF (spec
, i
)))
2703 if (i
== FONT_DPI_INDEX
)
2704 /* Skip FONT_SPACING_INDEX */
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
= Fcopy_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
= Fcopy_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
= Fcopy_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
= Fcopy_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
= Fcopy_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 size
, 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
= Fcopy_font_spec (spec
);
3101 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3102 XSETFRAME (frame
, f
);
3103 size
= AREF (spec
, FONT_SIZE_INDEX
);
3104 pixel_size
= font_pixel_size (f
, spec
);
3105 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3107 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3109 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3111 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3112 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3113 if (! NILP (foundry
[0]))
3114 foundry
[1] = null_vector
;
3115 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3117 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3118 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3120 foundry
[2] = null_vector
;
3123 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3125 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3126 if (! NILP (adstyle
[0]))
3127 adstyle
[1] = null_vector
;
3128 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3130 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3132 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3134 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3136 adstyle
[2] = null_vector
;
3139 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3142 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3145 val
= AREF (work
, FONT_FAMILY_INDEX
);
3146 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3148 val
= attrs
[LFACE_FAMILY_INDEX
];
3149 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3153 family
= alloca ((sizeof family
[0]) * 2);
3155 family
[1] = null_vector
; /* terminator. */
3160 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3161 /* Font family names are case-sensitive under NS. */
3169 if (! NILP (alters
))
3171 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3172 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3173 family
[i
] = XCAR (alters
);
3174 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3176 family
[i
] = null_vector
;
3180 family
= alloca ((sizeof family
[0]) * 3);
3183 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3185 family
[i
] = null_vector
;
3189 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3191 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3192 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3194 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3195 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3197 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3198 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3200 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3201 entities
= font_list_entities (frame
, work
);
3202 if (! NILP (entities
))
3204 val
= font_select_entity (frame
, entities
,
3205 attrs
, pixel_size
, c
);
3218 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3222 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3223 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3224 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3225 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3226 size
= font_pixel_size (f
, spec
);
3230 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3231 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3234 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3235 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3236 if (INTEGERP (height
))
3239 abort(); /* We should never end up here. */
3243 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3247 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3248 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3252 return font_open_entity (f
, entity
, size
);
3256 /* Find a font satisfying SPEC and best matching with face's
3257 attributes in ATTRS on FRAME, and return the opened
3261 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3263 Lisp_Object entity
, name
;
3265 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3268 /* No font is listed for SPEC, but each font-backend may have
3269 the different criteria about "font matching". So, try
3271 entity
= font_matching_entity (f
, attrs
, spec
);
3275 /* Don't lose the original name that was put in initially. We need
3276 it to re-apply the font when font parameters (like hinting or dpi) have
3278 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3281 name
= Ffont_get (spec
, QCuser_spec
);
3282 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3288 /* Make FACE on frame F ready to use the font opened for FACE. */
3291 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3293 if (face
->font
->driver
->prepare_face
)
3294 face
->font
->driver
->prepare_face (f
, face
);
3298 /* Make FACE on frame F stop using the font opened for FACE. */
3301 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3303 if (face
->font
->driver
->done_face
)
3304 face
->font
->driver
->done_face (f
, face
);
3309 /* Open a font matching with font-spec SPEC on frame F. If no proper
3310 font is found, return Qnil. */
3313 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3315 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3317 /* We set up the default font-related attributes of a face to prefer
3319 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3320 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3321 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3323 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3325 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3327 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3329 return font_load_for_lface (f
, attrs
, spec
);
3333 /* Open a font matching with NAME on frame F. If no proper font is
3334 found, return Qnil. */
3337 font_open_by_name (FRAME_PTR f
, const char *name
)
3339 Lisp_Object args
[2];
3340 Lisp_Object spec
, ret
;
3343 args
[1] = make_unibyte_string (name
, strlen (name
));
3344 spec
= Ffont_spec (2, args
);
3345 ret
= font_open_by_spec (f
, spec
);
3346 /* Do not lose name originally put in. */
3348 font_put_extra (ret
, QCuser_spec
, args
[1]);
3354 /* Register font-driver DRIVER. This function is used in two ways.
3356 The first is with frame F non-NULL. In this case, make DRIVER
3357 available (but not yet activated) on F. All frame creaters
3358 (e.g. Fx_create_frame) must call this function at least once with
3359 an available font-driver.
3361 The second is with frame F NULL. In this case, DRIVER is globally
3362 registered in the variable `font_driver_list'. All font-driver
3363 implementations must call this function in its syms_of_XXXX
3364 (e.g. syms_of_xfont). */
3367 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3369 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3370 struct font_driver_list
*prev
, *list
;
3372 if (f
&& ! driver
->draw
)
3373 error ("Unusable font driver for a frame: %s",
3374 SDATA (SYMBOL_NAME (driver
->type
)));
3376 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3377 if (EQ (list
->driver
->type
, driver
->type
))
3378 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3380 list
= xmalloc (sizeof (struct font_driver_list
));
3382 list
->driver
= driver
;
3387 f
->font_driver_list
= list
;
3389 font_driver_list
= list
;
3395 free_font_driver_list (FRAME_PTR f
)
3397 struct font_driver_list
*list
, *next
;
3399 for (list
= f
->font_driver_list
; list
; list
= next
)
3404 f
->font_driver_list
= NULL
;
3408 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3409 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3410 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3412 A caller must free all realized faces if any in advance. The
3413 return value is a list of font backends actually made used on
3417 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3419 Lisp_Object active_drivers
= Qnil
;
3420 struct font_driver_list
*list
;
3422 /* At first, turn off non-requested drivers, and turn on requested
3424 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3426 struct font_driver
*driver
= list
->driver
;
3427 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3432 if (driver
->end_for_frame
)
3433 driver
->end_for_frame (f
);
3434 font_finish_cache (f
, driver
);
3439 if (! driver
->start_for_frame
3440 || driver
->start_for_frame (f
) == 0)
3442 font_prepare_cache (f
, driver
);
3449 if (NILP (new_drivers
))
3452 if (! EQ (new_drivers
, Qt
))
3454 /* Re-order the driver list according to new_drivers. */
3455 struct font_driver_list
**list_table
, **next
;
3459 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3460 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3462 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3463 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3466 list_table
[i
++] = list
;
3468 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3470 list_table
[i
++] = list
;
3471 list_table
[i
] = NULL
;
3473 next
= &f
->font_driver_list
;
3474 for (i
= 0; list_table
[i
]; i
++)
3476 *next
= list_table
[i
];
3477 next
= &(*next
)->next
;
3481 if (! f
->font_driver_list
->on
)
3482 { /* None of the drivers is enabled: enable them all.
3483 Happens if you set the list of drivers to (xft x) in your .emacs
3484 and then use it under w32 or ns. */
3485 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3487 struct font_driver
*driver
= list
->driver
;
3488 eassert (! list
->on
);
3489 if (! driver
->start_for_frame
3490 || driver
->start_for_frame (f
) == 0)
3492 font_prepare_cache (f
, driver
);
3499 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3501 active_drivers
= nconc2 (active_drivers
,
3502 Fcons (list
->driver
->type
, Qnil
));
3503 return active_drivers
;
3507 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3509 struct font_data_list
*list
, *prev
;
3511 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3512 prev
= list
, list
= list
->next
)
3513 if (list
->driver
== driver
)
3520 prev
->next
= list
->next
;
3522 f
->font_data_list
= list
->next
;
3530 list
= xmalloc (sizeof (struct font_data_list
));
3531 list
->driver
= driver
;
3532 list
->next
= f
->font_data_list
;
3533 f
->font_data_list
= list
;
3541 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3543 struct font_data_list
*list
;
3545 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3546 if (list
->driver
== driver
)
3554 /* Sets attributes on a font. Any properties that appear in ALIST and
3555 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3556 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3557 arrays of strings. This function is intended for use by the font
3558 drivers to implement their specific font_filter_properties. */
3560 font_filter_properties (Lisp_Object font
,
3562 const char *const boolean_properties
[],
3563 const char *const non_boolean_properties
[])
3568 /* Set boolean values to Qt or Qnil */
3569 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3570 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3572 Lisp_Object key
= XCAR (XCAR (it
));
3573 Lisp_Object val
= XCDR (XCAR (it
));
3574 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3576 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3578 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3579 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3582 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3583 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3584 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3585 || strcmp ("Off", str
) == 0)
3590 Ffont_put (font
, key
, val
);
3594 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3595 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3597 Lisp_Object key
= XCAR (XCAR (it
));
3598 Lisp_Object val
= XCDR (XCAR (it
));
3599 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3600 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3601 Ffont_put (font
, key
, val
);
3606 /* Return the font used to draw character C by FACE at buffer position
3607 POS in window W. If STRING is non-nil, it is a string containing C
3608 at index POS. If C is negative, get C from the current buffer or
3612 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3617 Lisp_Object font_object
;
3619 multibyte
= (NILP (string
)
3620 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3621 : STRING_MULTIBYTE (string
));
3628 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3630 c
= FETCH_CHAR (pos_byte
);
3633 c
= FETCH_BYTE (pos
);
3639 multibyte
= STRING_MULTIBYTE (string
);
3642 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3644 str
= SDATA (string
) + pos_byte
;
3645 c
= STRING_CHAR (str
);
3648 c
= SDATA (string
)[pos
];
3652 f
= XFRAME (w
->frame
);
3653 if (! FRAME_WINDOW_P (f
))
3660 if (STRINGP (string
))
3661 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3662 DEFAULT_FACE_ID
, 0);
3664 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3666 face
= FACE_FROM_ID (f
, face_id
);
3670 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3671 face
= FACE_FROM_ID (f
, face_id
);
3676 XSETFONT (font_object
, face
->font
);
3681 #ifdef HAVE_WINDOW_SYSTEM
3683 /* Check how many characters after POS (at most to *LIMIT) can be
3684 displayed by the same font on the window W. FACE, if non-NULL, is
3685 the face selected for the character at POS. If STRING is not nil,
3686 it is the string to check instead of the current buffer. In that
3687 case, FACE must be not NULL.
3689 The return value is the font-object for the character at POS.
3690 *LIMIT is set to the position where that font can't be used.
3692 It is assured that the current buffer (or STRING) is multibyte. */
3695 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3697 EMACS_INT pos_byte
, ignore
;
3699 Lisp_Object font_object
= Qnil
;
3703 pos_byte
= CHAR_TO_BYTE (pos
);
3708 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3710 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3716 pos_byte
= string_char_to_byte (string
, pos
);
3719 while (pos
< *limit
)
3721 Lisp_Object category
;
3724 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3726 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3727 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3728 if (EQ (category
, QCf
)
3729 || CHAR_VARIATION_SELECTOR_P (c
))
3731 if (NILP (font_object
))
3733 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3734 if (NILP (font_object
))
3738 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3748 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3749 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3750 Return nil otherwise.
3751 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3752 which kind of font it is. It must be one of `font-spec', `font-entity',
3754 (Lisp_Object object
, Lisp_Object extra_type
)
3756 if (NILP (extra_type
))
3757 return (FONTP (object
) ? Qt
: Qnil
);
3758 if (EQ (extra_type
, Qfont_spec
))
3759 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3760 if (EQ (extra_type
, Qfont_entity
))
3761 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3762 if (EQ (extra_type
, Qfont_object
))
3763 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3764 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3767 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3768 doc
: /* Return a newly created font-spec with arguments as properties.
3770 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3771 valid font property name listed below:
3773 `:family', `:weight', `:slant', `:width'
3775 They are the same as face attributes of the same name. See
3776 `set-face-attribute'.
3780 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3784 VALUE must be a string or a symbol specifying the additional
3785 typographic style information of a font, e.g. ``sans''.
3789 VALUE must be a string or a symbol specifying the charset registry and
3790 encoding of a font, e.g. ``iso8859-1''.
3794 VALUE must be a non-negative integer or a floating point number
3795 specifying the font size. It specifies the font size in pixels (if
3796 VALUE is an integer), or in points (if VALUE is a float).
3800 VALUE must be a string of XLFD-style or fontconfig-style font name.
3804 VALUE must be a symbol representing a script that the font must
3805 support. It may be a symbol representing a subgroup of a script
3806 listed in the variable `script-representative-chars'.
3810 VALUE must be a symbol of two-letter ISO-639 language names,
3815 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3816 required OpenType features.
3818 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3819 LANGSYS-TAG: OpenType language system tag symbol,
3820 or nil for the default language system.
3821 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3822 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3824 GSUB and GPOS may contain `nil' element. In such a case, the font
3825 must not have any of the remaining elements.
3827 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3828 be an OpenType font, and whose GPOS table of `thai' script's default
3829 language system must contain `mark' feature.
3831 usage: (font-spec ARGS...) */)
3832 (int nargs
, Lisp_Object
*args
)
3834 Lisp_Object spec
= font_make_spec ();
3837 for (i
= 0; i
< nargs
; i
+= 2)
3839 Lisp_Object key
= args
[i
], val
;
3843 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3846 if (EQ (key
, QCname
))
3849 font_parse_name (SSDATA (val
), spec
);
3850 font_put_extra (spec
, key
, val
);
3854 int idx
= get_font_prop_index (key
);
3858 val
= font_prop_validate (idx
, Qnil
, val
);
3859 if (idx
< FONT_EXTRA_INDEX
)
3860 ASET (spec
, idx
, val
);
3862 font_put_extra (spec
, key
, val
);
3865 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3871 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3872 doc
: /* Return a copy of FONT as a font-spec. */)
3875 Lisp_Object new_spec
, tail
, prev
, extra
;
3879 new_spec
= font_make_spec ();
3880 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3881 ASET (new_spec
, i
, AREF (font
, i
));
3882 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3883 /* We must remove :font-entity property. */
3884 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3885 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3888 extra
= XCDR (extra
);
3890 XSETCDR (prev
, XCDR (tail
));
3893 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3897 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3898 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3899 Every specified properties in FROM override the corresponding
3900 properties in TO. */)
3901 (Lisp_Object from
, Lisp_Object to
)
3903 Lisp_Object extra
, tail
;
3908 to
= Fcopy_font_spec (to
);
3909 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3910 ASET (to
, i
, AREF (from
, i
));
3911 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3912 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3913 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3915 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3918 XSETCDR (slot
, XCDR (XCAR (tail
)));
3920 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3922 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3926 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3927 doc
: /* Return the value of FONT's property KEY.
3928 FONT is a font-spec, a font-entity, or a font-object.
3929 KEY is any symbol, but these are reserved for specific meanings:
3930 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3931 :size, :name, :script, :otf
3932 See the documentation of `font-spec' for their meanings.
3933 In addition, if FONT is a font-entity or a font-object, values of
3934 :script and :otf are different from those of a font-spec as below:
3936 The value of :script may be a list of scripts that are supported by the font.
3938 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3939 representing the OpenType features supported by the font by this form:
3940 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3941 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3943 (Lisp_Object font
, Lisp_Object key
)
3951 idx
= get_font_prop_index (key
);
3952 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3953 return font_style_symbolic (font
, idx
, 0);
3954 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3955 return AREF (font
, idx
);
3956 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3957 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3959 struct font
*fontp
= XFONT_OBJECT (font
);
3961 if (fontp
->driver
->otf_capability
)
3962 val
= fontp
->driver
->otf_capability (fontp
);
3964 val
= Fcons (Qnil
, Qnil
);
3971 #ifdef HAVE_WINDOW_SYSTEM
3973 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3974 doc
: /* Return a plist of face attributes generated by FONT.
3975 FONT is a font name, a font-spec, a font-entity, or a font-object.
3976 The return value is a list of the form
3978 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3980 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3981 compatible with `set-face-attribute'. Some of these key-attribute pairs
3982 may be omitted from the list if they are not specified by FONT.
3984 The optional argument FRAME specifies the frame that the face attributes
3985 are to be displayed on. If omitted, the selected frame is used. */)
3986 (Lisp_Object font
, Lisp_Object frame
)
3989 Lisp_Object plist
[10];
3994 frame
= selected_frame
;
3995 CHECK_LIVE_FRAME (frame
);
4000 int fontset
= fs_query_fontset (font
, 0);
4001 Lisp_Object name
= font
;
4003 font
= fontset_ascii (fontset
);
4004 font
= font_spec_from_name (name
);
4006 signal_error ("Invalid font name", name
);
4008 else if (! FONTP (font
))
4009 signal_error ("Invalid font object", font
);
4011 val
= AREF (font
, FONT_FAMILY_INDEX
);
4014 plist
[n
++] = QCfamily
;
4015 plist
[n
++] = SYMBOL_NAME (val
);
4018 val
= AREF (font
, FONT_SIZE_INDEX
);
4021 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4022 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4023 plist
[n
++] = QCheight
;
4024 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4026 else if (FLOATP (val
))
4028 plist
[n
++] = QCheight
;
4029 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4032 val
= FONT_WEIGHT_FOR_FACE (font
);
4035 plist
[n
++] = QCweight
;
4039 val
= FONT_SLANT_FOR_FACE (font
);
4042 plist
[n
++] = QCslant
;
4046 val
= FONT_WIDTH_FOR_FACE (font
);
4049 plist
[n
++] = QCwidth
;
4053 return Flist (n
, plist
);
4058 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4059 doc
: /* Set one property of FONT: give property KEY value VAL.
4060 FONT is a font-spec, a font-entity, or a font-object.
4062 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4063 accepted by the function `font-spec' (which see), VAL must be what
4064 allowed in `font-spec'.
4066 If FONT is a font-entity or a font-object, KEY must not be the one
4067 accepted by `font-spec'. */)
4068 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4072 idx
= get_font_prop_index (prop
);
4073 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4075 CHECK_FONT_SPEC (font
);
4076 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4080 if (EQ (prop
, QCname
)
4081 || EQ (prop
, QCscript
)
4082 || EQ (prop
, QClang
)
4083 || EQ (prop
, QCotf
))
4084 CHECK_FONT_SPEC (font
);
4087 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4092 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4093 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4094 Optional 2nd argument FRAME specifies the target frame.
4095 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4096 Optional 4th argument PREFER, if non-nil, is a font-spec to
4097 control the order of the returned list. Fonts are sorted by
4098 how close they are to PREFER. */)
4099 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4101 Lisp_Object vec
, list
;
4105 frame
= selected_frame
;
4106 CHECK_LIVE_FRAME (frame
);
4107 CHECK_FONT_SPEC (font_spec
);
4115 if (! NILP (prefer
))
4116 CHECK_FONT_SPEC (prefer
);
4118 list
= font_list_entities (frame
, font_spec
);
4121 if (NILP (XCDR (list
))
4122 && ASIZE (XCAR (list
)) == 1)
4123 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4125 if (! NILP (prefer
))
4126 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4128 vec
= font_vconcat_entity_vectors (list
);
4129 if (n
== 0 || n
>= ASIZE (vec
))
4131 Lisp_Object args
[2];
4135 list
= Fappend (2, args
);
4139 for (list
= Qnil
, n
--; n
>= 0; n
--)
4140 list
= Fcons (AREF (vec
, n
), list
);
4145 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4146 doc
: /* List available font families on the current frame.
4147 Optional argument FRAME, if non-nil, specifies the target frame. */)
4151 struct font_driver_list
*driver_list
;
4155 frame
= selected_frame
;
4156 CHECK_LIVE_FRAME (frame
);
4159 for (driver_list
= f
->font_driver_list
; driver_list
;
4160 driver_list
= driver_list
->next
)
4161 if (driver_list
->driver
->list_family
)
4163 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4164 Lisp_Object tail
= list
;
4166 for (; CONSP (val
); val
= XCDR (val
))
4167 if (NILP (Fmemq (XCAR (val
), tail
))
4168 && SYMBOLP (XCAR (val
)))
4169 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4174 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4175 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4176 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4177 (Lisp_Object font_spec
, Lisp_Object frame
)
4179 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4186 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4187 doc
: /* Return XLFD name of FONT.
4188 FONT is a font-spec, font-entity, or font-object.
4189 If the name is too long for XLFD (maximum 255 chars), return nil.
4190 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4191 the consecutive wildcards are folded to one. */)
4192 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4199 if (FONT_OBJECT_P (font
))
4201 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4203 if (STRINGP (font_name
)
4204 && SDATA (font_name
)[0] == '-')
4206 if (NILP (fold_wildcards
))
4208 strcpy (name
, SSDATA (font_name
));
4211 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4213 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4216 if (! NILP (fold_wildcards
))
4218 char *p0
= name
, *p1
;
4220 while ((p1
= strstr (p0
, "-*-*")))
4222 strcpy (p1
, p1
+ 2);
4227 return build_string (name
);
4230 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4231 doc
: /* Clear font cache. */)
4234 Lisp_Object list
, frame
;
4236 FOR_EACH_FRAME (list
, frame
)
4238 FRAME_PTR f
= XFRAME (frame
);
4239 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4241 for (; driver_list
; driver_list
= driver_list
->next
)
4242 if (driver_list
->on
)
4244 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4245 Lisp_Object val
, tmp
;
4249 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4251 font_assert (! NILP (val
));
4252 tmp
= XCDR (XCAR (val
));
4253 if (XINT (XCAR (tmp
)) == 0)
4255 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4256 XSETCDR (cache
, XCDR (val
));
4266 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4268 struct font
*font
= XFONT_OBJECT (font_object
);
4270 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4271 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4272 struct font_metrics metrics
;
4274 LGLYPH_SET_CODE (glyph
, ecode
);
4276 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4277 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4278 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4279 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4280 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4281 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4285 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4286 doc
: /* Shape the glyph-string GSTRING.
4287 Shaping means substituting glyphs and/or adjusting positions of glyphs
4288 to get the correct visual image of character sequences set in the
4289 header of the glyph-string.
4291 If the shaping was successful, the value is GSTRING itself or a newly
4292 created glyph-string. Otherwise, the value is nil. */)
4293 (Lisp_Object gstring
)
4296 Lisp_Object font_object
, n
, glyph
;
4299 if (! composition_gstring_p (gstring
))
4300 signal_error ("Invalid glyph-string: ", gstring
);
4301 if (! NILP (LGSTRING_ID (gstring
)))
4303 font_object
= LGSTRING_FONT (gstring
);
4304 CHECK_FONT_OBJECT (font_object
);
4305 font
= XFONT_OBJECT (font_object
);
4306 if (! font
->driver
->shape
)
4309 /* Try at most three times with larger gstring each time. */
4310 for (i
= 0; i
< 3; i
++)
4312 n
= font
->driver
->shape (gstring
);
4315 gstring
= larger_vector (gstring
,
4316 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4319 if (i
== 3 || XINT (n
) == 0)
4321 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4322 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4324 glyph
= LGSTRING_GLYPH (gstring
, 0);
4325 from
= LGLYPH_FROM (glyph
);
4326 to
= LGLYPH_TO (glyph
);
4327 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4329 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4333 if (NILP (LGLYPH_ADJUSTMENT (this)))
4338 glyph
= LGSTRING_GLYPH (gstring
, j
);
4339 LGLYPH_SET_FROM (glyph
, from
);
4340 LGLYPH_SET_TO (glyph
, to
);
4342 from
= LGLYPH_FROM (this);
4343 to
= LGLYPH_TO (this);
4348 if (from
> LGLYPH_FROM (this))
4349 from
= LGLYPH_FROM (this);
4350 if (to
< LGLYPH_TO (this))
4351 to
= LGLYPH_TO (this);
4357 glyph
= LGSTRING_GLYPH (gstring
, j
);
4358 LGLYPH_SET_FROM (glyph
, from
);
4359 LGLYPH_SET_TO (glyph
, to
);
4361 return composition_gstring_put_cache (gstring
, XINT (n
));
4364 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4366 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4367 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4369 VARIATION-SELECTOR is a character code of variation selection
4370 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4371 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4372 (Lisp_Object font_object
, Lisp_Object character
)
4374 unsigned variations
[256];
4379 CHECK_FONT_OBJECT (font_object
);
4380 CHECK_CHARACTER (character
);
4381 font
= XFONT_OBJECT (font_object
);
4382 if (! font
->driver
->get_variation_glyphs
)
4384 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4388 for (i
= 0; i
< 255; i
++)
4392 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4393 /* Stops GCC whining about limited range of data type. */
4394 EMACS_INT var
= variations
[i
];
4396 if (var
> MOST_POSITIVE_FIXNUM
)
4397 code
= Fcons (make_number ((variations
[i
]) >> 16),
4398 make_number ((variations
[i
]) & 0xFFFF));
4400 code
= make_number (variations
[i
]);
4401 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4408 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4409 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4410 OTF-FEATURES specifies which features to apply in this format:
4411 (SCRIPT LANGSYS GSUB GPOS)
4413 SCRIPT is a symbol specifying a script tag of OpenType,
4414 LANGSYS is a symbol specifying a langsys tag of OpenType,
4415 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4417 If LANGYS is nil, the default langsys is selected.
4419 The features are applied in the order they appear in the list. The
4420 symbol `*' means to apply all available features not present in this
4421 list, and the remaining features are ignored. For instance, (vatu
4422 pstf * haln) is to apply vatu and pstf in this order, then to apply
4423 all available features other than vatu, pstf, and haln.
4425 The features are applied to the glyphs in the range FROM and TO of
4426 the glyph-string GSTRING-IN.
4428 If some feature is actually applicable, the resulting glyphs are
4429 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4430 this case, the value is the number of produced glyphs.
4432 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4435 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4436 produced in GSTRING-OUT, and the value is nil.
4438 See the documentation of `font-make-gstring' for the format of
4440 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4442 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4447 check_otf_features (otf_features
);
4448 CHECK_FONT_OBJECT (font_object
);
4449 font
= XFONT_OBJECT (font_object
);
4450 if (! font
->driver
->otf_drive
)
4451 error ("Font backend %s can't drive OpenType GSUB table",
4452 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4453 CHECK_CONS (otf_features
);
4454 CHECK_SYMBOL (XCAR (otf_features
));
4455 val
= XCDR (otf_features
);
4456 CHECK_SYMBOL (XCAR (val
));
4457 val
= XCDR (otf_features
);
4460 len
= check_gstring (gstring_in
);
4461 CHECK_VECTOR (gstring_out
);
4462 CHECK_NATNUM (from
);
4464 CHECK_NATNUM (index
);
4466 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4467 args_out_of_range_3 (from
, to
, make_number (len
));
4468 if (XINT (index
) >= ASIZE (gstring_out
))
4469 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4470 num
= font
->driver
->otf_drive (font
, otf_features
,
4471 gstring_in
, XINT (from
), XINT (to
),
4472 gstring_out
, XINT (index
), 0);
4475 return make_number (num
);
4478 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4480 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4481 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4483 (SCRIPT LANGSYS FEATURE ...)
4484 See the documentation of `font-drive-otf' for more detail.
4486 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4487 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4488 character code corresponding to the glyph or nil if there's no
4489 corresponding character. */)
4490 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4493 Lisp_Object gstring_in
, gstring_out
, g
;
4494 Lisp_Object alternates
;
4497 CHECK_FONT_GET_OBJECT (font_object
, font
);
4498 if (! font
->driver
->otf_drive
)
4499 error ("Font backend %s can't drive OpenType GSUB table",
4500 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4501 CHECK_CHARACTER (character
);
4502 CHECK_CONS (otf_features
);
4504 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4505 g
= LGSTRING_GLYPH (gstring_in
, 0);
4506 LGLYPH_SET_CHAR (g
, XINT (character
));
4507 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4508 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4509 gstring_out
, 0, 1)) < 0)
4510 gstring_out
= Ffont_make_gstring (font_object
,
4511 make_number (ASIZE (gstring_out
) * 2));
4513 for (i
= 0; i
< num
; i
++)
4515 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4516 int c
= LGLYPH_CHAR (g
);
4517 unsigned code
= LGLYPH_CODE (g
);
4519 alternates
= Fcons (Fcons (make_number (code
),
4520 c
> 0 ? make_number (c
) : Qnil
),
4523 return Fnreverse (alternates
);
4529 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4530 doc
: /* Open FONT-ENTITY. */)
4531 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4535 CHECK_FONT_ENTITY (font_entity
);
4537 frame
= selected_frame
;
4538 CHECK_LIVE_FRAME (frame
);
4541 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4544 CHECK_NUMBER_OR_FLOAT (size
);
4546 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4548 isize
= XINT (size
);
4552 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4555 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4556 doc
: /* Close FONT-OBJECT. */)
4557 (Lisp_Object font_object
, Lisp_Object frame
)
4559 CHECK_FONT_OBJECT (font_object
);
4561 frame
= selected_frame
;
4562 CHECK_LIVE_FRAME (frame
);
4563 font_close_object (XFRAME (frame
), font_object
);
4567 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4568 doc
: /* Return information about FONT-OBJECT.
4569 The value is a vector:
4570 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4573 NAME is a string of the font name (or nil if the font backend doesn't
4576 FILENAME is a string of the font file (or nil if the font backend
4577 doesn't provide a file name).
4579 PIXEL-SIZE is a pixel size by which the font is opened.
4581 SIZE is a maximum advance width of the font in pixels.
4583 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4586 CAPABILITY is a list whose first element is a symbol representing the
4587 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4588 remaining elements describe the details of the font capability.
4590 If the font is OpenType font, the form of the list is
4591 \(opentype GSUB GPOS)
4592 where GSUB shows which "GSUB" features the font supports, and GPOS
4593 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4594 lists of the format:
4595 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4597 If the font is not OpenType font, currently the length of the form is
4600 SCRIPT is a symbol representing OpenType script tag.
4602 LANGSYS is a symbol representing OpenType langsys tag, or nil
4603 representing the default langsys.
4605 FEATURE is a symbol representing OpenType feature tag.
4607 If the font is not OpenType font, CAPABILITY is nil. */)
4608 (Lisp_Object font_object
)
4613 CHECK_FONT_GET_OBJECT (font_object
, font
);
4615 val
= Fmake_vector (make_number (9), Qnil
);
4616 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4617 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4618 ASET (val
, 2, make_number (font
->pixel_size
));
4619 ASET (val
, 3, make_number (font
->max_width
));
4620 ASET (val
, 4, make_number (font
->ascent
));
4621 ASET (val
, 5, make_number (font
->descent
));
4622 ASET (val
, 6, make_number (font
->space_width
));
4623 ASET (val
, 7, make_number (font
->average_width
));
4624 if (font
->driver
->otf_capability
)
4625 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4629 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4631 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4632 FROM and TO are positions (integers or markers) specifying a region
4633 of the current buffer.
4634 If the optional fourth arg OBJECT is not nil, it is a string or a
4635 vector containing the target characters.
4637 Each element is a vector containing information of a glyph in this format:
4638 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4640 FROM is an index numbers of a character the glyph corresponds to.
4641 TO is the same as FROM.
4642 C is the character of the glyph.
4643 CODE is the glyph-code of C in FONT-OBJECT.
4644 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4645 ADJUSTMENT is always nil.
4646 If FONT-OBJECT doesn't have a glyph for a character,
4647 the corresponding element is nil. */)
4648 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4653 Lisp_Object
*chars
, vec
;
4656 CHECK_FONT_GET_OBJECT (font_object
, font
);
4659 EMACS_INT charpos
, bytepos
;
4661 validate_region (&from
, &to
);
4664 len
= XFASTINT (to
) - XFASTINT (from
);
4665 SAFE_ALLOCA_LISP (chars
, len
);
4666 charpos
= XFASTINT (from
);
4667 bytepos
= CHAR_TO_BYTE (charpos
);
4668 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4671 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4672 chars
[i
] = make_number (c
);
4675 else if (STRINGP (object
))
4677 const unsigned char *p
;
4679 CHECK_NUMBER (from
);
4681 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4682 || XINT (to
) > SCHARS (object
))
4683 args_out_of_range_3 (object
, from
, to
);
4686 len
= XFASTINT (to
) - XFASTINT (from
);
4687 SAFE_ALLOCA_LISP (chars
, len
);
4689 if (STRING_MULTIBYTE (object
))
4690 for (i
= 0; i
< len
; i
++)
4692 int c
= STRING_CHAR_ADVANCE (p
);
4693 chars
[i
] = make_number (c
);
4696 for (i
= 0; i
< len
; i
++)
4697 chars
[i
] = make_number (p
[i
]);
4701 CHECK_VECTOR (object
);
4702 CHECK_NUMBER (from
);
4704 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4705 || XINT (to
) > ASIZE (object
))
4706 args_out_of_range_3 (object
, from
, to
);
4709 len
= XFASTINT (to
) - XFASTINT (from
);
4710 for (i
= 0; i
< len
; i
++)
4712 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4713 CHECK_CHARACTER (elt
);
4715 chars
= &(AREF (object
, XFASTINT (from
)));
4718 vec
= Fmake_vector (make_number (len
), Qnil
);
4719 for (i
= 0; i
< len
; i
++)
4722 int c
= XFASTINT (chars
[i
]);
4725 struct font_metrics metrics
;
4727 cod
= code
= font
->driver
->encode_char (font
, c
);
4728 if (code
== FONT_INVALID_CODE
)
4730 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4731 LGLYPH_SET_FROM (g
, i
);
4732 LGLYPH_SET_TO (g
, i
);
4733 LGLYPH_SET_CHAR (g
, c
);
4734 LGLYPH_SET_CODE (g
, code
);
4735 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4736 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4737 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4738 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4739 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4740 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4743 if (! VECTORP (object
))
4748 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4749 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4750 FONT is a font-spec, font-entity, or font-object. */)
4751 (Lisp_Object spec
, Lisp_Object font
)
4753 CHECK_FONT_SPEC (spec
);
4756 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4759 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4760 doc
: /* Return a font-object for displaying a character at POSITION.
4761 Optional second arg WINDOW, if non-nil, is a window displaying
4762 the current buffer. It defaults to the currently selected window. */)
4763 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4770 CHECK_NUMBER_COERCE_MARKER (position
);
4771 pos
= XINT (position
);
4772 if (pos
< BEGV
|| pos
>= ZV
)
4773 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4777 CHECK_NUMBER (position
);
4778 CHECK_STRING (string
);
4779 pos
= XINT (position
);
4780 if (pos
< 0 || pos
>= SCHARS (string
))
4781 args_out_of_range (string
, position
);
4784 window
= selected_window
;
4785 CHECK_LIVE_WINDOW (window
);
4786 w
= XWINDOW (window
);
4788 return font_at (-1, pos
, NULL
, w
, string
);
4792 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4793 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4794 The value is a number of glyphs drawn.
4795 Type C-l to recover what previously shown. */)
4796 (Lisp_Object font_object
, Lisp_Object string
)
4798 Lisp_Object frame
= selected_frame
;
4799 FRAME_PTR f
= XFRAME (frame
);
4805 CHECK_FONT_GET_OBJECT (font_object
, font
);
4806 CHECK_STRING (string
);
4807 len
= SCHARS (string
);
4808 code
= alloca (sizeof (unsigned) * len
);
4809 for (i
= 0; i
< len
; i
++)
4811 Lisp_Object ch
= Faref (string
, make_number (i
));
4815 code
[i
] = font
->driver
->encode_char (font
, c
);
4816 if (code
[i
] == FONT_INVALID_CODE
)
4819 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4821 if (font
->driver
->prepare_face
)
4822 font
->driver
->prepare_face (f
, face
);
4823 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4824 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4825 if (font
->driver
->done_face
)
4826 font
->driver
->done_face (f
, face
);
4828 return make_number (len
);
4832 #endif /* FONT_DEBUG */
4834 #ifdef HAVE_WINDOW_SYSTEM
4836 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4837 doc
: /* Return information about a font named NAME on frame FRAME.
4838 If FRAME is omitted or nil, use the selected frame.
4839 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4840 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4842 OPENED-NAME is the name used for opening the font,
4843 FULL-NAME is the full name of the font,
4844 SIZE is the pixelsize of the font,
4845 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4846 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4847 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4848 how to compose characters.
4849 If the named font is not yet loaded, return nil. */)
4850 (Lisp_Object name
, Lisp_Object frame
)
4855 Lisp_Object font_object
;
4857 (*check_window_system_func
) ();
4860 CHECK_STRING (name
);
4862 frame
= selected_frame
;
4863 CHECK_LIVE_FRAME (frame
);
4868 int fontset
= fs_query_fontset (name
, 0);
4871 name
= fontset_ascii (fontset
);
4872 font_object
= font_open_by_name (f
, SSDATA (name
));
4874 else if (FONT_OBJECT_P (name
))
4876 else if (FONT_ENTITY_P (name
))
4877 font_object
= font_open_entity (f
, name
, 0);
4880 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4881 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4883 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4885 if (NILP (font_object
))
4887 font
= XFONT_OBJECT (font_object
);
4889 info
= Fmake_vector (make_number (7), Qnil
);
4890 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4891 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4892 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4893 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4894 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4895 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4896 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4899 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4900 close it now. Perhaps, we should manage font-objects
4901 by `reference-count'. */
4902 font_close_object (f
, font_object
);
4909 #define BUILD_STYLE_TABLE(TBL) \
4910 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4913 build_style_table (const struct table_entry
*entry
, int nelement
)
4916 Lisp_Object table
, elt
;
4918 table
= Fmake_vector (make_number (nelement
), Qnil
);
4919 for (i
= 0; i
< nelement
; i
++)
4921 for (j
= 0; entry
[i
].names
[j
]; j
++);
4922 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4923 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4924 for (j
= 0; entry
[i
].names
[j
]; j
++)
4925 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4926 ASET (table
, i
, elt
);
4931 /* The deferred font-log data of the form [ACTION ARG RESULT].
4932 If ACTION is not nil, that is added to the log when font_add_log is
4933 called next time. At that time, ACTION is set back to nil. */
4934 static Lisp_Object Vfont_log_deferred
;
4936 /* Prepend the font-related logging data in Vfont_log if it is not
4937 `t'. ACTION describes a kind of font-related action (e.g. listing,
4938 opening), ARG is the argument for the action, and RESULT is the
4939 result of the action. */
4941 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4946 if (EQ (Vfont_log
, Qt
))
4948 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4950 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4952 ASET (Vfont_log_deferred
, 0, Qnil
);
4953 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4954 AREF (Vfont_log_deferred
, 2));
4959 Lisp_Object tail
, elt
;
4960 Lisp_Object equalstr
= build_string ("=");
4962 val
= Ffont_xlfd_name (arg
, Qt
);
4963 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4967 if (EQ (XCAR (elt
), QCscript
)
4968 && SYMBOLP (XCDR (elt
)))
4969 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4970 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4971 else if (EQ (XCAR (elt
), QClang
)
4972 && SYMBOLP (XCDR (elt
)))
4973 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4974 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4975 else if (EQ (XCAR (elt
), QCotf
)
4976 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4977 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4979 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4985 && VECTORP (XCAR (result
))
4986 && ASIZE (XCAR (result
)) > 0
4987 && FONTP (AREF (XCAR (result
), 0)))
4988 result
= font_vconcat_entity_vectors (result
);
4991 val
= Ffont_xlfd_name (result
, Qt
);
4992 if (! FONT_SPEC_P (result
))
4993 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4994 build_string (":"), val
);
4997 else if (CONSP (result
))
5000 result
= Fcopy_sequence (result
);
5001 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5005 val
= Ffont_xlfd_name (val
, Qt
);
5006 XSETCAR (tail
, val
);
5009 else if (VECTORP (result
))
5011 result
= Fcopy_sequence (result
);
5012 for (i
= 0; i
< ASIZE (result
); i
++)
5014 val
= AREF (result
, i
);
5016 val
= Ffont_xlfd_name (val
, Qt
);
5017 ASET (result
, i
, val
);
5020 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5023 /* Record a font-related logging data to be added to Vfont_log when
5024 font_add_log is called next time. ACTION, ARG, RESULT are the same
5028 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5030 if (EQ (Vfont_log
, Qt
))
5032 ASET (Vfont_log_deferred
, 0, build_string (action
));
5033 ASET (Vfont_log_deferred
, 1, arg
);
5034 ASET (Vfont_log_deferred
, 2, result
);
5040 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5041 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5042 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5043 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5044 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5045 /* Note that the other elements in sort_shift_bits are not used. */
5047 staticpro (&font_charset_alist
);
5048 font_charset_alist
= Qnil
;
5050 DEFSYM (Qopentype
, "opentype");
5052 DEFSYM (Qascii_0
, "ascii-0");
5053 DEFSYM (Qiso8859_1
, "iso8859-1");
5054 DEFSYM (Qiso10646_1
, "iso10646-1");
5055 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5056 DEFSYM (Qunicode_sip
, "unicode-sip");
5060 DEFSYM (QCotf
, ":otf");
5061 DEFSYM (QClang
, ":lang");
5062 DEFSYM (QCscript
, ":script");
5063 DEFSYM (QCantialias
, ":antialias");
5065 DEFSYM (QCfoundry
, ":foundry");
5066 DEFSYM (QCadstyle
, ":adstyle");
5067 DEFSYM (QCregistry
, ":registry");
5068 DEFSYM (QCspacing
, ":spacing");
5069 DEFSYM (QCdpi
, ":dpi");
5070 DEFSYM (QCscalable
, ":scalable");
5071 DEFSYM (QCavgwidth
, ":avgwidth");
5072 DEFSYM (QCfont_entity
, ":font-entity");
5073 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5083 DEFSYM (QCuser_spec
, "user-spec");
5085 staticpro (&null_vector
);
5086 null_vector
= Fmake_vector (make_number (0), Qnil
);
5088 staticpro (&scratch_font_spec
);
5089 scratch_font_spec
= Ffont_spec (0, NULL
);
5090 staticpro (&scratch_font_prefer
);
5091 scratch_font_prefer
= Ffont_spec (0, NULL
);
5093 staticpro (&Vfont_log_deferred
);
5094 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5098 staticpro (&otf_list
);
5100 #endif /* HAVE_LIBOTF */
5104 defsubr (&Sfont_spec
);
5105 defsubr (&Sfont_get
);
5106 #ifdef HAVE_WINDOW_SYSTEM
5107 defsubr (&Sfont_face_attributes
);
5109 defsubr (&Sfont_put
);
5110 defsubr (&Slist_fonts
);
5111 defsubr (&Sfont_family_list
);
5112 defsubr (&Sfind_font
);
5113 defsubr (&Sfont_xlfd_name
);
5114 defsubr (&Sclear_font_cache
);
5115 defsubr (&Sfont_shape_gstring
);
5116 defsubr (&Sfont_variation_glyphs
);
5118 defsubr (&Sfont_drive_otf
);
5119 defsubr (&Sfont_otf_alternates
);
5123 defsubr (&Sopen_font
);
5124 defsubr (&Sclose_font
);
5125 defsubr (&Squery_font
);
5126 defsubr (&Sfont_get_glyphs
);
5127 defsubr (&Sfont_match_p
);
5128 defsubr (&Sfont_at
);
5130 defsubr (&Sdraw_string
);
5132 #endif /* FONT_DEBUG */
5133 #ifdef HAVE_WINDOW_SYSTEM
5134 defsubr (&Sfont_info
);
5137 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5139 Alist of fontname patterns vs the corresponding encoding and repertory info.
5140 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5141 where ENCODING is a charset or a char-table,
5142 and REPERTORY is a charset, a char-table, or nil.
5144 If ENCODING and REPERTORY are the same, the element can have the form
5145 \(REGEXP . ENCODING).
5147 ENCODING is for converting a character to a glyph code of the font.
5148 If ENCODING is a charset, encoding a character by the charset gives
5149 the corresponding glyph code. If ENCODING is a char-table, looking up
5150 the table by a character gives the corresponding glyph code.
5152 REPERTORY specifies a repertory of characters supported by the font.
5153 If REPERTORY is a charset, all characters beloging to the charset are
5154 supported. If REPERTORY is a char-table, all characters who have a
5155 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5156 gets the repertory information by an opened font and ENCODING. */);
5157 Vfont_encoding_alist
= Qnil
;
5159 /* FIXME: These 3 vars are not quite what they appear: setq on them
5160 won't have any effect other than disconnect them from the style
5161 table used by the font display code. So we make them read-only,
5162 to avoid this confusing situation. */
5164 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5165 doc
: /* Vector of valid font weight values.
5166 Each element has the form:
5167 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5168 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5169 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5170 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5172 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5173 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5174 See `font-weight-table' for the format of the vector. */);
5175 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5176 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5178 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5179 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5180 See `font-weight-table' for the format of the vector. */);
5181 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5182 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5184 staticpro (&font_style_table
);
5185 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5186 ASET (font_style_table
, 0, Vfont_weight_table
);
5187 ASET (font_style_table
, 1, Vfont_slant_table
);
5188 ASET (font_style_table
, 2, Vfont_width_table
);
5190 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5191 *Logging list of font related actions and results.
5192 The value t means to suppress the logging.
5193 The initial value is set to nil if the environment variable
5194 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5197 #ifdef HAVE_WINDOW_SYSTEM
5198 #ifdef HAVE_FREETYPE
5200 #ifdef HAVE_X_WINDOWS
5205 #endif /* HAVE_XFT */
5206 #endif /* HAVE_X_WINDOWS */
5207 #else /* not HAVE_FREETYPE */
5208 #ifdef HAVE_X_WINDOWS
5210 #endif /* HAVE_X_WINDOWS */
5211 #endif /* not HAVE_FREETYPE */
5214 #endif /* HAVE_BDFFONT */
5217 #endif /* WINDOWSNT */
5220 #endif /* HAVE_NS */
5221 #endif /* HAVE_WINDOW_SYSTEM */
5227 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;