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
508 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
512 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
514 if ((n
& 0xF) + 1 >= ASIZE (elt
))
516 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
520 else if (SYMBOLP (val
))
522 int n
= font_style_to_value (prop
, val
, 0);
524 val
= n
>= 0 ? make_number (n
) : Qerror
;
532 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
534 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
539 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
541 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
543 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
545 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
547 if (spacing
== 'c' || spacing
== 'C')
548 return make_number (FONT_SPACING_CHARCELL
);
549 if (spacing
== 'm' || spacing
== 'M')
550 return make_number (FONT_SPACING_MONO
);
551 if (spacing
== 'p' || spacing
== 'P')
552 return make_number (FONT_SPACING_PROPORTIONAL
);
553 if (spacing
== 'd' || spacing
== 'D')
554 return make_number (FONT_SPACING_DUAL
);
560 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
562 Lisp_Object tail
, tmp
;
565 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
566 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
567 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
570 if (! SYMBOLP (XCAR (val
)))
575 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
577 for (i
= 0; i
< 2; i
++)
584 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
585 if (! SYMBOLP (XCAR (tmp
)))
593 /* Structure of known font property keys and validater of the
597 /* Pointer to the key symbol. */
599 /* Function to validate PROP's value VAL, or NULL if any value is
600 ok. The value is VAL or its regularized value if VAL is valid,
601 and Qerror if not. */
602 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
603 } font_property_table
[] =
604 { { &QCtype
, font_prop_validate_symbol
},
605 { &QCfoundry
, font_prop_validate_symbol
},
606 { &QCfamily
, font_prop_validate_symbol
},
607 { &QCadstyle
, font_prop_validate_symbol
},
608 { &QCregistry
, font_prop_validate_symbol
},
609 { &QCweight
, font_prop_validate_style
},
610 { &QCslant
, font_prop_validate_style
},
611 { &QCwidth
, font_prop_validate_style
},
612 { &QCsize
, font_prop_validate_non_neg
},
613 { &QCdpi
, font_prop_validate_non_neg
},
614 { &QCspacing
, font_prop_validate_spacing
},
615 { &QCavgwidth
, font_prop_validate_non_neg
},
616 /* The order of the above entries must match with enum
617 font_property_index. */
618 { &QClang
, font_prop_validate_symbol
},
619 { &QCscript
, font_prop_validate_symbol
},
620 { &QCotf
, font_prop_validate_otf
}
623 /* Size (number of elements) of the above table. */
624 #define FONT_PROPERTY_TABLE_SIZE \
625 ((sizeof font_property_table) / (sizeof *font_property_table))
627 /* Return an index number of font property KEY or -1 if KEY is not an
628 already known property. */
631 get_font_prop_index (Lisp_Object key
)
635 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
636 if (EQ (key
, *font_property_table
[i
].key
))
641 /* Validate the font property. The property key is specified by the
642 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
643 signal an error. The value is VAL or the regularized one. */
646 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
648 Lisp_Object validated
;
653 prop
= *font_property_table
[idx
].key
;
656 idx
= get_font_prop_index (prop
);
660 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
661 if (EQ (validated
, Qerror
))
662 signal_error ("invalid font property", Fcons (prop
, val
));
667 /* Store VAL as a value of extra font property PROP in FONT while
668 keeping the sorting order. Don't check the validity of VAL. */
671 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
673 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
674 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
678 Lisp_Object prev
= Qnil
;
681 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
682 prev
= extra
, extra
= XCDR (extra
);
685 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
687 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
693 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
698 /* Font name parser and unparser */
700 static int parse_matrix (const char *);
701 static int font_expand_wildcards (Lisp_Object
*, int);
702 static int font_parse_name (char *, Lisp_Object
);
704 /* An enumerator for each field of an XLFD font name. */
705 enum xlfd_field_index
724 /* An enumerator for mask bit corresponding to each XLFD field. */
727 XLFD_FOUNDRY_MASK
= 0x0001,
728 XLFD_FAMILY_MASK
= 0x0002,
729 XLFD_WEIGHT_MASK
= 0x0004,
730 XLFD_SLANT_MASK
= 0x0008,
731 XLFD_SWIDTH_MASK
= 0x0010,
732 XLFD_ADSTYLE_MASK
= 0x0020,
733 XLFD_PIXEL_MASK
= 0x0040,
734 XLFD_POINT_MASK
= 0x0080,
735 XLFD_RESX_MASK
= 0x0100,
736 XLFD_RESY_MASK
= 0x0200,
737 XLFD_SPACING_MASK
= 0x0400,
738 XLFD_AVGWIDTH_MASK
= 0x0800,
739 XLFD_REGISTRY_MASK
= 0x1000,
740 XLFD_ENCODING_MASK
= 0x2000
744 /* Parse P pointing the pixel/point size field of the form
745 `[A B C D]' which specifies a transformation matrix:
751 by which all glyphs of the font are transformed. The spec says
752 that scalar value N for the pixel/point size is equivalent to:
753 A = N * resx/resy, B = C = 0, D = N.
755 Return the scalar value N if the form is valid. Otherwise return
759 parse_matrix (const char *p
)
765 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
768 matrix
[i
] = - strtod (p
+ 1, &end
);
770 matrix
[i
] = strtod (p
, &end
);
773 return (i
== 4 ? (int) matrix
[3] : -1);
776 /* Expand a wildcard field in FIELD (the first N fields are filled) to
777 multiple fields to fill in all 14 XLFD fields while restring a
778 field position by its contents. */
781 font_expand_wildcards (Lisp_Object
*field
, int n
)
784 Lisp_Object tmp
[XLFD_LAST_INDEX
];
785 /* Array of information about where this element can go. Nth
786 element is for Nth element of FIELD. */
788 /* Minimum possible field. */
790 /* Maxinum possible field. */
792 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
794 } range
[XLFD_LAST_INDEX
];
796 int range_from
, range_to
;
799 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
800 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
801 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
802 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
803 | XLFD_AVGWIDTH_MASK)
804 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
806 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
807 field. The value is shifted to left one bit by one in the
809 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
810 range_mask
= (range_mask
<< 1) | 1;
812 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
813 position-based retriction for FIELD[I]. */
814 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
815 i
++, range_from
++, range_to
++, range_mask
<<= 1)
817 Lisp_Object val
= field
[i
];
823 range
[i
].from
= range_from
;
824 range
[i
].to
= range_to
;
825 range
[i
].mask
= range_mask
;
829 /* The triplet FROM, TO, and MASK is a value-based
830 retriction for FIELD[I]. */
836 int numeric
= XINT (val
);
839 from
= to
= XLFD_ENCODING_INDEX
,
840 mask
= XLFD_ENCODING_MASK
;
841 else if (numeric
== 0)
842 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
843 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
844 else if (numeric
<= 48)
845 from
= to
= XLFD_PIXEL_INDEX
,
846 mask
= XLFD_PIXEL_MASK
;
848 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
849 mask
= XLFD_LARGENUM_MASK
;
851 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
852 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
853 mask
= XLFD_NULL_MASK
;
855 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
858 Lisp_Object name
= SYMBOL_NAME (val
);
860 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
861 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
862 mask
= XLFD_REGENC_MASK
;
864 from
= to
= XLFD_ENCODING_INDEX
,
865 mask
= XLFD_ENCODING_MASK
;
867 else if (range_from
<= XLFD_WEIGHT_INDEX
868 && range_to
>= XLFD_WEIGHT_INDEX
869 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
870 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
871 else if (range_from
<= XLFD_SLANT_INDEX
872 && range_to
>= XLFD_SLANT_INDEX
873 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
874 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
875 else if (range_from
<= XLFD_SWIDTH_INDEX
876 && range_to
>= XLFD_SWIDTH_INDEX
877 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
878 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
881 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
882 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
884 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
885 mask
= XLFD_SYMBOL_MASK
;
888 /* Merge position-based and value-based restrictions. */
890 while (from
< range_from
)
891 mask
&= ~(1 << from
++);
892 while (from
< 14 && ! (mask
& (1 << from
)))
894 while (to
> range_to
)
895 mask
&= ~(1 << to
--);
896 while (to
>= 0 && ! (mask
& (1 << to
)))
900 range
[i
].from
= from
;
902 range
[i
].mask
= mask
;
904 if (from
> range_from
|| to
< range_to
)
906 /* The range is narrowed by value-based restrictions.
907 Reflect it to the other fields. */
909 /* Following fields should be after FROM. */
911 /* Preceding fields should be before TO. */
912 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
914 /* Check FROM for non-wildcard field. */
915 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
917 while (range
[j
].from
< from
)
918 range
[j
].mask
&= ~(1 << range
[j
].from
++);
919 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
921 range
[j
].from
= from
;
924 from
= range
[j
].from
;
925 if (range
[j
].to
> to
)
927 while (range
[j
].to
> to
)
928 range
[j
].mask
&= ~(1 << range
[j
].to
--);
929 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
942 /* Decide all fileds from restrictions in RANGE. */
943 for (i
= j
= 0; i
< n
; i
++)
945 if (j
< range
[i
].from
)
947 if (i
== 0 || ! NILP (tmp
[i
- 1]))
948 /* None of TMP[X] corresponds to Jth field. */
950 for (; j
< range
[i
].from
; j
++)
955 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
957 for (; j
< XLFD_LAST_INDEX
; j
++)
959 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
960 field
[XLFD_ENCODING_INDEX
]
961 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
966 /* Parse NAME (null terminated) as XLFD and store information in FONT
967 (font-spec or font-entity). Size property of FONT is set as
969 specified XLFD fields FONT property
970 --------------------- -------------
971 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
972 POINT_SIZE and RESY calculated pixel size (Lisp integer)
973 POINT_SIZE POINT_SIZE/10 (Lisp float)
975 If NAME is successfully parsed, return 0. Otherwise return -1.
977 FONT is usually a font-spec, but when this function is called from
978 X font backend driver, it is a font-entity. In that case, NAME is
979 a fully specified XLFD. */
982 font_parse_xlfd (char *name
, Lisp_Object font
)
984 int len
= strlen (name
);
986 char *f
[XLFD_LAST_INDEX
+ 1];
990 if (len
> 255 || !len
)
991 /* Maximum XLFD name length is 255. */
993 /* Accept "*-.." as a fully specified XLFD. */
994 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
995 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
998 for (p
= name
+ i
; *p
; p
++)
1002 if (i
== XLFD_LAST_INDEX
)
1007 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1008 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1010 if (i
== XLFD_LAST_INDEX
)
1012 /* Fully specified XLFD. */
1015 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1016 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1017 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1018 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1020 val
= INTERN_FIELD_SYM (i
);
1023 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1025 ASET (font
, j
, make_number (n
));
1028 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1029 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1030 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1032 ASET (font
, FONT_REGISTRY_INDEX
,
1033 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1034 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1036 p
= f
[XLFD_PIXEL_INDEX
];
1037 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1038 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1041 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1043 ASET (font
, FONT_SIZE_INDEX
, val
);
1044 else if (FONT_ENTITY_P (font
))
1048 double point_size
= -1;
1050 font_assert (FONT_SPEC_P (font
));
1051 p
= f
[XLFD_POINT_INDEX
];
1053 point_size
= parse_matrix (p
);
1054 else if (isdigit (*p
))
1055 point_size
= atoi (p
), point_size
/= 10;
1056 if (point_size
>= 0)
1057 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1061 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1062 if (! NILP (val
) && ! INTEGERP (val
))
1064 ASET (font
, FONT_DPI_INDEX
, val
);
1065 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1068 val
= font_prop_validate_spacing (QCspacing
, val
);
1069 if (! INTEGERP (val
))
1071 ASET (font
, FONT_SPACING_INDEX
, val
);
1073 p
= f
[XLFD_AVGWIDTH_INDEX
];
1076 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1077 if (! NILP (val
) && ! INTEGERP (val
))
1079 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1083 int wild_card_found
= 0;
1084 Lisp_Object prop
[XLFD_LAST_INDEX
];
1086 if (FONT_ENTITY_P (font
))
1088 for (j
= 0; j
< i
; j
++)
1092 if (f
[j
][1] && f
[j
][1] != '-')
1095 wild_card_found
= 1;
1098 prop
[j
] = INTERN_FIELD (j
);
1100 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1102 if (! wild_card_found
)
1104 if (font_expand_wildcards (prop
, i
) < 0)
1107 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1108 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1109 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1110 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1111 if (! NILP (prop
[i
]))
1113 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1115 ASET (font
, j
, make_number (n
));
1117 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1118 val
= prop
[XLFD_REGISTRY_INDEX
];
1121 val
= prop
[XLFD_ENCODING_INDEX
];
1123 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1125 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1126 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1128 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1129 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1131 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1133 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1134 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1135 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1137 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1139 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1142 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1143 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1144 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1146 val
= font_prop_validate_spacing (QCspacing
,
1147 prop
[XLFD_SPACING_INDEX
]);
1148 if (! INTEGERP (val
))
1150 ASET (font
, FONT_SPACING_INDEX
, val
);
1152 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1153 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1159 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1160 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1161 0, use PIXEL_SIZE instead. */
1164 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1167 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1171 font_assert (FONTP (font
));
1173 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1176 if (i
== FONT_ADSTYLE_INDEX
)
1177 j
= XLFD_ADSTYLE_INDEX
;
1178 else if (i
== FONT_REGISTRY_INDEX
)
1179 j
= XLFD_REGISTRY_INDEX
;
1180 val
= AREF (font
, i
);
1183 if (j
== XLFD_REGISTRY_INDEX
)
1184 f
[j
] = "*-*", len
+= 4;
1186 f
[j
] = "*", len
+= 2;
1191 val
= SYMBOL_NAME (val
);
1192 if (j
== XLFD_REGISTRY_INDEX
1193 && ! strchr (SSDATA (val
), '-'))
1195 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1196 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1198 f
[j
] = p
= alloca (SBYTES (val
) + 3);
1199 sprintf (p
, "%s-*", SDATA (val
));
1200 len
+= SBYTES (val
) + 3;
1204 f
[j
] = p
= alloca (SBYTES (val
) + 4);
1205 sprintf (p
, "%s*-*", SDATA (val
));
1206 len
+= SBYTES (val
) + 4;
1210 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1214 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1217 val
= font_style_symbolic (font
, i
, 0);
1219 f
[j
] = "*", len
+= 2;
1222 val
= SYMBOL_NAME (val
);
1223 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1227 val
= AREF (font
, FONT_SIZE_INDEX
);
1228 font_assert (NUMBERP (val
) || NILP (val
));
1236 f
[XLFD_PIXEL_INDEX
] = p
= alloca (22);
1237 len
+= sprintf (p
, "%d-*", i
) + 1;
1240 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1242 else if (FLOATP (val
))
1244 i
= XFLOAT_DATA (val
) * 10;
1245 f
[XLFD_PIXEL_INDEX
] = p
= alloca (12);
1246 len
+= sprintf (p
, "*-%d", i
) + 1;
1249 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1251 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1253 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1254 f
[XLFD_RESX_INDEX
] = p
= alloca (22);
1255 len
+= sprintf (p
, "%d-%d", i
, i
) + 1;
1258 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1259 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1261 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1263 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1264 : spacing
<= FONT_SPACING_DUAL
? "d"
1265 : spacing
<= FONT_SPACING_MONO
? "m"
1270 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1271 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1273 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (11);
1274 len
+= sprintf (p
, "%ld",
1275 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1278 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1279 len
++; /* for terminating '\0'. */
1282 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1283 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1284 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1285 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1286 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1287 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1288 f
[XLFD_REGISTRY_INDEX
]);
1291 /* Parse NAME (null terminated) and store information in FONT
1292 (font-spec or font-entity). NAME is supplied in either the
1293 Fontconfig or GTK font name format. If NAME is successfully
1294 parsed, return 0. Otherwise return -1.
1296 The fontconfig format is
1298 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1302 FAMILY [PROPS...] [SIZE]
1304 This function tries to guess which format it is. */
1307 font_parse_fcname (char *name
, Lisp_Object font
)
1310 char *size_beg
= NULL
, *size_end
= NULL
;
1311 char *props_beg
= NULL
, *family_end
= NULL
;
1312 int len
= strlen (name
);
1317 for (p
= name
; *p
; p
++)
1319 if (*p
== '\\' && p
[1])
1323 props_beg
= family_end
= p
;
1328 int decimal
= 0, size_found
= 1;
1329 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1332 if (*q
!= '.' || decimal
)
1351 Lisp_Object extra_props
= Qnil
;
1353 /* A fontconfig name with size and/or property data. */
1354 if (family_end
> name
)
1357 family
= font_intern_prop (name
, family_end
- name
, 1);
1358 ASET (font
, FONT_FAMILY_INDEX
, family
);
1362 double point_size
= strtod (size_beg
, &size_end
);
1363 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1364 if (*size_end
== ':' && size_end
[1])
1365 props_beg
= size_end
;
1369 /* Now parse ":KEY=VAL" patterns. */
1372 for (p
= props_beg
; *p
; p
= q
)
1374 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1377 /* Must be an enumerated value. */
1381 val
= font_intern_prop (p
, q
- p
, 1);
1383 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1384 && memcmp (p, STR, strlen (STR)) == 0)
1386 if (PROP_MATCH ("light")
1387 || PROP_MATCH ("medium")
1388 || PROP_MATCH ("demibold")
1389 || PROP_MATCH ("bold")
1390 || PROP_MATCH ("black"))
1391 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1392 else if (PROP_MATCH ("roman")
1393 || PROP_MATCH ("italic")
1394 || PROP_MATCH ("oblique"))
1395 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1396 else if (PROP_MATCH ("charcell"))
1397 ASET (font
, FONT_SPACING_INDEX
,
1398 make_number (FONT_SPACING_CHARCELL
));
1399 else if (PROP_MATCH ("mono"))
1400 ASET (font
, FONT_SPACING_INDEX
,
1401 make_number (FONT_SPACING_MONO
));
1402 else if (PROP_MATCH ("proportional"))
1403 ASET (font
, FONT_SPACING_INDEX
,
1404 make_number (FONT_SPACING_PROPORTIONAL
));
1413 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1414 prop
= FONT_SIZE_INDEX
;
1417 key
= font_intern_prop (p
, q
- p
, 1);
1418 prop
= get_font_prop_index (key
);
1422 for (q
= p
; *q
&& *q
!= ':'; q
++);
1423 val
= font_intern_prop (p
, q
- p
, 0);
1425 if (prop
>= FONT_FOUNDRY_INDEX
1426 && prop
< FONT_EXTRA_INDEX
)
1427 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1430 extra_props
= nconc2 (extra_props
,
1431 Fcons (Fcons (key
, val
), Qnil
));
1438 if (! NILP (extra_props
))
1440 struct font_driver_list
*driver_list
= font_driver_list
;
1441 for ( ; driver_list
; driver_list
= driver_list
->next
)
1442 if (driver_list
->driver
->filter_properties
)
1443 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1449 /* Either a fontconfig-style name with no size and property
1450 data, or a GTK-style name. */
1451 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1452 Lisp_Object width
= Qnil
, size
= Qnil
;
1456 /* Scan backwards from the end, looking for a size. */
1457 for (p
= name
+ len
- 1; p
>= name
; p
--)
1461 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1462 /* Found a font size. */
1463 size
= make_float (strtod (p
+ 1, NULL
));
1467 /* Now P points to the termination of the string, sans size.
1468 Scan backwards, looking for font properties. */
1469 for (; p
> name
; p
= q
)
1471 for (q
= p
- 1; q
>= name
; q
--)
1473 if (q
> name
&& *(q
-1) == '\\')
1474 --q
; /* Skip quoting backslashes. */
1480 word_len
= p
- word_start
;
1482 #define PROP_MATCH(STR) \
1483 (word_len == strlen (STR) \
1484 && memcmp (word_start, STR, strlen (STR)) == 0)
1485 #define PROP_SAVE(VAR, STR) \
1486 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1488 if (PROP_MATCH ("Ultra-Light"))
1489 PROP_SAVE (weight
, "ultra-light");
1490 else if (PROP_MATCH ("Light"))
1491 PROP_SAVE (weight
, "light");
1492 else if (PROP_MATCH ("Book"))
1493 PROP_SAVE (weight
, "book");
1494 else if (PROP_MATCH ("Medium"))
1495 PROP_SAVE (weight
, "medium");
1496 else if (PROP_MATCH ("Semi-Bold"))
1497 PROP_SAVE (weight
, "semi-bold");
1498 else if (PROP_MATCH ("Bold"))
1499 PROP_SAVE (weight
, "bold");
1500 else if (PROP_MATCH ("Italic"))
1501 PROP_SAVE (slant
, "italic");
1502 else if (PROP_MATCH ("Oblique"))
1503 PROP_SAVE (slant
, "oblique");
1504 else if (PROP_MATCH ("Semi-Condensed"))
1505 PROP_SAVE (width
, "semi-condensed");
1506 else if (PROP_MATCH ("Condensed"))
1507 PROP_SAVE (width
, "condensed");
1508 /* An unknown word must be part of the font name. */
1519 ASET (font
, FONT_FAMILY_INDEX
,
1520 font_intern_prop (name
, family_end
- name
, 1));
1522 ASET (font
, FONT_SIZE_INDEX
, size
);
1524 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1526 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1528 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1534 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1535 NAME (NBYTES length), and return the name length. If
1536 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1539 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1541 Lisp_Object family
, foundry
;
1542 Lisp_Object tail
, val
;
1546 Lisp_Object styles
[3];
1547 const char *style_names
[3] = { "weight", "slant", "width" };
1550 family
= AREF (font
, FONT_FAMILY_INDEX
);
1551 if (! NILP (family
))
1553 if (SYMBOLP (family
))
1555 family
= SYMBOL_NAME (family
);
1556 len
+= SBYTES (family
);
1562 val
= AREF (font
, FONT_SIZE_INDEX
);
1565 if (XINT (val
) != 0)
1566 pixel_size
= XINT (val
);
1568 len
+= 21; /* for ":pixelsize=NUM" */
1570 else if (FLOATP (val
))
1573 point_size
= (int) XFLOAT_DATA (val
);
1574 len
+= 11; /* for "-NUM" */
1577 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1578 if (! NILP (foundry
))
1580 if (SYMBOLP (foundry
))
1582 foundry
= SYMBOL_NAME (foundry
);
1583 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1589 for (i
= 0; i
< 3; i
++)
1591 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1592 if (! NILP (styles
[i
]))
1593 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1594 SDATA (SYMBOL_NAME (styles
[i
])));
1597 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1598 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1599 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1600 len
+= strlen (":spacing=100");
1601 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1602 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1603 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1605 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1607 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1609 len
+= SBYTES (val
);
1610 else if (INTEGERP (val
))
1611 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1612 else if (SYMBOLP (val
))
1613 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1619 if (! NILP (family
))
1620 p
+= sprintf (p
, "%s", SDATA (family
));
1624 p
+= sprintf (p
, "%d", point_size
);
1626 p
+= sprintf (p
, "-%d", point_size
);
1628 else if (pixel_size
> 0)
1629 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1630 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1631 p
+= sprintf (p
, ":foundry=%s",
1632 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1633 for (i
= 0; i
< 3; i
++)
1634 if (! NILP (styles
[i
]))
1635 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1636 SDATA (SYMBOL_NAME (styles
[i
])));
1637 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1638 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1639 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1640 p
+= sprintf (p
, ":spacing=%ld",
1641 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1642 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1644 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1645 p
+= sprintf (p
, ":scalable=true");
1647 p
+= sprintf (p
, ":scalable=false");
1652 /* Parse NAME (null terminated) and store information in FONT
1653 (font-spec or font-entity). If NAME is successfully parsed, return
1654 0. Otherwise return -1. */
1657 font_parse_name (char *name
, Lisp_Object font
)
1659 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1660 return font_parse_xlfd (name
, font
);
1661 return font_parse_fcname (name
, font
);
1665 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1666 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1670 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1676 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1678 CHECK_STRING (family
);
1679 len
= SBYTES (family
);
1680 p0
= SSDATA (family
);
1681 p1
= strchr (p0
, '-');
1684 if ((*p0
!= '*' && p1
- p0
> 0)
1685 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1686 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1689 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1692 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1694 if (! NILP (registry
))
1696 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1697 CHECK_STRING (registry
);
1698 len
= SBYTES (registry
);
1699 p0
= SSDATA (registry
);
1700 p1
= strchr (p0
, '-');
1703 if (SDATA (registry
)[len
- 1] == '*')
1704 registry
= concat2 (registry
, build_string ("-*"));
1706 registry
= concat2 (registry
, build_string ("*-*"));
1708 registry
= Fdowncase (registry
);
1709 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1714 /* This part (through the next ^L) is still experimental and not
1715 tested much. We may drastically change codes. */
1721 #define LGSTRING_HEADER_SIZE 6
1722 #define LGSTRING_GLYPH_SIZE 8
1725 check_gstring (gstring
)
1726 Lisp_Object gstring
;
1731 CHECK_VECTOR (gstring
);
1732 val
= AREF (gstring
, 0);
1734 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1736 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1737 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1738 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1739 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1740 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1741 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1742 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1743 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1744 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1745 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1746 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1748 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1750 val
= LGSTRING_GLYPH (gstring
, i
);
1752 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1754 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1756 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1757 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1758 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1759 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1760 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1761 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1762 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1763 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1765 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1767 if (ASIZE (val
) < 3)
1769 for (j
= 0; j
< 3; j
++)
1770 CHECK_NUMBER (AREF (val
, j
));
1775 error ("Invalid glyph-string format");
1780 check_otf_features (otf_features
)
1781 Lisp_Object otf_features
;
1785 CHECK_CONS (otf_features
);
1786 CHECK_SYMBOL (XCAR (otf_features
));
1787 otf_features
= XCDR (otf_features
);
1788 CHECK_CONS (otf_features
);
1789 CHECK_SYMBOL (XCAR (otf_features
));
1790 otf_features
= XCDR (otf_features
);
1791 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1793 CHECK_SYMBOL (Fcar (val
));
1794 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1795 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1797 otf_features
= XCDR (otf_features
);
1798 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1800 CHECK_SYMBOL (Fcar (val
));
1801 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1802 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1809 Lisp_Object otf_list
;
1812 otf_tag_symbol (tag
)
1817 OTF_tag_name (tag
, name
);
1818 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1825 Lisp_Object val
= Fassoc (file
, otf_list
);
1829 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1832 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1833 val
= make_save_value (otf
, 0);
1834 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1840 /* Return a list describing which scripts/languages FONT supports by
1841 which GSUB/GPOS features of OpenType tables. See the comment of
1842 (struct font_driver).otf_capability. */
1845 font_otf_capability (font
)
1849 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1852 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1855 for (i
= 0; i
< 2; i
++)
1857 OTF_GSUB_GPOS
*gsub_gpos
;
1858 Lisp_Object script_list
= Qnil
;
1861 if (OTF_get_features (otf
, i
== 0) < 0)
1863 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1864 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1866 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1867 Lisp_Object langsys_list
= Qnil
;
1868 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1871 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1873 OTF_LangSys
*langsys
;
1874 Lisp_Object feature_list
= Qnil
;
1875 Lisp_Object langsys_tag
;
1878 if (k
== script
->LangSysCount
)
1880 langsys
= &script
->DefaultLangSys
;
1885 langsys
= script
->LangSys
+ k
;
1887 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1889 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1891 OTF_Feature
*feature
1892 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1893 Lisp_Object feature_tag
1894 = otf_tag_symbol (feature
->FeatureTag
);
1896 feature_list
= Fcons (feature_tag
, feature_list
);
1898 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1901 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1906 XSETCAR (capability
, script_list
);
1908 XSETCDR (capability
, script_list
);
1914 /* Parse OTF features in SPEC and write a proper features spec string
1915 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1916 assured that the sufficient memory has already allocated for
1920 generate_otf_features (spec
, features
)
1930 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1936 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1941 else if (! asterisk
)
1943 val
= SYMBOL_NAME (val
);
1944 p
+= sprintf (p
, "%s", SDATA (val
));
1948 val
= SYMBOL_NAME (val
);
1949 p
+= sprintf (p
, "~%s", SDATA (val
));
1953 error ("OTF spec too long");
1957 font_otf_DeviceTable (device_table
)
1958 OTF_DeviceTable
*device_table
;
1960 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1962 return Fcons (make_number (len
),
1963 make_unibyte_string (device_table
->DeltaValue
, len
));
1967 font_otf_ValueRecord (value_format
, value_record
)
1969 OTF_ValueRecord
*value_record
;
1971 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1973 if (value_format
& OTF_XPlacement
)
1974 ASET (val
, 0, make_number (value_record
->XPlacement
));
1975 if (value_format
& OTF_YPlacement
)
1976 ASET (val
, 1, make_number (value_record
->YPlacement
));
1977 if (value_format
& OTF_XAdvance
)
1978 ASET (val
, 2, make_number (value_record
->XAdvance
));
1979 if (value_format
& OTF_YAdvance
)
1980 ASET (val
, 3, make_number (value_record
->YAdvance
));
1981 if (value_format
& OTF_XPlaDevice
)
1982 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1983 if (value_format
& OTF_YPlaDevice
)
1984 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1985 if (value_format
& OTF_XAdvDevice
)
1986 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1987 if (value_format
& OTF_YAdvDevice
)
1988 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1993 font_otf_Anchor (anchor
)
1998 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1999 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2000 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2001 if (anchor
->AnchorFormat
== 2)
2002 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2005 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2006 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2010 #endif /* HAVE_LIBOTF */
2016 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2017 static int font_compare (const void *, const void *);
2018 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2022 font_rescale_ratio (Lisp_Object font_entity
)
2024 Lisp_Object tail
, elt
;
2025 Lisp_Object name
= Qnil
;
2027 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2030 if (FLOATP (XCDR (elt
)))
2032 if (STRINGP (XCAR (elt
)))
2035 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2036 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2037 return XFLOAT_DATA (XCDR (elt
));
2039 else if (FONT_SPEC_P (XCAR (elt
)))
2041 if (font_match_p (XCAR (elt
), font_entity
))
2042 return XFLOAT_DATA (XCDR (elt
));
2049 /* We sort fonts by scoring each of them against a specified
2050 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2051 the value is, the closer the font is to the font-spec.
2053 The lowest 2 bits of the score is used for driver type. The font
2054 available by the most preferred font driver is 0.
2056 Each 7-bit in the higher 28 bits are used for numeric properties
2057 WEIGHT, SLANT, WIDTH, and SIZE. */
2059 /* How many bits to shift to store the difference value of each font
2060 property in a score. Note that flots for FONT_TYPE_INDEX and
2061 FONT_REGISTRY_INDEX are not used. */
2062 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2064 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2065 The return value indicates how different ENTITY is compared with
2069 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2074 /* Score three style numeric fields. Maximum difference is 127. */
2075 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2076 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2078 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2083 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2086 /* Score the size. Maximum difference is 127. */
2087 i
= FONT_SIZE_INDEX
;
2088 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2089 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2091 /* We use the higher 6-bit for the actual size difference. The
2092 lowest bit is set if the DPI is different. */
2094 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2096 if (CONSP (Vface_font_rescale_alist
))
2097 pixel_size
*= font_rescale_ratio (entity
);
2098 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2102 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2103 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2105 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2106 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2108 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2115 /* Concatenate all elements of LIST into one vector. LIST is a list
2116 of font-entity vectors. */
2119 font_vconcat_entity_vectors (Lisp_Object list
)
2121 int nargs
= XINT (Flength (list
));
2122 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2125 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2126 args
[i
] = XCAR (list
);
2127 return Fvconcat (nargs
, args
);
2131 /* The structure for elements being sorted by qsort. */
2132 struct font_sort_data
2135 int font_driver_preference
;
2140 /* The comparison function for qsort. */
2143 font_compare (const void *d1
, const void *d2
)
2145 const struct font_sort_data
*data1
= d1
;
2146 const struct font_sort_data
*data2
= d2
;
2148 if (data1
->score
< data2
->score
)
2150 else if (data1
->score
> data2
->score
)
2152 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2156 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2157 If PREFER specifies a point-size, calculate the corresponding
2158 pixel-size from QCdpi property of PREFER or from the Y-resolution
2159 of FRAME before sorting.
2161 If BEST-ONLY is nonzero, return the best matching entity (that
2162 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2163 if BEST-ONLY is negative). Otherwise, return the sorted result as
2164 a single vector of font-entities.
2166 This function does no optimization for the case that the total
2167 number of elements is 1. The caller should avoid calling this in
2171 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2173 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2175 struct font_sort_data
*data
;
2176 unsigned best_score
;
2177 Lisp_Object best_entity
;
2178 struct frame
*f
= XFRAME (frame
);
2179 Lisp_Object tail
, vec
;
2182 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2183 prefer_prop
[i
] = AREF (prefer
, i
);
2184 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2185 prefer_prop
[FONT_SIZE_INDEX
]
2186 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2188 if (NILP (XCDR (list
)))
2190 /* What we have to take care of is this single vector. */
2192 maxlen
= ASIZE (vec
);
2196 /* We don't have to perform sort, so there's no need of creating
2197 a single vector. But, we must find the length of the longest
2200 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2201 if (maxlen
< ASIZE (XCAR (tail
)))
2202 maxlen
= ASIZE (XCAR (tail
));
2206 /* We have to create a single vector to sort it. */
2207 vec
= font_vconcat_entity_vectors (list
);
2208 maxlen
= ASIZE (vec
);
2211 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2212 best_score
= 0xFFFFFFFF;
2215 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2217 int font_driver_preference
= 0;
2218 Lisp_Object current_font_driver
;
2224 /* We are sure that the length of VEC > 0. */
2225 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2226 /* Score the elements. */
2227 for (i
= 0; i
< len
; i
++)
2229 data
[i
].entity
= AREF (vec
, i
);
2231 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2233 ? font_score (data
[i
].entity
, prefer_prop
)
2235 if (best_only
&& best_score
> data
[i
].score
)
2237 best_score
= data
[i
].score
;
2238 best_entity
= data
[i
].entity
;
2239 if (best_score
== 0)
2242 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2244 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2245 font_driver_preference
++;
2247 data
[i
].font_driver_preference
= font_driver_preference
;
2250 /* Sort if necessary. */
2253 qsort (data
, len
, sizeof *data
, font_compare
);
2254 for (i
= 0; i
< len
; i
++)
2255 ASET (vec
, i
, data
[i
].entity
);
2264 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2269 /* API of Font Service Layer. */
2271 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2272 sort_shift_bits. Finternal_set_font_selection_order calls this
2273 function with font_sort_order after setting up it. */
2276 font_update_sort_order (int *order
)
2280 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2282 int xlfd_idx
= order
[i
];
2284 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2285 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2286 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2287 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2288 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2289 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2291 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2296 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2301 table
= assq_no_quit (script
, table
);
2304 table
= XCDR (table
);
2305 if (! NILP (langsys
))
2307 table
= assq_no_quit (langsys
, table
);
2313 val
= assq_no_quit (Qnil
, table
);
2315 table
= XCAR (table
);
2319 table
= XCDR (table
);
2320 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2322 if (NILP (XCAR (features
)))
2327 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2333 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2336 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2338 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2340 script
= XCAR (spec
);
2344 langsys
= XCAR (spec
);
2355 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2356 XCAR (otf_capability
)))
2358 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2359 XCDR (otf_capability
)))
2366 /* Check if FONT (font-entity or font-object) matches with the font
2367 specification SPEC. */
2370 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2372 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2373 Lisp_Object extra
, font_extra
;
2376 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2377 if (! NILP (AREF (spec
, i
))
2378 && ! NILP (AREF (font
, i
))
2379 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2381 props
= XFONT_SPEC (spec
)->props
;
2382 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2384 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2385 prop
[i
] = AREF (spec
, i
);
2386 prop
[FONT_SIZE_INDEX
]
2387 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2391 if (font_score (font
, props
) > 0)
2393 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2394 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2395 for (; CONSP (extra
); extra
= XCDR (extra
))
2397 Lisp_Object key
= XCAR (XCAR (extra
));
2398 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2400 if (EQ (key
, QClang
))
2402 val2
= assq_no_quit (key
, font_extra
);
2411 if (NILP (Fmemq (val
, val2
)))
2416 ? NILP (Fmemq (val
, XCDR (val2
)))
2420 else if (EQ (key
, QCscript
))
2422 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2428 /* All characters in the list must be supported. */
2429 for (; CONSP (val2
); val2
= XCDR (val2
))
2431 if (! NATNUMP (XCAR (val2
)))
2433 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2434 == FONT_INVALID_CODE
)
2438 else if (VECTORP (val2
))
2440 /* At most one character in the vector must be supported. */
2441 for (i
= 0; i
< ASIZE (val2
); i
++)
2443 if (! NATNUMP (AREF (val2
, i
)))
2445 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2446 != FONT_INVALID_CODE
)
2449 if (i
== ASIZE (val2
))
2454 else if (EQ (key
, QCotf
))
2458 if (! FONT_OBJECT_P (font
))
2460 fontp
= XFONT_OBJECT (font
);
2461 if (! fontp
->driver
->otf_capability
)
2463 val2
= fontp
->driver
->otf_capability (fontp
);
2464 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2475 Each font backend has the callback function get_cache, and it
2476 returns a cons cell of which cdr part can be freely used for
2477 caching fonts. The cons cell may be shared by multiple frames
2478 and/or multiple font drivers. So, we arrange the cdr part as this:
2480 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2482 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2483 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2484 cons (FONT-SPEC FONT-ENTITY ...). */
2486 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2487 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2488 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2489 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2490 struct font_driver
*);
2493 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2495 Lisp_Object cache
, val
;
2497 cache
= driver
->get_cache (f
);
2499 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2503 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2504 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2508 val
= XCDR (XCAR (val
));
2509 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2515 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2517 Lisp_Object cache
, val
, tmp
;
2520 cache
= driver
->get_cache (f
);
2522 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2523 cache
= val
, val
= XCDR (val
);
2524 font_assert (! NILP (val
));
2525 tmp
= XCDR (XCAR (val
));
2526 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2527 if (XINT (XCAR (tmp
)) == 0)
2529 font_clear_cache (f
, XCAR (val
), driver
);
2530 XSETCDR (cache
, XCDR (val
));
2536 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2538 Lisp_Object val
= driver
->get_cache (f
);
2539 Lisp_Object type
= driver
->type
;
2541 font_assert (CONSP (val
));
2542 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2543 font_assert (CONSP (val
));
2544 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2545 val
= XCDR (XCAR (val
));
2549 static int num_fonts
;
2552 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2554 Lisp_Object tail
, elt
;
2555 Lisp_Object tail2
, entity
;
2557 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2558 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2561 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2562 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2564 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2566 entity
= XCAR (tail2
);
2568 if (FONT_ENTITY_P (entity
)
2569 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2571 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2573 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2575 Lisp_Object val
= XCAR (objlist
);
2576 struct font
*font
= XFONT_OBJECT (val
);
2578 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2580 font_assert (font
&& driver
== font
->driver
);
2581 driver
->close (f
, font
);
2585 if (driver
->free_entity
)
2586 driver
->free_entity (entity
);
2591 XSETCDR (cache
, Qnil
);
2595 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2597 /* Check each font-entity in VEC, and return a list of font-entities
2598 that satisfy this condition:
2599 (1) matches with SPEC and SIZE if SPEC is not nil, and
2600 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2604 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2606 Lisp_Object entity
, val
;
2607 enum font_property_index prop
;
2610 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2612 entity
= AREF (vec
, i
);
2613 if (! NILP (Vface_ignored_fonts
))
2616 Lisp_Object tail
, regexp
;
2618 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2620 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2622 regexp
= XCAR (tail
);
2623 if (STRINGP (regexp
)
2624 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2633 val
= Fcons (entity
, val
);
2636 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2637 if (INTEGERP (AREF (spec
, prop
))
2638 && ((XINT (AREF (spec
, prop
)) >> 8)
2639 != (XINT (AREF (entity
, prop
)) >> 8)))
2640 prop
= FONT_SPEC_MAX
;
2641 if (prop
< FONT_SPEC_MAX
2643 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2645 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2648 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2649 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2650 prop
= FONT_SPEC_MAX
;
2652 if (prop
< FONT_SPEC_MAX
2653 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2654 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2655 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2656 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2657 prop
= FONT_SPEC_MAX
;
2658 if (prop
< FONT_SPEC_MAX
2659 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2660 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2661 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2662 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2663 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2664 prop
= FONT_SPEC_MAX
;
2665 if (prop
< FONT_SPEC_MAX
)
2666 val
= Fcons (entity
, val
);
2668 return (Fvconcat (1, &val
));
2672 /* Return a list of vectors of font-entities matching with SPEC on
2673 FRAME. Each elements in the list is a vector of entities from the
2674 same font-driver. */
2677 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2679 FRAME_PTR f
= XFRAME (frame
);
2680 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2681 Lisp_Object ftype
, val
;
2682 Lisp_Object list
= Qnil
;
2684 int need_filtering
= 0;
2687 font_assert (FONT_SPEC_P (spec
));
2689 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2690 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2691 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2692 size
= font_pixel_size (f
, spec
);
2696 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2697 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2698 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2699 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2701 ASET (scratch_font_spec
, i
, Qnil
);
2702 if (! NILP (AREF (spec
, i
)))
2704 if (i
== FONT_DPI_INDEX
)
2705 /* Skip FONT_SPACING_INDEX */
2708 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2709 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2711 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2713 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2715 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2717 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2718 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2725 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2729 val
= Fvconcat (1, &val
);
2730 copy
= Fcopy_font_spec (scratch_font_spec
);
2731 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2732 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2736 || ! NILP (Vface_ignored_fonts
)))
2737 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2738 if (ASIZE (val
) > 0)
2739 list
= Fcons (val
, list
);
2742 list
= Fnreverse (list
);
2743 FONT_ADD_LOG ("list", spec
, list
);
2748 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2749 nil, is an array of face's attributes, which specifies preferred
2750 font-related attributes. */
2753 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2755 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2756 Lisp_Object ftype
, size
, entity
;
2758 Lisp_Object work
= Fcopy_font_spec (spec
);
2760 XSETFRAME (frame
, f
);
2761 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2762 size
= AREF (spec
, FONT_SIZE_INDEX
);
2765 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2766 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2767 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2768 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2771 for (; driver_list
; driver_list
= driver_list
->next
)
2773 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2775 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2778 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2779 entity
= assoc_no_quit (work
, XCDR (cache
));
2781 entity
= XCDR (entity
);
2784 entity
= driver_list
->driver
->match (frame
, work
);
2785 copy
= Fcopy_font_spec (work
);
2786 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2787 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2789 if (! NILP (entity
))
2792 FONT_ADD_LOG ("match", work
, entity
);
2797 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2798 opened font object. */
2801 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2803 struct font_driver_list
*driver_list
;
2804 Lisp_Object objlist
, size
, val
, font_object
;
2806 int min_width
, height
;
2807 int scaled_pixel_size
= pixel_size
;
2809 font_assert (FONT_ENTITY_P (entity
));
2810 size
= AREF (entity
, FONT_SIZE_INDEX
);
2811 if (XINT (size
) != 0)
2812 scaled_pixel_size
= pixel_size
= XINT (size
);
2813 else if (CONSP (Vface_font_rescale_alist
))
2814 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2816 val
= AREF (entity
, FONT_TYPE_INDEX
);
2817 for (driver_list
= f
->font_driver_list
;
2818 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2819 driver_list
= driver_list
->next
);
2823 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2824 objlist
= XCDR (objlist
))
2826 Lisp_Object fn
= XCAR (objlist
);
2827 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2828 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2830 if (driver_list
->driver
->cached_font_ok
== NULL
2831 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2836 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2837 if (!NILP (font_object
))
2838 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2839 FONT_ADD_LOG ("open", entity
, font_object
);
2840 if (NILP (font_object
))
2842 ASET (entity
, FONT_OBJLIST_INDEX
,
2843 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2846 font
= XFONT_OBJECT (font_object
);
2847 min_width
= (font
->min_width
? font
->min_width
2848 : font
->average_width
? font
->average_width
2849 : font
->space_width
? font
->space_width
2851 height
= (font
->height
? font
->height
: 1);
2852 #ifdef HAVE_WINDOW_SYSTEM
2853 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2854 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2856 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2857 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2858 fonts_changed_p
= 1;
2862 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2863 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2864 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2865 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2873 /* Close FONT_OBJECT that is opened on frame F. */
2876 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2878 struct font
*font
= XFONT_OBJECT (font_object
);
2880 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2881 /* Already closed. */
2883 FONT_ADD_LOG ("close", font_object
, Qnil
);
2884 font
->driver
->close (f
, font
);
2885 #ifdef HAVE_WINDOW_SYSTEM
2886 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2887 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2893 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2894 FONT is a font-entity and it must be opened to check. */
2897 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2901 if (FONT_ENTITY_P (font
))
2903 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2904 struct font_driver_list
*driver_list
;
2906 for (driver_list
= f
->font_driver_list
;
2907 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2908 driver_list
= driver_list
->next
);
2911 if (! driver_list
->driver
->has_char
)
2913 return driver_list
->driver
->has_char (font
, c
);
2916 font_assert (FONT_OBJECT_P (font
));
2917 fontp
= XFONT_OBJECT (font
);
2918 if (fontp
->driver
->has_char
)
2920 int result
= fontp
->driver
->has_char (font
, c
);
2925 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2929 /* Return the glyph ID of FONT_OBJECT for character C. */
2932 font_encode_char (Lisp_Object font_object
, int c
)
2936 font_assert (FONT_OBJECT_P (font_object
));
2937 font
= XFONT_OBJECT (font_object
);
2938 return font
->driver
->encode_char (font
, c
);
2942 /* Return the name of FONT_OBJECT. */
2945 font_get_name (Lisp_Object font_object
)
2947 font_assert (FONT_OBJECT_P (font_object
));
2948 return AREF (font_object
, FONT_NAME_INDEX
);
2952 /* Return the specification of FONT_OBJECT. */
2955 font_get_spec (Lisp_Object font_object
)
2957 Lisp_Object spec
= font_make_spec ();
2960 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2961 ASET (spec
, i
, AREF (font_object
, i
));
2962 ASET (spec
, FONT_SIZE_INDEX
,
2963 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2968 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2969 could not be parsed by font_parse_name, return Qnil. */
2972 font_spec_from_name (Lisp_Object font_name
)
2974 Lisp_Object spec
= Ffont_spec (0, NULL
);
2976 CHECK_STRING (font_name
);
2977 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2979 font_put_extra (spec
, QCname
, font_name
);
2980 font_put_extra (spec
, QCuser_spec
, font_name
);
2986 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2988 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2993 if (! NILP (Ffont_get (font
, QCname
)))
2995 font
= Fcopy_font_spec (font
);
2996 font_put_extra (font
, QCname
, Qnil
);
2999 if (NILP (AREF (font
, prop
))
3000 && prop
!= FONT_FAMILY_INDEX
3001 && prop
!= FONT_FOUNDRY_INDEX
3002 && prop
!= FONT_WIDTH_INDEX
3003 && prop
!= FONT_SIZE_INDEX
)
3005 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3006 font
= Fcopy_font_spec (font
);
3007 ASET (font
, prop
, Qnil
);
3008 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3010 if (prop
== FONT_FAMILY_INDEX
)
3012 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3013 /* If we are setting the font family, we must also clear
3014 FONT_WIDTH_INDEX to avoid rejecting families that lack
3015 support for some widths. */
3016 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3018 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3019 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3020 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3021 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3022 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3023 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3025 else if (prop
== FONT_SIZE_INDEX
)
3027 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3028 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3029 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3031 else if (prop
== FONT_WIDTH_INDEX
)
3032 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3033 attrs
[LFACE_FONT_INDEX
] = font
;
3036 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3037 supports C and matches best with ATTRS and PIXEL_SIZE. */
3040 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3042 Lisp_Object font_entity
;
3045 FRAME_PTR f
= XFRAME (frame
);
3047 if (NILP (XCDR (entities
))
3048 && ASIZE (XCAR (entities
)) == 1)
3050 font_entity
= AREF (XCAR (entities
), 0);
3052 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3057 /* Sort fonts by properties specified in ATTRS. */
3058 prefer
= scratch_font_prefer
;
3060 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3061 ASET (prefer
, i
, Qnil
);
3062 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3064 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3066 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3067 ASET (prefer
, i
, AREF (face_font
, i
));
3069 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3070 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3071 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3072 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3073 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3074 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3075 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3077 return font_sort_entities (entities
, prefer
, frame
, c
);
3080 /* Return a font-entity satisfying SPEC and best matching with face's
3081 font related attributes in ATTRS. C, if not negative, is a
3082 character that the entity must support. */
3085 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3088 Lisp_Object frame
, entities
, val
;
3089 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3093 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3094 if (NILP (registry
[0]))
3096 registry
[0] = DEFAULT_ENCODING
;
3097 registry
[1] = Qascii_0
;
3098 registry
[2] = null_vector
;
3101 registry
[1] = null_vector
;
3103 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3105 struct charset
*encoding
, *repertory
;
3107 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3108 &encoding
, &repertory
) < 0)
3111 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3113 else if (c
> encoding
->max_char
)
3117 work
= Fcopy_font_spec (spec
);
3118 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3119 XSETFRAME (frame
, f
);
3120 size
= AREF (spec
, FONT_SIZE_INDEX
);
3121 pixel_size
= font_pixel_size (f
, spec
);
3122 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3124 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3126 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3128 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3129 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3130 if (! NILP (foundry
[0]))
3131 foundry
[1] = null_vector
;
3132 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3134 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3135 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3137 foundry
[2] = null_vector
;
3140 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3142 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3143 if (! NILP (adstyle
[0]))
3144 adstyle
[1] = null_vector
;
3145 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3147 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3149 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3151 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3153 adstyle
[2] = null_vector
;
3156 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3159 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3162 val
= AREF (work
, FONT_FAMILY_INDEX
);
3163 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3165 val
= attrs
[LFACE_FAMILY_INDEX
];
3166 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3170 family
= alloca ((sizeof family
[0]) * 2);
3172 family
[1] = null_vector
; /* terminator. */
3177 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3178 /* Font family names are case-sensitive under NS. */
3186 if (! NILP (alters
))
3188 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3189 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3190 family
[i
] = XCAR (alters
);
3191 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3193 family
[i
] = null_vector
;
3197 family
= alloca ((sizeof family
[0]) * 3);
3200 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3202 family
[i
] = null_vector
;
3206 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3208 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3209 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3211 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3212 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3214 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3215 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3217 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3218 entities
= font_list_entities (frame
, work
);
3219 if (! NILP (entities
))
3221 val
= font_select_entity (frame
, entities
,
3222 attrs
, pixel_size
, c
);
3235 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3239 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3240 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3241 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3242 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3243 size
= font_pixel_size (f
, spec
);
3247 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3248 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3251 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3252 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3253 if (INTEGERP (height
))
3256 abort(); /* We should never end up here. */
3260 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3264 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3265 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3269 return font_open_entity (f
, entity
, size
);
3273 /* Find a font satisfying SPEC and best matching with face's
3274 attributes in ATTRS on FRAME, and return the opened
3278 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3280 Lisp_Object entity
, name
;
3282 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3285 /* No font is listed for SPEC, but each font-backend may have
3286 the different criteria about "font matching". So, try
3288 entity
= font_matching_entity (f
, attrs
, spec
);
3292 /* Don't lose the original name that was put in initially. We need
3293 it to re-apply the font when font parameters (like hinting or dpi) have
3295 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3298 name
= Ffont_get (spec
, QCuser_spec
);
3299 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3305 /* Make FACE on frame F ready to use the font opened for FACE. */
3308 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3310 if (face
->font
->driver
->prepare_face
)
3311 face
->font
->driver
->prepare_face (f
, face
);
3315 /* Make FACE on frame F stop using the font opened for FACE. */
3318 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3320 if (face
->font
->driver
->done_face
)
3321 face
->font
->driver
->done_face (f
, face
);
3326 /* Open a font matching with font-spec SPEC on frame F. If no proper
3327 font is found, return Qnil. */
3330 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3332 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3334 /* We set up the default font-related attributes of a face to prefer
3336 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3337 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3338 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3340 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3342 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3344 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3346 return font_load_for_lface (f
, attrs
, spec
);
3350 /* Open a font matching with NAME on frame F. If no proper font is
3351 found, return Qnil. */
3354 font_open_by_name (FRAME_PTR f
, const char *name
)
3356 Lisp_Object args
[2];
3357 Lisp_Object spec
, ret
;
3360 args
[1] = make_unibyte_string (name
, strlen (name
));
3361 spec
= Ffont_spec (2, args
);
3362 ret
= font_open_by_spec (f
, spec
);
3363 /* Do not lose name originally put in. */
3365 font_put_extra (ret
, QCuser_spec
, args
[1]);
3371 /* Register font-driver DRIVER. This function is used in two ways.
3373 The first is with frame F non-NULL. In this case, make DRIVER
3374 available (but not yet activated) on F. All frame creaters
3375 (e.g. Fx_create_frame) must call this function at least once with
3376 an available font-driver.
3378 The second is with frame F NULL. In this case, DRIVER is globally
3379 registered in the variable `font_driver_list'. All font-driver
3380 implementations must call this function in its syms_of_XXXX
3381 (e.g. syms_of_xfont). */
3384 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3386 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3387 struct font_driver_list
*prev
, *list
;
3389 if (f
&& ! driver
->draw
)
3390 error ("Unusable font driver for a frame: %s",
3391 SDATA (SYMBOL_NAME (driver
->type
)));
3393 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3394 if (EQ (list
->driver
->type
, driver
->type
))
3395 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3397 list
= xmalloc (sizeof (struct font_driver_list
));
3399 list
->driver
= driver
;
3404 f
->font_driver_list
= list
;
3406 font_driver_list
= list
;
3412 free_font_driver_list (FRAME_PTR f
)
3414 struct font_driver_list
*list
, *next
;
3416 for (list
= f
->font_driver_list
; list
; list
= next
)
3421 f
->font_driver_list
= NULL
;
3425 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3426 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3427 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3429 A caller must free all realized faces if any in advance. The
3430 return value is a list of font backends actually made used on
3434 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3436 Lisp_Object active_drivers
= Qnil
;
3437 struct font_driver
*driver
;
3438 struct font_driver_list
*list
;
3440 /* At first, turn off non-requested drivers, and turn on requested
3442 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3444 driver
= list
->driver
;
3445 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3450 if (driver
->end_for_frame
)
3451 driver
->end_for_frame (f
);
3452 font_finish_cache (f
, driver
);
3457 if (! driver
->start_for_frame
3458 || driver
->start_for_frame (f
) == 0)
3460 font_prepare_cache (f
, driver
);
3467 if (NILP (new_drivers
))
3470 if (! EQ (new_drivers
, Qt
))
3472 /* Re-order the driver list according to new_drivers. */
3473 struct font_driver_list
**list_table
, **next
;
3477 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3478 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3480 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3481 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3484 list_table
[i
++] = list
;
3486 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3488 list_table
[i
++] = list
;
3489 list_table
[i
] = NULL
;
3491 next
= &f
->font_driver_list
;
3492 for (i
= 0; list_table
[i
]; i
++)
3494 *next
= list_table
[i
];
3495 next
= &(*next
)->next
;
3499 if (! f
->font_driver_list
->on
)
3500 { /* None of the drivers is enabled: enable them all.
3501 Happens if you set the list of drivers to (xft x) in your .emacs
3502 and then use it under w32 or ns. */
3503 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3505 struct font_driver
*driver
= list
->driver
;
3506 eassert (! list
->on
);
3507 if (! driver
->start_for_frame
3508 || driver
->start_for_frame (f
) == 0)
3510 font_prepare_cache (f
, driver
);
3517 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3519 active_drivers
= nconc2 (active_drivers
,
3520 Fcons (list
->driver
->type
, Qnil
));
3521 return active_drivers
;
3525 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3527 struct font_data_list
*list
, *prev
;
3529 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3530 prev
= list
, list
= list
->next
)
3531 if (list
->driver
== driver
)
3538 prev
->next
= list
->next
;
3540 f
->font_data_list
= list
->next
;
3548 list
= xmalloc (sizeof (struct font_data_list
));
3549 list
->driver
= driver
;
3550 list
->next
= f
->font_data_list
;
3551 f
->font_data_list
= list
;
3559 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3561 struct font_data_list
*list
;
3563 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3564 if (list
->driver
== driver
)
3572 /* Sets attributes on a font. Any properties that appear in ALIST and
3573 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3574 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3575 arrays of strings. This function is intended for use by the font
3576 drivers to implement their specific font_filter_properties. */
3578 font_filter_properties (Lisp_Object font
,
3580 const char *const boolean_properties
[],
3581 const char *const non_boolean_properties
[])
3586 /* Set boolean values to Qt or Qnil */
3587 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3588 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3590 Lisp_Object key
= XCAR (XCAR (it
));
3591 Lisp_Object val
= XCDR (XCAR (it
));
3592 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3594 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3596 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3597 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3600 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3601 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3602 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3603 || strcmp ("Off", str
) == 0)
3608 Ffont_put (font
, key
, val
);
3612 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3613 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3615 Lisp_Object key
= XCAR (XCAR (it
));
3616 Lisp_Object val
= XCDR (XCAR (it
));
3617 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3618 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3619 Ffont_put (font
, key
, val
);
3624 /* Return the font used to draw character C by FACE at buffer position
3625 POS in window W. If STRING is non-nil, it is a string containing C
3626 at index POS. If C is negative, get C from the current buffer or
3630 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3635 Lisp_Object font_object
;
3637 multibyte
= (NILP (string
)
3638 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3639 : STRING_MULTIBYTE (string
));
3646 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3648 c
= FETCH_CHAR (pos_byte
);
3651 c
= FETCH_BYTE (pos
);
3657 multibyte
= STRING_MULTIBYTE (string
);
3660 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3662 str
= SDATA (string
) + pos_byte
;
3663 c
= STRING_CHAR (str
);
3666 c
= SDATA (string
)[pos
];
3670 f
= XFRAME (w
->frame
);
3671 if (! FRAME_WINDOW_P (f
))
3678 if (STRINGP (string
))
3679 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3680 DEFAULT_FACE_ID
, 0);
3682 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3684 face
= FACE_FROM_ID (f
, face_id
);
3688 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3689 face
= FACE_FROM_ID (f
, face_id
);
3694 XSETFONT (font_object
, face
->font
);
3699 #ifdef HAVE_WINDOW_SYSTEM
3701 /* Check how many characters after POS (at most to *LIMIT) can be
3702 displayed by the same font on the window W. FACE, if non-NULL, is
3703 the face selected for the character at POS. If STRING is not nil,
3704 it is the string to check instead of the current buffer. In that
3705 case, FACE must be not NULL.
3707 The return value is the font-object for the character at POS.
3708 *LIMIT is set to the position where that font can't be used.
3710 It is assured that the current buffer (or STRING) is multibyte. */
3713 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3715 EMACS_INT pos_byte
, ignore
;
3717 Lisp_Object font_object
= Qnil
;
3721 pos_byte
= CHAR_TO_BYTE (pos
);
3726 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3728 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3734 pos_byte
= string_char_to_byte (string
, pos
);
3737 while (pos
< *limit
)
3739 Lisp_Object category
;
3742 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3744 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3745 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3746 if (EQ (category
, QCf
)
3747 || CHAR_VARIATION_SELECTOR_P (c
))
3749 if (NILP (font_object
))
3751 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3752 if (NILP (font_object
))
3756 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3766 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3767 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3768 Return nil otherwise.
3769 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3770 which kind of font it is. It must be one of `font-spec', `font-entity',
3772 (Lisp_Object object
, Lisp_Object extra_type
)
3774 if (NILP (extra_type
))
3775 return (FONTP (object
) ? Qt
: Qnil
);
3776 if (EQ (extra_type
, Qfont_spec
))
3777 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3778 if (EQ (extra_type
, Qfont_entity
))
3779 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3780 if (EQ (extra_type
, Qfont_object
))
3781 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3782 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3785 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3786 doc
: /* Return a newly created font-spec with arguments as properties.
3788 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3789 valid font property name listed below:
3791 `:family', `:weight', `:slant', `:width'
3793 They are the same as face attributes of the same name. See
3794 `set-face-attribute'.
3798 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3802 VALUE must be a string or a symbol specifying the additional
3803 typographic style information of a font, e.g. ``sans''.
3807 VALUE must be a string or a symbol specifying the charset registry and
3808 encoding of a font, e.g. ``iso8859-1''.
3812 VALUE must be a non-negative integer or a floating point number
3813 specifying the font size. It specifies the font size in pixels (if
3814 VALUE is an integer), or in points (if VALUE is a float).
3818 VALUE must be a string of XLFD-style or fontconfig-style font name.
3822 VALUE must be a symbol representing a script that the font must
3823 support. It may be a symbol representing a subgroup of a script
3824 listed in the variable `script-representative-chars'.
3828 VALUE must be a symbol of two-letter ISO-639 language names,
3833 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3834 required OpenType features.
3836 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3837 LANGSYS-TAG: OpenType language system tag symbol,
3838 or nil for the default language system.
3839 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3840 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3842 GSUB and GPOS may contain `nil' element. In such a case, the font
3843 must not have any of the remaining elements.
3845 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3846 be an OpenType font, and whose GPOS table of `thai' script's default
3847 language system must contain `mark' feature.
3849 usage: (font-spec ARGS...) */)
3850 (int nargs
, Lisp_Object
*args
)
3852 Lisp_Object spec
= font_make_spec ();
3855 for (i
= 0; i
< nargs
; i
+= 2)
3857 Lisp_Object key
= args
[i
], val
;
3861 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3864 if (EQ (key
, QCname
))
3867 font_parse_name (SSDATA (val
), spec
);
3868 font_put_extra (spec
, key
, val
);
3872 int idx
= get_font_prop_index (key
);
3876 val
= font_prop_validate (idx
, Qnil
, val
);
3877 if (idx
< FONT_EXTRA_INDEX
)
3878 ASET (spec
, idx
, val
);
3880 font_put_extra (spec
, key
, val
);
3883 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3889 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3890 doc
: /* Return a copy of FONT as a font-spec. */)
3893 Lisp_Object new_spec
, tail
, prev
, extra
;
3897 new_spec
= font_make_spec ();
3898 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3899 ASET (new_spec
, i
, AREF (font
, i
));
3900 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3901 /* We must remove :font-entity property. */
3902 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3903 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3906 extra
= XCDR (extra
);
3908 XSETCDR (prev
, XCDR (tail
));
3911 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3915 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3916 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3917 Every specified properties in FROM override the corresponding
3918 properties in TO. */)
3919 (Lisp_Object from
, Lisp_Object to
)
3921 Lisp_Object extra
, tail
;
3926 to
= Fcopy_font_spec (to
);
3927 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3928 ASET (to
, i
, AREF (from
, i
));
3929 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3930 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3931 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3933 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3936 XSETCDR (slot
, XCDR (XCAR (tail
)));
3938 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3940 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3944 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3945 doc
: /* Return the value of FONT's property KEY.
3946 FONT is a font-spec, a font-entity, or a font-object.
3947 KEY is any symbol, but these are reserved for specific meanings:
3948 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3949 :size, :name, :script, :otf
3950 See the documentation of `font-spec' for their meanings.
3951 In addition, if FONT is a font-entity or a font-object, values of
3952 :script and :otf are different from those of a font-spec as below:
3954 The value of :script may be a list of scripts that are supported by the font.
3956 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3957 representing the OpenType features supported by the font by this form:
3958 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3959 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3961 (Lisp_Object font
, Lisp_Object key
)
3969 idx
= get_font_prop_index (key
);
3970 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3971 return font_style_symbolic (font
, idx
, 0);
3972 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3973 return AREF (font
, idx
);
3974 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3975 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3977 struct font
*fontp
= XFONT_OBJECT (font
);
3979 if (fontp
->driver
->otf_capability
)
3980 val
= fontp
->driver
->otf_capability (fontp
);
3982 val
= Fcons (Qnil
, Qnil
);
3989 #ifdef HAVE_WINDOW_SYSTEM
3991 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3992 doc
: /* Return a plist of face attributes generated by FONT.
3993 FONT is a font name, a font-spec, a font-entity, or a font-object.
3994 The return value is a list of the form
3996 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3998 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3999 compatible with `set-face-attribute'. Some of these key-attribute pairs
4000 may be omitted from the list if they are not specified by FONT.
4002 The optional argument FRAME specifies the frame that the face attributes
4003 are to be displayed on. If omitted, the selected frame is used. */)
4004 (Lisp_Object font
, Lisp_Object frame
)
4007 Lisp_Object plist
[10];
4012 frame
= selected_frame
;
4013 CHECK_LIVE_FRAME (frame
);
4018 int fontset
= fs_query_fontset (font
, 0);
4019 Lisp_Object name
= font
;
4021 font
= fontset_ascii (fontset
);
4022 font
= font_spec_from_name (name
);
4024 signal_error ("Invalid font name", name
);
4026 else if (! FONTP (font
))
4027 signal_error ("Invalid font object", font
);
4029 val
= AREF (font
, FONT_FAMILY_INDEX
);
4032 plist
[n
++] = QCfamily
;
4033 plist
[n
++] = SYMBOL_NAME (val
);
4036 val
= AREF (font
, FONT_SIZE_INDEX
);
4039 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4040 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4041 plist
[n
++] = QCheight
;
4042 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4044 else if (FLOATP (val
))
4046 plist
[n
++] = QCheight
;
4047 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4050 val
= FONT_WEIGHT_FOR_FACE (font
);
4053 plist
[n
++] = QCweight
;
4057 val
= FONT_SLANT_FOR_FACE (font
);
4060 plist
[n
++] = QCslant
;
4064 val
= FONT_WIDTH_FOR_FACE (font
);
4067 plist
[n
++] = QCwidth
;
4071 return Flist (n
, plist
);
4076 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4077 doc
: /* Set one property of FONT: give property KEY value VAL.
4078 FONT is a font-spec, a font-entity, or a font-object.
4080 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4081 accepted by the function `font-spec' (which see), VAL must be what
4082 allowed in `font-spec'.
4084 If FONT is a font-entity or a font-object, KEY must not be the one
4085 accepted by `font-spec'. */)
4086 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4090 idx
= get_font_prop_index (prop
);
4091 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4093 CHECK_FONT_SPEC (font
);
4094 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4098 if (EQ (prop
, QCname
)
4099 || EQ (prop
, QCscript
)
4100 || EQ (prop
, QClang
)
4101 || EQ (prop
, QCotf
))
4102 CHECK_FONT_SPEC (font
);
4105 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4110 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4111 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4112 Optional 2nd argument FRAME specifies the target frame.
4113 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4114 Optional 4th argument PREFER, if non-nil, is a font-spec to
4115 control the order of the returned list. Fonts are sorted by
4116 how close they are to PREFER. */)
4117 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4119 Lisp_Object vec
, list
;
4123 frame
= selected_frame
;
4124 CHECK_LIVE_FRAME (frame
);
4125 CHECK_FONT_SPEC (font_spec
);
4133 if (! NILP (prefer
))
4134 CHECK_FONT_SPEC (prefer
);
4136 list
= font_list_entities (frame
, font_spec
);
4139 if (NILP (XCDR (list
))
4140 && ASIZE (XCAR (list
)) == 1)
4141 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4143 if (! NILP (prefer
))
4144 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4146 vec
= font_vconcat_entity_vectors (list
);
4147 if (n
== 0 || n
>= ASIZE (vec
))
4149 Lisp_Object args
[2];
4153 list
= Fappend (2, args
);
4157 for (list
= Qnil
, n
--; n
>= 0; n
--)
4158 list
= Fcons (AREF (vec
, n
), list
);
4163 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4164 doc
: /* List available font families on the current frame.
4165 Optional argument FRAME, if non-nil, specifies the target frame. */)
4169 struct font_driver_list
*driver_list
;
4173 frame
= selected_frame
;
4174 CHECK_LIVE_FRAME (frame
);
4177 for (driver_list
= f
->font_driver_list
; driver_list
;
4178 driver_list
= driver_list
->next
)
4179 if (driver_list
->driver
->list_family
)
4181 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4182 Lisp_Object tail
= list
;
4184 for (; CONSP (val
); val
= XCDR (val
))
4185 if (NILP (Fmemq (XCAR (val
), tail
))
4186 && SYMBOLP (XCAR (val
)))
4187 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4192 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4193 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4194 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4195 (Lisp_Object font_spec
, Lisp_Object frame
)
4197 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4204 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4205 doc
: /* Return XLFD name of FONT.
4206 FONT is a font-spec, font-entity, or font-object.
4207 If the name is too long for XLFD (maximum 255 chars), return nil.
4208 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4209 the consecutive wildcards are folded to one. */)
4210 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4217 if (FONT_OBJECT_P (font
))
4219 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4221 if (STRINGP (font_name
)
4222 && SDATA (font_name
)[0] == '-')
4224 if (NILP (fold_wildcards
))
4226 strcpy (name
, SSDATA (font_name
));
4229 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4231 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4234 if (! NILP (fold_wildcards
))
4236 char *p0
= name
, *p1
;
4238 while ((p1
= strstr (p0
, "-*-*")))
4240 strcpy (p1
, p1
+ 2);
4245 return build_string (name
);
4248 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4249 doc
: /* Clear font cache. */)
4252 Lisp_Object list
, frame
;
4254 FOR_EACH_FRAME (list
, frame
)
4256 FRAME_PTR f
= XFRAME (frame
);
4257 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4259 for (; driver_list
; driver_list
= driver_list
->next
)
4260 if (driver_list
->on
)
4262 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4263 Lisp_Object val
, tmp
;
4267 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4269 font_assert (! NILP (val
));
4270 tmp
= XCDR (XCAR (val
));
4271 if (XINT (XCAR (tmp
)) == 0)
4273 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4274 XSETCDR (cache
, XCDR (val
));
4284 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4286 struct font
*font
= XFONT_OBJECT (font_object
);
4288 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4289 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4290 struct font_metrics metrics
;
4292 LGLYPH_SET_CODE (glyph
, ecode
);
4294 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4295 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4296 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4297 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4298 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4299 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4303 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4304 doc
: /* Shape the glyph-string GSTRING.
4305 Shaping means substituting glyphs and/or adjusting positions of glyphs
4306 to get the correct visual image of character sequences set in the
4307 header of the glyph-string.
4309 If the shaping was successful, the value is GSTRING itself or a newly
4310 created glyph-string. Otherwise, the value is nil. */)
4311 (Lisp_Object gstring
)
4314 Lisp_Object font_object
, n
, glyph
;
4317 if (! composition_gstring_p (gstring
))
4318 signal_error ("Invalid glyph-string: ", gstring
);
4319 if (! NILP (LGSTRING_ID (gstring
)))
4321 font_object
= LGSTRING_FONT (gstring
);
4322 CHECK_FONT_OBJECT (font_object
);
4323 font
= XFONT_OBJECT (font_object
);
4324 if (! font
->driver
->shape
)
4327 /* Try at most three times with larger gstring each time. */
4328 for (i
= 0; i
< 3; i
++)
4330 n
= font
->driver
->shape (gstring
);
4333 gstring
= larger_vector (gstring
,
4334 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4337 if (i
== 3 || XINT (n
) == 0)
4339 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4340 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4342 glyph
= LGSTRING_GLYPH (gstring
, 0);
4343 from
= LGLYPH_FROM (glyph
);
4344 to
= LGLYPH_TO (glyph
);
4345 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4347 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4351 if (NILP (LGLYPH_ADJUSTMENT (this)))
4356 glyph
= LGSTRING_GLYPH (gstring
, j
);
4357 LGLYPH_SET_FROM (glyph
, from
);
4358 LGLYPH_SET_TO (glyph
, to
);
4360 from
= LGLYPH_FROM (this);
4361 to
= LGLYPH_TO (this);
4366 if (from
> LGLYPH_FROM (this))
4367 from
= LGLYPH_FROM (this);
4368 if (to
< LGLYPH_TO (this))
4369 to
= LGLYPH_TO (this);
4375 glyph
= LGSTRING_GLYPH (gstring
, j
);
4376 LGLYPH_SET_FROM (glyph
, from
);
4377 LGLYPH_SET_TO (glyph
, to
);
4379 return composition_gstring_put_cache (gstring
, XINT (n
));
4382 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4384 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4385 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4387 VARIATION-SELECTOR is a character code of variation selection
4388 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4389 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4390 (Lisp_Object font_object
, Lisp_Object character
)
4392 unsigned variations
[256];
4397 CHECK_FONT_OBJECT (font_object
);
4398 CHECK_CHARACTER (character
);
4399 font
= XFONT_OBJECT (font_object
);
4400 if (! font
->driver
->get_variation_glyphs
)
4402 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4406 for (i
= 0; i
< 255; i
++)
4410 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4411 /* Stops GCC whining about limited range of data type. */
4412 EMACS_INT var
= variations
[i
];
4414 if (var
> MOST_POSITIVE_FIXNUM
)
4415 code
= Fcons (make_number ((variations
[i
]) >> 16),
4416 make_number ((variations
[i
]) & 0xFFFF));
4418 code
= make_number (variations
[i
]);
4419 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4426 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4427 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4428 OTF-FEATURES specifies which features to apply in this format:
4429 (SCRIPT LANGSYS GSUB GPOS)
4431 SCRIPT is a symbol specifying a script tag of OpenType,
4432 LANGSYS is a symbol specifying a langsys tag of OpenType,
4433 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4435 If LANGYS is nil, the default langsys is selected.
4437 The features are applied in the order they appear in the list. The
4438 symbol `*' means to apply all available features not present in this
4439 list, and the remaining features are ignored. For instance, (vatu
4440 pstf * haln) is to apply vatu and pstf in this order, then to apply
4441 all available features other than vatu, pstf, and haln.
4443 The features are applied to the glyphs in the range FROM and TO of
4444 the glyph-string GSTRING-IN.
4446 If some feature is actually applicable, the resulting glyphs are
4447 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4448 this case, the value is the number of produced glyphs.
4450 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4453 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4454 produced in GSTRING-OUT, and the value is nil.
4456 See the documentation of `font-make-gstring' for the format of
4458 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4460 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4465 check_otf_features (otf_features
);
4466 CHECK_FONT_OBJECT (font_object
);
4467 font
= XFONT_OBJECT (font_object
);
4468 if (! font
->driver
->otf_drive
)
4469 error ("Font backend %s can't drive OpenType GSUB table",
4470 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4471 CHECK_CONS (otf_features
);
4472 CHECK_SYMBOL (XCAR (otf_features
));
4473 val
= XCDR (otf_features
);
4474 CHECK_SYMBOL (XCAR (val
));
4475 val
= XCDR (otf_features
);
4478 len
= check_gstring (gstring_in
);
4479 CHECK_VECTOR (gstring_out
);
4480 CHECK_NATNUM (from
);
4482 CHECK_NATNUM (index
);
4484 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4485 args_out_of_range_3 (from
, to
, make_number (len
));
4486 if (XINT (index
) >= ASIZE (gstring_out
))
4487 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4488 num
= font
->driver
->otf_drive (font
, otf_features
,
4489 gstring_in
, XINT (from
), XINT (to
),
4490 gstring_out
, XINT (index
), 0);
4493 return make_number (num
);
4496 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4498 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4499 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4501 (SCRIPT LANGSYS FEATURE ...)
4502 See the documentation of `font-drive-otf' for more detail.
4504 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4505 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4506 character code corresponding to the glyph or nil if there's no
4507 corresponding character. */)
4508 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4511 Lisp_Object gstring_in
, gstring_out
, g
;
4512 Lisp_Object alternates
;
4515 CHECK_FONT_GET_OBJECT (font_object
, font
);
4516 if (! font
->driver
->otf_drive
)
4517 error ("Font backend %s can't drive OpenType GSUB table",
4518 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4519 CHECK_CHARACTER (character
);
4520 CHECK_CONS (otf_features
);
4522 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4523 g
= LGSTRING_GLYPH (gstring_in
, 0);
4524 LGLYPH_SET_CHAR (g
, XINT (character
));
4525 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4526 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4527 gstring_out
, 0, 1)) < 0)
4528 gstring_out
= Ffont_make_gstring (font_object
,
4529 make_number (ASIZE (gstring_out
) * 2));
4531 for (i
= 0; i
< num
; i
++)
4533 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4534 int c
= LGLYPH_CHAR (g
);
4535 unsigned code
= LGLYPH_CODE (g
);
4537 alternates
= Fcons (Fcons (make_number (code
),
4538 c
> 0 ? make_number (c
) : Qnil
),
4541 return Fnreverse (alternates
);
4547 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4548 doc
: /* Open FONT-ENTITY. */)
4549 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4553 CHECK_FONT_ENTITY (font_entity
);
4555 frame
= selected_frame
;
4556 CHECK_LIVE_FRAME (frame
);
4559 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4562 CHECK_NUMBER_OR_FLOAT (size
);
4564 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4566 isize
= XINT (size
);
4570 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4573 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4574 doc
: /* Close FONT-OBJECT. */)
4575 (Lisp_Object font_object
, Lisp_Object frame
)
4577 CHECK_FONT_OBJECT (font_object
);
4579 frame
= selected_frame
;
4580 CHECK_LIVE_FRAME (frame
);
4581 font_close_object (XFRAME (frame
), font_object
);
4585 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4586 doc
: /* Return information about FONT-OBJECT.
4587 The value is a vector:
4588 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4591 NAME is a string of the font name (or nil if the font backend doesn't
4594 FILENAME is a string of the font file (or nil if the font backend
4595 doesn't provide a file name).
4597 PIXEL-SIZE is a pixel size by which the font is opened.
4599 SIZE is a maximum advance width of the font in pixels.
4601 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4604 CAPABILITY is a list whose first element is a symbol representing the
4605 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4606 remaining elements describe the details of the font capability.
4608 If the font is OpenType font, the form of the list is
4609 \(opentype GSUB GPOS)
4610 where GSUB shows which "GSUB" features the font supports, and GPOS
4611 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4612 lists of the format:
4613 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4615 If the font is not OpenType font, currently the length of the form is
4618 SCRIPT is a symbol representing OpenType script tag.
4620 LANGSYS is a symbol representing OpenType langsys tag, or nil
4621 representing the default langsys.
4623 FEATURE is a symbol representing OpenType feature tag.
4625 If the font is not OpenType font, CAPABILITY is nil. */)
4626 (Lisp_Object font_object
)
4631 CHECK_FONT_GET_OBJECT (font_object
, font
);
4633 val
= Fmake_vector (make_number (9), Qnil
);
4634 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4635 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4636 ASET (val
, 2, make_number (font
->pixel_size
));
4637 ASET (val
, 3, make_number (font
->max_width
));
4638 ASET (val
, 4, make_number (font
->ascent
));
4639 ASET (val
, 5, make_number (font
->descent
));
4640 ASET (val
, 6, make_number (font
->space_width
));
4641 ASET (val
, 7, make_number (font
->average_width
));
4642 if (font
->driver
->otf_capability
)
4643 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4647 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4649 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4650 FROM and TO are positions (integers or markers) specifying a region
4651 of the current buffer.
4652 If the optional fourth arg OBJECT is not nil, it is a string or a
4653 vector containing the target characters.
4655 Each element is a vector containing information of a glyph in this format:
4656 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4658 FROM is an index numbers of a character the glyph corresponds to.
4659 TO is the same as FROM.
4660 C is the character of the glyph.
4661 CODE is the glyph-code of C in FONT-OBJECT.
4662 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4663 ADJUSTMENT is always nil.
4664 If FONT-OBJECT doesn't have a glyph for a character,
4665 the corresponding element is nil. */)
4666 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4671 Lisp_Object
*chars
, vec
;
4674 CHECK_FONT_GET_OBJECT (font_object
, font
);
4677 EMACS_INT charpos
, bytepos
;
4679 validate_region (&from
, &to
);
4682 len
= XFASTINT (to
) - XFASTINT (from
);
4683 SAFE_ALLOCA_LISP (chars
, len
);
4684 charpos
= XFASTINT (from
);
4685 bytepos
= CHAR_TO_BYTE (charpos
);
4686 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4688 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4689 chars
[i
] = make_number (c
);
4692 else if (STRINGP (object
))
4694 const unsigned char *p
;
4696 CHECK_NUMBER (from
);
4698 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4699 || XINT (to
) > SCHARS (object
))
4700 args_out_of_range_3 (object
, from
, to
);
4703 len
= XFASTINT (to
) - XFASTINT (from
);
4704 SAFE_ALLOCA_LISP (chars
, len
);
4706 if (STRING_MULTIBYTE (object
))
4707 for (i
= 0; i
< len
; i
++)
4709 c
= STRING_CHAR_ADVANCE (p
);
4710 chars
[i
] = make_number (c
);
4713 for (i
= 0; i
< len
; i
++)
4714 chars
[i
] = make_number (p
[i
]);
4718 CHECK_VECTOR (object
);
4719 CHECK_NUMBER (from
);
4721 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4722 || XINT (to
) > ASIZE (object
))
4723 args_out_of_range_3 (object
, from
, to
);
4726 len
= XFASTINT (to
) - XFASTINT (from
);
4727 for (i
= 0; i
< len
; i
++)
4729 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4730 CHECK_CHARACTER (elt
);
4732 chars
= &(AREF (object
, XFASTINT (from
)));
4735 vec
= Fmake_vector (make_number (len
), Qnil
);
4736 for (i
= 0; i
< len
; i
++)
4739 int c
= XFASTINT (chars
[i
]);
4742 struct font_metrics metrics
;
4744 cod
= code
= font
->driver
->encode_char (font
, c
);
4745 if (code
== FONT_INVALID_CODE
)
4747 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4748 LGLYPH_SET_FROM (g
, i
);
4749 LGLYPH_SET_TO (g
, i
);
4750 LGLYPH_SET_CHAR (g
, c
);
4751 LGLYPH_SET_CODE (g
, code
);
4752 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4753 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4754 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4755 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4756 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4757 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4760 if (! VECTORP (object
))
4765 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4766 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4767 FONT is a font-spec, font-entity, or font-object. */)
4768 (Lisp_Object spec
, Lisp_Object font
)
4770 CHECK_FONT_SPEC (spec
);
4773 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4776 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4777 doc
: /* Return a font-object for displaying a character at POSITION.
4778 Optional second arg WINDOW, if non-nil, is a window displaying
4779 the current buffer. It defaults to the currently selected window. */)
4780 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4787 CHECK_NUMBER_COERCE_MARKER (position
);
4788 pos
= XINT (position
);
4789 if (pos
< BEGV
|| pos
>= ZV
)
4790 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4794 CHECK_NUMBER (position
);
4795 CHECK_STRING (string
);
4796 pos
= XINT (position
);
4797 if (pos
< 0 || pos
>= SCHARS (string
))
4798 args_out_of_range (string
, position
);
4801 window
= selected_window
;
4802 CHECK_LIVE_WINDOW (window
);
4803 w
= XWINDOW (window
);
4805 return font_at (-1, pos
, NULL
, w
, string
);
4809 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4810 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4811 The value is a number of glyphs drawn.
4812 Type C-l to recover what previously shown. */)
4813 (Lisp_Object font_object
, Lisp_Object string
)
4815 Lisp_Object frame
= selected_frame
;
4816 FRAME_PTR f
= XFRAME (frame
);
4822 CHECK_FONT_GET_OBJECT (font_object
, font
);
4823 CHECK_STRING (string
);
4824 len
= SCHARS (string
);
4825 code
= alloca (sizeof (unsigned) * len
);
4826 for (i
= 0; i
< len
; i
++)
4828 Lisp_Object ch
= Faref (string
, make_number (i
));
4832 code
[i
] = font
->driver
->encode_char (font
, c
);
4833 if (code
[i
] == FONT_INVALID_CODE
)
4836 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4838 if (font
->driver
->prepare_face
)
4839 font
->driver
->prepare_face (f
, face
);
4840 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4841 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4842 if (font
->driver
->done_face
)
4843 font
->driver
->done_face (f
, face
);
4845 return make_number (len
);
4849 #endif /* FONT_DEBUG */
4851 #ifdef HAVE_WINDOW_SYSTEM
4853 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4854 doc
: /* Return information about a font named NAME on frame FRAME.
4855 If FRAME is omitted or nil, use the selected frame.
4856 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4857 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4859 OPENED-NAME is the name used for opening the font,
4860 FULL-NAME is the full name of the font,
4861 SIZE is the pixelsize of the font,
4862 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4863 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4864 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4865 how to compose characters.
4866 If the named font is not yet loaded, return nil. */)
4867 (Lisp_Object name
, Lisp_Object frame
)
4872 Lisp_Object font_object
;
4874 (*check_window_system_func
) ();
4877 CHECK_STRING (name
);
4879 frame
= selected_frame
;
4880 CHECK_LIVE_FRAME (frame
);
4885 int fontset
= fs_query_fontset (name
, 0);
4888 name
= fontset_ascii (fontset
);
4889 font_object
= font_open_by_name (f
, SSDATA (name
));
4891 else if (FONT_OBJECT_P (name
))
4893 else if (FONT_ENTITY_P (name
))
4894 font_object
= font_open_entity (f
, name
, 0);
4897 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4898 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4900 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4902 if (NILP (font_object
))
4904 font
= XFONT_OBJECT (font_object
);
4906 info
= Fmake_vector (make_number (7), Qnil
);
4907 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4908 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4909 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4910 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4911 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4912 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4913 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4916 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4917 close it now. Perhaps, we should manage font-objects
4918 by `reference-count'. */
4919 font_close_object (f
, font_object
);
4926 #define BUILD_STYLE_TABLE(TBL) \
4927 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4930 build_style_table (const struct table_entry
*entry
, int nelement
)
4933 Lisp_Object table
, elt
;
4935 table
= Fmake_vector (make_number (nelement
), Qnil
);
4936 for (i
= 0; i
< nelement
; i
++)
4938 for (j
= 0; entry
[i
].names
[j
]; j
++);
4939 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4940 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4941 for (j
= 0; entry
[i
].names
[j
]; j
++)
4942 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4943 ASET (table
, i
, elt
);
4948 /* The deferred font-log data of the form [ACTION ARG RESULT].
4949 If ACTION is not nil, that is added to the log when font_add_log is
4950 called next time. At that time, ACTION is set back to nil. */
4951 static Lisp_Object Vfont_log_deferred
;
4953 /* Prepend the font-related logging data in Vfont_log if it is not
4954 `t'. ACTION describes a kind of font-related action (e.g. listing,
4955 opening), ARG is the argument for the action, and RESULT is the
4956 result of the action. */
4958 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4960 Lisp_Object tail
, val
;
4963 if (EQ (Vfont_log
, Qt
))
4965 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4967 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4969 ASET (Vfont_log_deferred
, 0, Qnil
);
4970 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4971 AREF (Vfont_log_deferred
, 2));
4976 Lisp_Object tail
, elt
;
4977 Lisp_Object equalstr
= build_string ("=");
4979 val
= Ffont_xlfd_name (arg
, Qt
);
4980 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4984 if (EQ (XCAR (elt
), QCscript
)
4985 && SYMBOLP (XCDR (elt
)))
4986 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4987 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4988 else if (EQ (XCAR (elt
), QClang
)
4989 && SYMBOLP (XCDR (elt
)))
4990 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4991 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4992 else if (EQ (XCAR (elt
), QCotf
)
4993 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4994 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4996 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5002 && VECTORP (XCAR (result
))
5003 && ASIZE (XCAR (result
)) > 0
5004 && FONTP (AREF (XCAR (result
), 0)))
5005 result
= font_vconcat_entity_vectors (result
);
5008 val
= Ffont_xlfd_name (result
, Qt
);
5009 if (! FONT_SPEC_P (result
))
5010 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5011 build_string (":"), val
);
5014 else if (CONSP (result
))
5016 result
= Fcopy_sequence (result
);
5017 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5021 val
= Ffont_xlfd_name (val
, Qt
);
5022 XSETCAR (tail
, val
);
5025 else if (VECTORP (result
))
5027 result
= Fcopy_sequence (result
);
5028 for (i
= 0; i
< ASIZE (result
); i
++)
5030 val
= AREF (result
, i
);
5032 val
= Ffont_xlfd_name (val
, Qt
);
5033 ASET (result
, i
, val
);
5036 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5039 /* Record a font-related logging data to be added to Vfont_log when
5040 font_add_log is called next time. ACTION, ARG, RESULT are the same
5044 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5046 if (EQ (Vfont_log
, Qt
))
5048 ASET (Vfont_log_deferred
, 0, build_string (action
));
5049 ASET (Vfont_log_deferred
, 1, arg
);
5050 ASET (Vfont_log_deferred
, 2, result
);
5056 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5057 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5058 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5059 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5060 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5061 /* Note that the other elements in sort_shift_bits are not used. */
5063 staticpro (&font_charset_alist
);
5064 font_charset_alist
= Qnil
;
5066 DEFSYM (Qopentype
, "opentype");
5068 DEFSYM (Qascii_0
, "ascii-0");
5069 DEFSYM (Qiso8859_1
, "iso8859-1");
5070 DEFSYM (Qiso10646_1
, "iso10646-1");
5071 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5072 DEFSYM (Qunicode_sip
, "unicode-sip");
5076 DEFSYM (QCotf
, ":otf");
5077 DEFSYM (QClang
, ":lang");
5078 DEFSYM (QCscript
, ":script");
5079 DEFSYM (QCantialias
, ":antialias");
5081 DEFSYM (QCfoundry
, ":foundry");
5082 DEFSYM (QCadstyle
, ":adstyle");
5083 DEFSYM (QCregistry
, ":registry");
5084 DEFSYM (QCspacing
, ":spacing");
5085 DEFSYM (QCdpi
, ":dpi");
5086 DEFSYM (QCscalable
, ":scalable");
5087 DEFSYM (QCavgwidth
, ":avgwidth");
5088 DEFSYM (QCfont_entity
, ":font-entity");
5089 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5099 DEFSYM (QCuser_spec
, "user-spec");
5101 staticpro (&null_vector
);
5102 null_vector
= Fmake_vector (make_number (0), Qnil
);
5104 staticpro (&scratch_font_spec
);
5105 scratch_font_spec
= Ffont_spec (0, NULL
);
5106 staticpro (&scratch_font_prefer
);
5107 scratch_font_prefer
= Ffont_spec (0, NULL
);
5109 staticpro (&Vfont_log_deferred
);
5110 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5114 staticpro (&otf_list
);
5116 #endif /* HAVE_LIBOTF */
5120 defsubr (&Sfont_spec
);
5121 defsubr (&Sfont_get
);
5122 #ifdef HAVE_WINDOW_SYSTEM
5123 defsubr (&Sfont_face_attributes
);
5125 defsubr (&Sfont_put
);
5126 defsubr (&Slist_fonts
);
5127 defsubr (&Sfont_family_list
);
5128 defsubr (&Sfind_font
);
5129 defsubr (&Sfont_xlfd_name
);
5130 defsubr (&Sclear_font_cache
);
5131 defsubr (&Sfont_shape_gstring
);
5132 defsubr (&Sfont_variation_glyphs
);
5134 defsubr (&Sfont_drive_otf
);
5135 defsubr (&Sfont_otf_alternates
);
5139 defsubr (&Sopen_font
);
5140 defsubr (&Sclose_font
);
5141 defsubr (&Squery_font
);
5142 defsubr (&Sfont_get_glyphs
);
5143 defsubr (&Sfont_match_p
);
5144 defsubr (&Sfont_at
);
5146 defsubr (&Sdraw_string
);
5148 #endif /* FONT_DEBUG */
5149 #ifdef HAVE_WINDOW_SYSTEM
5150 defsubr (&Sfont_info
);
5153 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5155 Alist of fontname patterns vs the corresponding encoding and repertory info.
5156 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5157 where ENCODING is a charset or a char-table,
5158 and REPERTORY is a charset, a char-table, or nil.
5160 If ENCODING and REPERTORY are the same, the element can have the form
5161 \(REGEXP . ENCODING).
5163 ENCODING is for converting a character to a glyph code of the font.
5164 If ENCODING is a charset, encoding a character by the charset gives
5165 the corresponding glyph code. If ENCODING is a char-table, looking up
5166 the table by a character gives the corresponding glyph code.
5168 REPERTORY specifies a repertory of characters supported by the font.
5169 If REPERTORY is a charset, all characters beloging to the charset are
5170 supported. If REPERTORY is a char-table, all characters who have a
5171 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5172 gets the repertory information by an opened font and ENCODING. */);
5173 Vfont_encoding_alist
= Qnil
;
5175 /* FIXME: These 3 vars are not quite what they appear: setq on them
5176 won't have any effect other than disconnect them from the style
5177 table used by the font display code. So we make them read-only,
5178 to avoid this confusing situation. */
5180 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5181 doc
: /* Vector of valid font weight values.
5182 Each element has the form:
5183 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5184 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5185 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5186 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5188 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5189 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5190 See `font-weight-table' for the format of the vector. */);
5191 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5192 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5194 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5195 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5196 See `font-weight-table' for the format of the vector. */);
5197 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5198 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5200 staticpro (&font_style_table
);
5201 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5202 ASET (font_style_table
, 0, Vfont_weight_table
);
5203 ASET (font_style_table
, 1, Vfont_slant_table
);
5204 ASET (font_style_table
, 2, Vfont_width_table
);
5206 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5207 *Logging list of font related actions and results.
5208 The value t means to suppress the logging.
5209 The initial value is set to nil if the environment variable
5210 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5213 #ifdef HAVE_WINDOW_SYSTEM
5214 #ifdef HAVE_FREETYPE
5216 #ifdef HAVE_X_WINDOWS
5221 #endif /* HAVE_XFT */
5222 #endif /* HAVE_X_WINDOWS */
5223 #else /* not HAVE_FREETYPE */
5224 #ifdef HAVE_X_WINDOWS
5226 #endif /* HAVE_X_WINDOWS */
5227 #endif /* not HAVE_FREETYPE */
5230 #endif /* HAVE_BDFFONT */
5233 #endif /* WINDOWSNT */
5236 #endif /* HAVE_NS */
5237 #endif /* HAVE_WINDOW_SYSTEM */
5243 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;