1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2011 Free Software Foundation, Inc.
4 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
51 Lisp_Object Qopentype
;
53 /* Important character set strings. */
54 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
56 #define DEFAULT_ENCODING Qiso8859_1
58 /* Unicode category `Cf'. */
59 static Lisp_Object QCf
;
61 /* Special vector of zero length. This is repeatedly used by (struct
62 font_driver *)->list when a specified font is not found. */
63 static Lisp_Object null_vector
;
65 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
66 static Lisp_Object font_style_table
;
68 /* Structure used for tables mapping weight, slant, and width numeric
69 values and their names. */
74 /* The first one is a valid name as a face attribute.
75 The second one (if any) is a typical name in XLFD field. */
79 /* Table of weight numeric values and their names. This table must be
80 sorted by numeric values in ascending order. */
82 static const struct table_entry weight_table
[] =
85 { 20, { "ultra-light", "ultralight" }},
86 { 40, { "extra-light", "extralight" }},
88 { 75, { "semi-light", "semilight", "demilight", "book" }},
89 { 100, { "normal", "medium", "regular", "unspecified" }},
90 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
92 { 205, { "extra-bold", "extrabold" }},
93 { 210, { "ultra-bold", "ultrabold", "black" }}
96 /* Table of slant numeric values and their names. This table must be
97 sorted by numeric values in ascending order. */
99 static const struct table_entry slant_table
[] =
101 { 0, { "reverse-oblique", "ro" }},
102 { 10, { "reverse-italic", "ri" }},
103 { 100, { "normal", "r", "unspecified" }},
104 { 200, { "italic" ,"i", "ot" }},
105 { 210, { "oblique", "o" }}
108 /* Table of width numeric values and their names. This table must be
109 sorted by numeric values in ascending order. */
111 static const struct table_entry width_table
[] =
113 { 50, { "ultra-condensed", "ultracondensed" }},
114 { 63, { "extra-condensed", "extracondensed" }},
115 { 75, { "condensed", "compressed", "narrow" }},
116 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
117 { 100, { "normal", "medium", "regular", "unspecified" }},
118 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
119 { 125, { "expanded" }},
120 { 150, { "extra-expanded", "extraexpanded" }},
121 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
124 Lisp_Object QCfoundry
;
125 static Lisp_Object QCadstyle
, QCregistry
;
126 /* Symbols representing keys of font extra info. */
127 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
128 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
129 /* Symbols representing values of font spacing property. */
130 Lisp_Object Qc
, Qm
, Qp
, Qd
;
131 /* Special ADSTYLE properties to avoid fonts used for Latin
132 characters; used in xfont.c and ftfont.c. */
133 Lisp_Object Qja
, Qko
;
135 Lisp_Object QCuser_spec
;
137 /* Alist of font registry symbol and the corresponding charsets
138 information. The information is retrieved from
139 Vfont_encoding_alist on demand.
141 Eash element has the form:
142 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
146 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
147 encodes a character code to a glyph code of a font, and
148 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
149 character is supported by a font.
151 The latter form means that the information for REGISTRY couldn't be
153 static Lisp_Object font_charset_alist
;
155 /* List of all font drivers. Each font-backend (XXXfont.c) calls
156 register_font_driver in syms_of_XXXfont to register its font-driver
158 static struct font_driver_list
*font_driver_list
;
162 /* Creaters of font-related Lisp object. */
165 font_make_spec (void)
167 Lisp_Object font_spec
;
168 struct font_spec
*spec
169 = ((struct font_spec
*)
170 allocate_pseudovector (VECSIZE (struct font_spec
),
171 FONT_SPEC_MAX
, PVEC_FONT
));
172 XSETFONT (font_spec
, spec
);
177 font_make_entity (void)
179 Lisp_Object font_entity
;
180 struct font_entity
*entity
181 = ((struct font_entity
*)
182 allocate_pseudovector (VECSIZE (struct font_entity
),
183 FONT_ENTITY_MAX
, PVEC_FONT
));
184 XSETFONT (font_entity
, entity
);
188 /* Create a font-object whose structure size is SIZE. If ENTITY is
189 not nil, copy properties from ENTITY to the font-object. If
190 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
192 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
194 Lisp_Object font_object
;
196 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
199 XSETFONT (font_object
, font
);
203 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
204 font
->props
[i
] = AREF (entity
, i
);
205 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
206 font
->props
[FONT_EXTRA_INDEX
]
207 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
210 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
216 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
217 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
218 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
220 static unsigned font_encode_char (Lisp_Object
, int);
222 /* Number of registered font drivers. */
223 static int num_font_drivers
;
226 /* Return a Lispy value of a font property value at STR and LEN bytes.
227 If STR is "*", it returns nil.
228 If FORCE_SYMBOL is zero and all characters in STR are digits, it
229 returns an integer. Otherwise, it returns a symbol interned from
233 font_intern_prop (const char *str
, int len
, int force_symbol
)
238 EMACS_INT nbytes
, nchars
;
240 if (len
== 1 && *str
== '*')
242 if (!force_symbol
&& len
>=1 && isdigit (*str
))
244 for (i
= 1; i
< len
; i
++)
245 if (! isdigit (str
[i
]))
248 return make_number (atoi (str
));
251 /* The following code is copied from the function intern (in
252 lread.c), and modified to suite our purpose. */
254 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
255 obarray
= check_obarray (obarray
);
256 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
257 if (len
== nchars
|| len
!= nbytes
)
258 /* CONTENTS contains no multibyte sequences or contains an invalid
259 multibyte sequence. We'll make a unibyte string. */
260 tem
= oblookup (obarray
, str
, len
, len
);
262 tem
= oblookup (obarray
, str
, nchars
, len
);
265 if (len
== nchars
|| len
!= nbytes
)
266 tem
= make_unibyte_string (str
, len
);
268 tem
= make_multibyte_string (str
, nchars
, len
);
269 return Fintern (tem
, obarray
);
272 /* Return a pixel size of font-spec SPEC on frame F. */
275 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
277 #ifdef HAVE_WINDOW_SYSTEM
278 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
287 font_assert (FLOATP (size
));
288 point_size
= XFLOAT_DATA (size
);
289 val
= AREF (spec
, FONT_DPI_INDEX
);
294 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
302 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
303 font vector. If VAL is not valid (i.e. not registered in
304 font_style_table), return -1 if NOERROR is zero, and return a
305 proper index if NOERROR is nonzero. In that case, register VAL in
306 font_style_table if VAL is a symbol, and return a closest index if
307 VAL is an integer. */
310 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
312 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
313 int len
= ASIZE (table
);
319 Lisp_Object args
[2], elt
;
321 /* At first try exact match. */
322 for (i
= 0; i
< len
; i
++)
323 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
324 if (EQ (val
, AREF (AREF (table
, i
), j
)))
325 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
326 | (i
<< 4) | (j
- 1));
327 /* Try also with case-folding match. */
328 s
= SSDATA (SYMBOL_NAME (val
));
329 for (i
= 0; i
< len
; i
++)
330 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
332 elt
= AREF (AREF (table
, i
), j
);
333 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
334 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
335 | (i
<< 4) | (j
- 1));
341 elt
= Fmake_vector (make_number (2), make_number (100));
344 args
[1] = Fmake_vector (make_number (1), elt
);
345 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
346 return (100 << 8) | (i
<< 4);
351 int numeric
= XINT (val
);
353 for (i
= 0, last_n
= -1; i
< len
; i
++)
355 int n
= XINT (AREF (AREF (table
, i
), 0));
358 return (n
<< 8) | (i
<< 4);
363 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
364 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
370 return ((last_n
<< 8) | ((i
- 1) << 4));
375 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
377 Lisp_Object val
= AREF (font
, prop
);
378 Lisp_Object table
, elt
;
383 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
384 i
= XINT (val
) & 0xFF;
385 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
386 elt
= AREF (table
, ((i
>> 4) & 0xF));
387 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
388 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
391 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
392 FONTNAME. ENCODING is a charset symbol that specifies the encoding
393 of the font. REPERTORY is a charset symbol or nil. */
396 find_font_encoding (Lisp_Object fontname
)
398 Lisp_Object tail
, elt
;
400 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
404 && STRINGP (XCAR (elt
))
405 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
406 && (SYMBOLP (XCDR (elt
))
407 ? CHARSETP (XCDR (elt
))
408 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
414 /* Return encoding charset and repertory charset for REGISTRY in
415 ENCODING and REPERTORY correspondingly. If correct information for
416 REGISTRY is available, return 0. Otherwise return -1. */
419 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
422 int encoding_id
, repertory_id
;
424 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
430 encoding_id
= XINT (XCAR (val
));
431 repertory_id
= XINT (XCDR (val
));
435 val
= find_font_encoding (SYMBOL_NAME (registry
));
436 if (SYMBOLP (val
) && CHARSETP (val
))
438 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
440 else if (CONSP (val
))
442 if (! CHARSETP (XCAR (val
)))
444 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
445 if (NILP (XCDR (val
)))
449 if (! CHARSETP (XCDR (val
)))
451 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
456 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
458 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
462 *encoding
= CHARSET_FROM_ID (encoding_id
);
464 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
469 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
474 /* Font property value validaters. See the comment of
475 font_property_table for the meaning of the arguments. */
477 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
478 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
479 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
480 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
481 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
482 static int get_font_prop_index (Lisp_Object
);
485 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
488 val
= Fintern (val
, Qnil
);
491 else if (EQ (prop
, QCregistry
))
492 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
498 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
500 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
501 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
507 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
511 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
513 if ((n
& 0xF) + 1 >= ASIZE (elt
))
515 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
519 else if (SYMBOLP (val
))
521 int n
= font_style_to_value (prop
, val
, 0);
523 val
= n
>= 0 ? make_number (n
) : Qerror
;
531 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
533 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
538 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
540 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
542 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
544 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
546 if (spacing
== 'c' || spacing
== 'C')
547 return make_number (FONT_SPACING_CHARCELL
);
548 if (spacing
== 'm' || spacing
== 'M')
549 return make_number (FONT_SPACING_MONO
);
550 if (spacing
== 'p' || spacing
== 'P')
551 return make_number (FONT_SPACING_PROPORTIONAL
);
552 if (spacing
== 'd' || spacing
== 'D')
553 return make_number (FONT_SPACING_DUAL
);
559 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
561 Lisp_Object tail
, tmp
;
564 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
565 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
566 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
569 if (! SYMBOLP (XCAR (val
)))
574 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
576 for (i
= 0; i
< 2; i
++)
583 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
584 if (! SYMBOLP (XCAR (tmp
)))
592 /* Structure of known font property keys and validater of the
596 /* Pointer to the key symbol. */
598 /* Function to validate PROP's value VAL, or NULL if any value is
599 ok. The value is VAL or its regularized value if VAL is valid,
600 and Qerror if not. */
601 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
602 } font_property_table
[] =
603 { { &QCtype
, font_prop_validate_symbol
},
604 { &QCfoundry
, font_prop_validate_symbol
},
605 { &QCfamily
, font_prop_validate_symbol
},
606 { &QCadstyle
, font_prop_validate_symbol
},
607 { &QCregistry
, font_prop_validate_symbol
},
608 { &QCweight
, font_prop_validate_style
},
609 { &QCslant
, font_prop_validate_style
},
610 { &QCwidth
, font_prop_validate_style
},
611 { &QCsize
, font_prop_validate_non_neg
},
612 { &QCdpi
, font_prop_validate_non_neg
},
613 { &QCspacing
, font_prop_validate_spacing
},
614 { &QCavgwidth
, font_prop_validate_non_neg
},
615 /* The order of the above entries must match with enum
616 font_property_index. */
617 { &QClang
, font_prop_validate_symbol
},
618 { &QCscript
, font_prop_validate_symbol
},
619 { &QCotf
, font_prop_validate_otf
}
622 /* Size (number of elements) of the above table. */
623 #define FONT_PROPERTY_TABLE_SIZE \
624 ((sizeof font_property_table) / (sizeof *font_property_table))
626 /* Return an index number of font property KEY or -1 if KEY is not an
627 already known property. */
630 get_font_prop_index (Lisp_Object key
)
634 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
635 if (EQ (key
, *font_property_table
[i
].key
))
640 /* Validate the font property. The property key is specified by the
641 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
642 signal an error. The value is VAL or the regularized one. */
645 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
647 Lisp_Object validated
;
652 prop
= *font_property_table
[idx
].key
;
655 idx
= get_font_prop_index (prop
);
659 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
660 if (EQ (validated
, Qerror
))
661 signal_error ("invalid font property", Fcons (prop
, val
));
666 /* Store VAL as a value of extra font property PROP in FONT while
667 keeping the sorting order. Don't check the validity of VAL. */
670 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
672 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
673 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
677 Lisp_Object prev
= Qnil
;
680 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
681 prev
= extra
, extra
= XCDR (extra
);
684 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
686 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
692 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
697 /* Font name parser and unparser */
699 static int parse_matrix (const char *);
700 static int font_expand_wildcards (Lisp_Object
*, int);
701 static int font_parse_name (char *, Lisp_Object
);
703 /* An enumerator for each field of an XLFD font name. */
704 enum xlfd_field_index
723 /* An enumerator for mask bit corresponding to each XLFD field. */
726 XLFD_FOUNDRY_MASK
= 0x0001,
727 XLFD_FAMILY_MASK
= 0x0002,
728 XLFD_WEIGHT_MASK
= 0x0004,
729 XLFD_SLANT_MASK
= 0x0008,
730 XLFD_SWIDTH_MASK
= 0x0010,
731 XLFD_ADSTYLE_MASK
= 0x0020,
732 XLFD_PIXEL_MASK
= 0x0040,
733 XLFD_POINT_MASK
= 0x0080,
734 XLFD_RESX_MASK
= 0x0100,
735 XLFD_RESY_MASK
= 0x0200,
736 XLFD_SPACING_MASK
= 0x0400,
737 XLFD_AVGWIDTH_MASK
= 0x0800,
738 XLFD_REGISTRY_MASK
= 0x1000,
739 XLFD_ENCODING_MASK
= 0x2000
743 /* Parse P pointing the pixel/point size field of the form
744 `[A B C D]' which specifies a transformation matrix:
750 by which all glyphs of the font are transformed. The spec says
751 that scalar value N for the pixel/point size is equivalent to:
752 A = N * resx/resy, B = C = 0, D = N.
754 Return the scalar value N if the form is valid. Otherwise return
758 parse_matrix (const char *p
)
764 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
767 matrix
[i
] = - strtod (p
+ 1, &end
);
769 matrix
[i
] = strtod (p
, &end
);
772 return (i
== 4 ? (int) matrix
[3] : -1);
775 /* Expand a wildcard field in FIELD (the first N fields are filled) to
776 multiple fields to fill in all 14 XLFD fields while restring a
777 field position by its contents. */
780 font_expand_wildcards (Lisp_Object
*field
, int n
)
783 Lisp_Object tmp
[XLFD_LAST_INDEX
];
784 /* Array of information about where this element can go. Nth
785 element is for Nth element of FIELD. */
787 /* Minimum possible field. */
789 /* Maxinum possible field. */
791 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
793 } range
[XLFD_LAST_INDEX
];
795 int range_from
, range_to
;
798 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
799 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
800 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
801 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
802 | XLFD_AVGWIDTH_MASK)
803 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
805 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
806 field. The value is shifted to left one bit by one in the
808 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
809 range_mask
= (range_mask
<< 1) | 1;
811 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
812 position-based retriction for FIELD[I]. */
813 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
814 i
++, range_from
++, range_to
++, range_mask
<<= 1)
816 Lisp_Object val
= field
[i
];
822 range
[i
].from
= range_from
;
823 range
[i
].to
= range_to
;
824 range
[i
].mask
= range_mask
;
828 /* The triplet FROM, TO, and MASK is a value-based
829 retriction for FIELD[I]. */
835 int numeric
= XINT (val
);
838 from
= to
= XLFD_ENCODING_INDEX
,
839 mask
= XLFD_ENCODING_MASK
;
840 else if (numeric
== 0)
841 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
842 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
843 else if (numeric
<= 48)
844 from
= to
= XLFD_PIXEL_INDEX
,
845 mask
= XLFD_PIXEL_MASK
;
847 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
848 mask
= XLFD_LARGENUM_MASK
;
850 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
851 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
852 mask
= XLFD_NULL_MASK
;
854 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
857 Lisp_Object name
= SYMBOL_NAME (val
);
859 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
860 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
861 mask
= XLFD_REGENC_MASK
;
863 from
= to
= XLFD_ENCODING_INDEX
,
864 mask
= XLFD_ENCODING_MASK
;
866 else if (range_from
<= XLFD_WEIGHT_INDEX
867 && range_to
>= XLFD_WEIGHT_INDEX
868 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
869 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
870 else if (range_from
<= XLFD_SLANT_INDEX
871 && range_to
>= XLFD_SLANT_INDEX
872 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
873 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
874 else if (range_from
<= XLFD_SWIDTH_INDEX
875 && range_to
>= XLFD_SWIDTH_INDEX
876 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
877 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
880 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
881 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
883 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
884 mask
= XLFD_SYMBOL_MASK
;
887 /* Merge position-based and value-based restrictions. */
889 while (from
< range_from
)
890 mask
&= ~(1 << from
++);
891 while (from
< 14 && ! (mask
& (1 << from
)))
893 while (to
> range_to
)
894 mask
&= ~(1 << to
--);
895 while (to
>= 0 && ! (mask
& (1 << to
)))
899 range
[i
].from
= from
;
901 range
[i
].mask
= mask
;
903 if (from
> range_from
|| to
< range_to
)
905 /* The range is narrowed by value-based restrictions.
906 Reflect it to the other fields. */
908 /* Following fields should be after FROM. */
910 /* Preceding fields should be before TO. */
911 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
913 /* Check FROM for non-wildcard field. */
914 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
916 while (range
[j
].from
< from
)
917 range
[j
].mask
&= ~(1 << range
[j
].from
++);
918 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
920 range
[j
].from
= from
;
923 from
= range
[j
].from
;
924 if (range
[j
].to
> to
)
926 while (range
[j
].to
> to
)
927 range
[j
].mask
&= ~(1 << range
[j
].to
--);
928 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
941 /* Decide all fileds from restrictions in RANGE. */
942 for (i
= j
= 0; i
< n
; i
++)
944 if (j
< range
[i
].from
)
946 if (i
== 0 || ! NILP (tmp
[i
- 1]))
947 /* None of TMP[X] corresponds to Jth field. */
949 for (; j
< range
[i
].from
; j
++)
954 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
956 for (; j
< XLFD_LAST_INDEX
; j
++)
958 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
959 field
[XLFD_ENCODING_INDEX
]
960 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
965 /* Parse NAME (null terminated) as XLFD and store information in FONT
966 (font-spec or font-entity). Size property of FONT is set as
968 specified XLFD fields FONT property
969 --------------------- -------------
970 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
971 POINT_SIZE and RESY calculated pixel size (Lisp integer)
972 POINT_SIZE POINT_SIZE/10 (Lisp float)
974 If NAME is successfully parsed, return 0. Otherwise return -1.
976 FONT is usually a font-spec, but when this function is called from
977 X font backend driver, it is a font-entity. In that case, NAME is
978 a fully specified XLFD. */
981 font_parse_xlfd (char *name
, Lisp_Object font
)
983 int len
= strlen (name
);
985 char *f
[XLFD_LAST_INDEX
+ 1];
989 if (len
> 255 || !len
)
990 /* Maximum XLFD name length is 255. */
992 /* Accept "*-.." as a fully specified XLFD. */
993 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
994 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
997 for (p
= name
+ i
; *p
; p
++)
1001 if (i
== XLFD_LAST_INDEX
)
1006 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1007 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1009 if (i
== XLFD_LAST_INDEX
)
1011 /* Fully specified XLFD. */
1014 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1015 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1016 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1017 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1019 val
= INTERN_FIELD_SYM (i
);
1022 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1024 ASET (font
, j
, make_number (n
));
1027 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1028 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1029 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1031 ASET (font
, FONT_REGISTRY_INDEX
,
1032 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1033 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1035 p
= f
[XLFD_PIXEL_INDEX
];
1036 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1037 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1040 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1042 ASET (font
, FONT_SIZE_INDEX
, val
);
1043 else if (FONT_ENTITY_P (font
))
1047 double point_size
= -1;
1049 font_assert (FONT_SPEC_P (font
));
1050 p
= f
[XLFD_POINT_INDEX
];
1052 point_size
= parse_matrix (p
);
1053 else if (isdigit (*p
))
1054 point_size
= atoi (p
), point_size
/= 10;
1055 if (point_size
>= 0)
1056 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1060 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1061 if (! NILP (val
) && ! INTEGERP (val
))
1063 ASET (font
, FONT_DPI_INDEX
, val
);
1064 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1067 val
= font_prop_validate_spacing (QCspacing
, val
);
1068 if (! INTEGERP (val
))
1070 ASET (font
, FONT_SPACING_INDEX
, val
);
1072 p
= f
[XLFD_AVGWIDTH_INDEX
];
1075 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1076 if (! NILP (val
) && ! INTEGERP (val
))
1078 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1082 int wild_card_found
= 0;
1083 Lisp_Object prop
[XLFD_LAST_INDEX
];
1085 if (FONT_ENTITY_P (font
))
1087 for (j
= 0; j
< i
; j
++)
1091 if (f
[j
][1] && f
[j
][1] != '-')
1094 wild_card_found
= 1;
1097 prop
[j
] = INTERN_FIELD (j
);
1099 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1101 if (! wild_card_found
)
1103 if (font_expand_wildcards (prop
, i
) < 0)
1106 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1107 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1108 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1109 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1110 if (! NILP (prop
[i
]))
1112 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1114 ASET (font
, j
, make_number (n
));
1116 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1117 val
= prop
[XLFD_REGISTRY_INDEX
];
1120 val
= prop
[XLFD_ENCODING_INDEX
];
1122 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1124 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1125 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1127 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1128 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1130 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1132 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1133 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1134 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1136 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1138 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1141 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1142 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1143 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1145 val
= font_prop_validate_spacing (QCspacing
,
1146 prop
[XLFD_SPACING_INDEX
]);
1147 if (! INTEGERP (val
))
1149 ASET (font
, FONT_SPACING_INDEX
, val
);
1151 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1152 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1158 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1159 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1160 0, use PIXEL_SIZE instead. */
1163 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1166 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1170 font_assert (FONTP (font
));
1172 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1175 if (i
== FONT_ADSTYLE_INDEX
)
1176 j
= XLFD_ADSTYLE_INDEX
;
1177 else if (i
== FONT_REGISTRY_INDEX
)
1178 j
= XLFD_REGISTRY_INDEX
;
1179 val
= AREF (font
, i
);
1182 if (j
== XLFD_REGISTRY_INDEX
)
1183 f
[j
] = "*-*", len
+= 4;
1185 f
[j
] = "*", len
+= 2;
1190 val
= SYMBOL_NAME (val
);
1191 if (j
== XLFD_REGISTRY_INDEX
1192 && ! strchr (SSDATA (val
), '-'))
1194 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1195 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1197 f
[j
] = p
= alloca (SBYTES (val
) + 3);
1198 sprintf (p
, "%s-*", SDATA (val
));
1199 len
+= SBYTES (val
) + 3;
1203 f
[j
] = p
= alloca (SBYTES (val
) + 4);
1204 sprintf (p
, "%s*-*", SDATA (val
));
1205 len
+= SBYTES (val
) + 4;
1209 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1213 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1216 val
= font_style_symbolic (font
, i
, 0);
1218 f
[j
] = "*", len
+= 2;
1221 val
= SYMBOL_NAME (val
);
1222 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1226 val
= AREF (font
, FONT_SIZE_INDEX
);
1227 font_assert (NUMBERP (val
) || NILP (val
));
1235 f
[XLFD_PIXEL_INDEX
] = p
= alloca (22);
1236 len
+= sprintf (p
, "%d-*", i
) + 1;
1239 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1241 else if (FLOATP (val
))
1243 i
= XFLOAT_DATA (val
) * 10;
1244 f
[XLFD_PIXEL_INDEX
] = p
= alloca (12);
1245 len
+= sprintf (p
, "*-%d", i
) + 1;
1248 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1250 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1252 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1253 f
[XLFD_RESX_INDEX
] = p
= alloca (22);
1254 len
+= sprintf (p
, "%d-%d", i
, i
) + 1;
1257 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1258 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1260 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1262 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1263 : spacing
<= FONT_SPACING_DUAL
? "d"
1264 : spacing
<= FONT_SPACING_MONO
? "m"
1269 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1270 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1272 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (11);
1273 len
+= sprintf (p
, "%ld",
1274 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1277 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1278 len
++; /* for terminating '\0'. */
1281 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1282 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1283 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1284 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1285 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1286 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1287 f
[XLFD_REGISTRY_INDEX
]);
1290 /* Parse NAME (null terminated) and store information in FONT
1291 (font-spec or font-entity). NAME is supplied in either the
1292 Fontconfig or GTK font name format. If NAME is successfully
1293 parsed, return 0. Otherwise return -1.
1295 The fontconfig format is
1297 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1301 FAMILY [PROPS...] [SIZE]
1303 This function tries to guess which format it is. */
1306 font_parse_fcname (char *name
, Lisp_Object font
)
1309 char *size_beg
= NULL
, *size_end
= NULL
;
1310 char *props_beg
= NULL
, *family_end
= NULL
;
1311 int len
= strlen (name
);
1316 for (p
= name
; *p
; p
++)
1318 if (*p
== '\\' && p
[1])
1322 props_beg
= family_end
= p
;
1327 int decimal
= 0, size_found
= 1;
1328 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1331 if (*q
!= '.' || decimal
)
1350 Lisp_Object extra_props
= Qnil
;
1352 /* A fontconfig name with size and/or property data. */
1353 if (family_end
> name
)
1356 family
= font_intern_prop (name
, family_end
- name
, 1);
1357 ASET (font
, FONT_FAMILY_INDEX
, family
);
1361 double point_size
= strtod (size_beg
, &size_end
);
1362 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1363 if (*size_end
== ':' && size_end
[1])
1364 props_beg
= size_end
;
1368 /* Now parse ":KEY=VAL" patterns. */
1371 for (p
= props_beg
; *p
; p
= q
)
1373 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1376 /* Must be an enumerated value. */
1380 val
= font_intern_prop (p
, q
- p
, 1);
1382 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1383 && memcmp (p, STR, strlen (STR)) == 0)
1385 if (PROP_MATCH ("light")
1386 || PROP_MATCH ("medium")
1387 || PROP_MATCH ("demibold")
1388 || PROP_MATCH ("bold")
1389 || PROP_MATCH ("black"))
1390 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1391 else if (PROP_MATCH ("roman")
1392 || PROP_MATCH ("italic")
1393 || PROP_MATCH ("oblique"))
1394 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1395 else if (PROP_MATCH ("charcell"))
1396 ASET (font
, FONT_SPACING_INDEX
,
1397 make_number (FONT_SPACING_CHARCELL
));
1398 else if (PROP_MATCH ("mono"))
1399 ASET (font
, FONT_SPACING_INDEX
,
1400 make_number (FONT_SPACING_MONO
));
1401 else if (PROP_MATCH ("proportional"))
1402 ASET (font
, FONT_SPACING_INDEX
,
1403 make_number (FONT_SPACING_PROPORTIONAL
));
1412 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1413 prop
= FONT_SIZE_INDEX
;
1416 key
= font_intern_prop (p
, q
- p
, 1);
1417 prop
= get_font_prop_index (key
);
1421 for (q
= p
; *q
&& *q
!= ':'; q
++);
1422 val
= font_intern_prop (p
, q
- p
, 0);
1424 if (prop
>= FONT_FOUNDRY_INDEX
1425 && prop
< FONT_EXTRA_INDEX
)
1426 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1429 extra_props
= nconc2 (extra_props
,
1430 Fcons (Fcons (key
, val
), Qnil
));
1437 if (! NILP (extra_props
))
1439 struct font_driver_list
*driver_list
= font_driver_list
;
1440 for ( ; driver_list
; driver_list
= driver_list
->next
)
1441 if (driver_list
->driver
->filter_properties
)
1442 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1448 /* Either a fontconfig-style name with no size and property
1449 data, or a GTK-style name. */
1450 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1451 Lisp_Object width
= Qnil
, size
= Qnil
;
1455 /* Scan backwards from the end, looking for a size. */
1456 for (p
= name
+ len
- 1; p
>= name
; p
--)
1460 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1461 /* Found a font size. */
1462 size
= make_float (strtod (p
+ 1, NULL
));
1466 /* Now P points to the termination of the string, sans size.
1467 Scan backwards, looking for font properties. */
1468 for (; p
> name
; p
= q
)
1470 for (q
= p
- 1; q
>= name
; q
--)
1472 if (q
> name
&& *(q
-1) == '\\')
1473 --q
; /* Skip quoting backslashes. */
1479 word_len
= p
- word_start
;
1481 #define PROP_MATCH(STR) \
1482 (word_len == strlen (STR) \
1483 && memcmp (word_start, STR, strlen (STR)) == 0)
1484 #define PROP_SAVE(VAR, STR) \
1485 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1487 if (PROP_MATCH ("Ultra-Light"))
1488 PROP_SAVE (weight
, "ultra-light");
1489 else if (PROP_MATCH ("Light"))
1490 PROP_SAVE (weight
, "light");
1491 else if (PROP_MATCH ("Book"))
1492 PROP_SAVE (weight
, "book");
1493 else if (PROP_MATCH ("Medium"))
1494 PROP_SAVE (weight
, "medium");
1495 else if (PROP_MATCH ("Semi-Bold"))
1496 PROP_SAVE (weight
, "semi-bold");
1497 else if (PROP_MATCH ("Bold"))
1498 PROP_SAVE (weight
, "bold");
1499 else if (PROP_MATCH ("Italic"))
1500 PROP_SAVE (slant
, "italic");
1501 else if (PROP_MATCH ("Oblique"))
1502 PROP_SAVE (slant
, "oblique");
1503 else if (PROP_MATCH ("Semi-Condensed"))
1504 PROP_SAVE (width
, "semi-condensed");
1505 else if (PROP_MATCH ("Condensed"))
1506 PROP_SAVE (width
, "condensed");
1507 /* An unknown word must be part of the font name. */
1518 ASET (font
, FONT_FAMILY_INDEX
,
1519 font_intern_prop (name
, family_end
- name
, 1));
1521 ASET (font
, FONT_SIZE_INDEX
, size
);
1523 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1525 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1527 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1533 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1534 NAME (NBYTES length), and return the name length. If
1535 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1538 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1540 Lisp_Object family
, foundry
;
1541 Lisp_Object tail
, val
;
1545 Lisp_Object styles
[3];
1546 const char *style_names
[3] = { "weight", "slant", "width" };
1549 family
= AREF (font
, FONT_FAMILY_INDEX
);
1550 if (! NILP (family
))
1552 if (SYMBOLP (family
))
1554 family
= SYMBOL_NAME (family
);
1555 len
+= SBYTES (family
);
1561 val
= AREF (font
, FONT_SIZE_INDEX
);
1564 if (XINT (val
) != 0)
1565 pixel_size
= XINT (val
);
1567 len
+= 21; /* for ":pixelsize=NUM" */
1574 point_size
= (int) XFLOAT_DATA (val
);
1575 len
+= 11; /* for "-NUM" */
1578 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1579 if (! NILP (foundry
))
1581 if (SYMBOLP (foundry
))
1583 foundry
= SYMBOL_NAME (foundry
);
1584 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1590 for (i
= 0; i
< 3; i
++)
1592 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1593 if (! NILP (styles
[i
]))
1594 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1595 SDATA (SYMBOL_NAME (styles
[i
])));
1598 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1599 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1600 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1601 len
+= strlen (":spacing=100");
1602 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1603 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1604 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1606 Lisp_Object key
= XCAR (XCAR (tail
)), value
= XCDR (XCAR (tail
));
1608 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1609 if (STRINGP (value
))
1610 len
+= SBYTES (value
);
1611 else if (INTEGERP (value
))
1612 len
+= sprintf (work
, "%ld", (long) XINT (value
));
1613 else if (SYMBOLP (value
))
1614 len
+= (NILP (value
) ? 5 : 4); /* for "false" or "true" */
1620 if (! NILP (family
))
1621 p
+= sprintf (p
, "%s", SDATA (family
));
1625 p
+= sprintf (p
, "%d", point_size
);
1627 p
+= sprintf (p
, "-%d", point_size
);
1629 else if (pixel_size
> 0)
1630 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1631 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1632 p
+= sprintf (p
, ":foundry=%s",
1633 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1634 for (i
= 0; i
< 3; i
++)
1635 if (! NILP (styles
[i
]))
1636 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1637 SDATA (SYMBOL_NAME (styles
[i
])));
1638 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1639 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1640 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1641 p
+= sprintf (p
, ":spacing=%ld",
1642 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1643 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1645 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1646 p
+= sprintf (p
, ":scalable=true");
1648 p
+= sprintf (p
, ":scalable=false");
1653 /* Parse NAME (null terminated) and store information in FONT
1654 (font-spec or font-entity). If NAME is successfully parsed, return
1655 0. Otherwise return -1. */
1658 font_parse_name (char *name
, Lisp_Object font
)
1660 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1661 return font_parse_xlfd (name
, font
);
1662 return font_parse_fcname (name
, font
);
1666 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1667 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1671 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1677 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1679 CHECK_STRING (family
);
1680 len
= SBYTES (family
);
1681 p0
= SSDATA (family
);
1682 p1
= strchr (p0
, '-');
1685 if ((*p0
!= '*' && p1
- p0
> 0)
1686 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1687 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1690 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1693 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1695 if (! NILP (registry
))
1697 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1698 CHECK_STRING (registry
);
1699 len
= SBYTES (registry
);
1700 p0
= SSDATA (registry
);
1701 p1
= strchr (p0
, '-');
1704 if (SDATA (registry
)[len
- 1] == '*')
1705 registry
= concat2 (registry
, build_string ("-*"));
1707 registry
= concat2 (registry
, build_string ("*-*"));
1709 registry
= Fdowncase (registry
);
1710 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1715 /* This part (through the next ^L) is still experimental and not
1716 tested much. We may drastically change codes. */
1722 #define LGSTRING_HEADER_SIZE 6
1723 #define LGSTRING_GLYPH_SIZE 8
1726 check_gstring (gstring
)
1727 Lisp_Object gstring
;
1732 CHECK_VECTOR (gstring
);
1733 val
= AREF (gstring
, 0);
1735 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1737 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1738 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1739 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1740 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1741 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1742 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1743 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1744 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1745 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1746 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1747 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1749 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1751 val
= LGSTRING_GLYPH (gstring
, i
);
1753 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1755 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1757 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1758 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1759 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1760 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1761 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1762 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1763 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1764 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1766 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1768 if (ASIZE (val
) < 3)
1770 for (j
= 0; j
< 3; j
++)
1771 CHECK_NUMBER (AREF (val
, j
));
1776 error ("Invalid glyph-string format");
1781 check_otf_features (otf_features
)
1782 Lisp_Object otf_features
;
1786 CHECK_CONS (otf_features
);
1787 CHECK_SYMBOL (XCAR (otf_features
));
1788 otf_features
= XCDR (otf_features
);
1789 CHECK_CONS (otf_features
);
1790 CHECK_SYMBOL (XCAR (otf_features
));
1791 otf_features
= XCDR (otf_features
);
1792 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1794 CHECK_SYMBOL (Fcar (val
));
1795 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1796 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1798 otf_features
= XCDR (otf_features
);
1799 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1801 CHECK_SYMBOL (Fcar (val
));
1802 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1803 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1810 Lisp_Object otf_list
;
1813 otf_tag_symbol (tag
)
1818 OTF_tag_name (tag
, name
);
1819 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1826 Lisp_Object val
= Fassoc (file
, otf_list
);
1830 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1833 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1834 val
= make_save_value (otf
, 0);
1835 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1841 /* Return a list describing which scripts/languages FONT supports by
1842 which GSUB/GPOS features of OpenType tables. See the comment of
1843 (struct font_driver).otf_capability. */
1846 font_otf_capability (font
)
1850 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1853 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1856 for (i
= 0; i
< 2; i
++)
1858 OTF_GSUB_GPOS
*gsub_gpos
;
1859 Lisp_Object script_list
= Qnil
;
1862 if (OTF_get_features (otf
, i
== 0) < 0)
1864 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1865 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1867 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1868 Lisp_Object langsys_list
= Qnil
;
1869 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1872 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1874 OTF_LangSys
*langsys
;
1875 Lisp_Object feature_list
= Qnil
;
1876 Lisp_Object langsys_tag
;
1879 if (k
== script
->LangSysCount
)
1881 langsys
= &script
->DefaultLangSys
;
1886 langsys
= script
->LangSys
+ k
;
1888 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1890 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1892 OTF_Feature
*feature
1893 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1894 Lisp_Object feature_tag
1895 = otf_tag_symbol (feature
->FeatureTag
);
1897 feature_list
= Fcons (feature_tag
, feature_list
);
1899 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1902 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1907 XSETCAR (capability
, script_list
);
1909 XSETCDR (capability
, script_list
);
1915 /* Parse OTF features in SPEC and write a proper features spec string
1916 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1917 assured that the sufficient memory has already allocated for
1921 generate_otf_features (spec
, features
)
1931 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1937 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1942 else if (! asterisk
)
1944 val
= SYMBOL_NAME (val
);
1945 p
+= sprintf (p
, "%s", SDATA (val
));
1949 val
= SYMBOL_NAME (val
);
1950 p
+= sprintf (p
, "~%s", SDATA (val
));
1954 error ("OTF spec too long");
1958 font_otf_DeviceTable (device_table
)
1959 OTF_DeviceTable
*device_table
;
1961 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1963 return Fcons (make_number (len
),
1964 make_unibyte_string (device_table
->DeltaValue
, len
));
1968 font_otf_ValueRecord (value_format
, value_record
)
1970 OTF_ValueRecord
*value_record
;
1972 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1974 if (value_format
& OTF_XPlacement
)
1975 ASET (val
, 0, make_number (value_record
->XPlacement
));
1976 if (value_format
& OTF_YPlacement
)
1977 ASET (val
, 1, make_number (value_record
->YPlacement
));
1978 if (value_format
& OTF_XAdvance
)
1979 ASET (val
, 2, make_number (value_record
->XAdvance
));
1980 if (value_format
& OTF_YAdvance
)
1981 ASET (val
, 3, make_number (value_record
->YAdvance
));
1982 if (value_format
& OTF_XPlaDevice
)
1983 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1984 if (value_format
& OTF_YPlaDevice
)
1985 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1986 if (value_format
& OTF_XAdvDevice
)
1987 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1988 if (value_format
& OTF_YAdvDevice
)
1989 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1994 font_otf_Anchor (anchor
)
1999 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2000 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2001 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2002 if (anchor
->AnchorFormat
== 2)
2003 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2006 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2007 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2011 #endif /* HAVE_LIBOTF */
2017 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2018 static int font_compare (const void *, const void *);
2019 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2023 font_rescale_ratio (Lisp_Object font_entity
)
2025 Lisp_Object tail
, elt
;
2026 Lisp_Object name
= Qnil
;
2028 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2031 if (FLOATP (XCDR (elt
)))
2033 if (STRINGP (XCAR (elt
)))
2036 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2037 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2038 return XFLOAT_DATA (XCDR (elt
));
2040 else if (FONT_SPEC_P (XCAR (elt
)))
2042 if (font_match_p (XCAR (elt
), font_entity
))
2043 return XFLOAT_DATA (XCDR (elt
));
2050 /* We sort fonts by scoring each of them against a specified
2051 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2052 the value is, the closer the font is to the font-spec.
2054 The lowest 2 bits of the score is used for driver type. The font
2055 available by the most preferred font driver is 0.
2057 Each 7-bit in the higher 28 bits are used for numeric properties
2058 WEIGHT, SLANT, WIDTH, and SIZE. */
2060 /* How many bits to shift to store the difference value of each font
2061 property in a score. Note that flots for FONT_TYPE_INDEX and
2062 FONT_REGISTRY_INDEX are not used. */
2063 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2065 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2066 The return value indicates how different ENTITY is compared with
2070 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2075 /* Score three style numeric fields. Maximum difference is 127. */
2076 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2077 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2079 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2080 - (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
IF_LINT (= Qnil
);
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
++)
2700 if (i
!= FONT_SPACING_INDEX
)
2702 ASET (scratch_font_spec
, i
, Qnil
);
2703 if (! NILP (AREF (spec
, i
)))
2706 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2707 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2709 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2711 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2713 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2715 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2716 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2723 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2727 val
= Fvconcat (1, &val
);
2728 copy
= Fcopy_font_spec (scratch_font_spec
);
2729 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2730 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2734 || ! NILP (Vface_ignored_fonts
)))
2735 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2736 if (ASIZE (val
) > 0)
2737 list
= Fcons (val
, list
);
2740 list
= Fnreverse (list
);
2741 FONT_ADD_LOG ("list", spec
, list
);
2746 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2747 nil, is an array of face's attributes, which specifies preferred
2748 font-related attributes. */
2751 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2753 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2754 Lisp_Object ftype
, size
, entity
;
2756 Lisp_Object work
= Fcopy_font_spec (spec
);
2758 XSETFRAME (frame
, f
);
2759 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2760 size
= AREF (spec
, FONT_SIZE_INDEX
);
2763 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2764 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2765 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2766 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2769 for (; driver_list
; driver_list
= driver_list
->next
)
2771 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2773 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2776 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2777 entity
= assoc_no_quit (work
, XCDR (cache
));
2779 entity
= XCDR (entity
);
2782 entity
= driver_list
->driver
->match (frame
, work
);
2783 copy
= Fcopy_font_spec (work
);
2784 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2785 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2787 if (! NILP (entity
))
2790 FONT_ADD_LOG ("match", work
, entity
);
2795 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2796 opened font object. */
2799 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2801 struct font_driver_list
*driver_list
;
2802 Lisp_Object objlist
, size
, val
, font_object
;
2804 int min_width
, height
;
2805 int scaled_pixel_size
= pixel_size
;
2807 font_assert (FONT_ENTITY_P (entity
));
2808 size
= AREF (entity
, FONT_SIZE_INDEX
);
2809 if (XINT (size
) != 0)
2810 scaled_pixel_size
= pixel_size
= XINT (size
);
2811 else if (CONSP (Vface_font_rescale_alist
))
2812 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2814 val
= AREF (entity
, FONT_TYPE_INDEX
);
2815 for (driver_list
= f
->font_driver_list
;
2816 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2817 driver_list
= driver_list
->next
);
2821 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2822 objlist
= XCDR (objlist
))
2824 Lisp_Object fn
= XCAR (objlist
);
2825 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2826 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2828 if (driver_list
->driver
->cached_font_ok
== NULL
2829 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2834 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2835 if (!NILP (font_object
))
2836 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2837 FONT_ADD_LOG ("open", entity
, font_object
);
2838 if (NILP (font_object
))
2840 ASET (entity
, FONT_OBJLIST_INDEX
,
2841 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2844 font
= XFONT_OBJECT (font_object
);
2845 min_width
= (font
->min_width
? font
->min_width
2846 : font
->average_width
? font
->average_width
2847 : font
->space_width
? font
->space_width
2849 height
= (font
->height
? font
->height
: 1);
2850 #ifdef HAVE_WINDOW_SYSTEM
2851 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2852 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2854 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2855 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2856 fonts_changed_p
= 1;
2860 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2861 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2862 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2863 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2871 /* Close FONT_OBJECT that is opened on frame F. */
2874 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2876 struct font
*font
= XFONT_OBJECT (font_object
);
2878 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2879 /* Already closed. */
2881 FONT_ADD_LOG ("close", font_object
, Qnil
);
2882 font
->driver
->close (f
, font
);
2883 #ifdef HAVE_WINDOW_SYSTEM
2884 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2885 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2891 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2892 FONT is a font-entity and it must be opened to check. */
2895 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2899 if (FONT_ENTITY_P (font
))
2901 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2902 struct font_driver_list
*driver_list
;
2904 for (driver_list
= f
->font_driver_list
;
2905 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2906 driver_list
= driver_list
->next
);
2909 if (! driver_list
->driver
->has_char
)
2911 return driver_list
->driver
->has_char (font
, c
);
2914 font_assert (FONT_OBJECT_P (font
));
2915 fontp
= XFONT_OBJECT (font
);
2916 if (fontp
->driver
->has_char
)
2918 int result
= fontp
->driver
->has_char (font
, c
);
2923 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2927 /* Return the glyph ID of FONT_OBJECT for character C. */
2930 font_encode_char (Lisp_Object font_object
, int c
)
2934 font_assert (FONT_OBJECT_P (font_object
));
2935 font
= XFONT_OBJECT (font_object
);
2936 return font
->driver
->encode_char (font
, c
);
2940 /* Return the name of FONT_OBJECT. */
2943 font_get_name (Lisp_Object font_object
)
2945 font_assert (FONT_OBJECT_P (font_object
));
2946 return AREF (font_object
, FONT_NAME_INDEX
);
2950 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2951 could not be parsed by font_parse_name, return Qnil. */
2954 font_spec_from_name (Lisp_Object font_name
)
2956 Lisp_Object spec
= Ffont_spec (0, NULL
);
2958 CHECK_STRING (font_name
);
2959 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2961 font_put_extra (spec
, QCname
, font_name
);
2962 font_put_extra (spec
, QCuser_spec
, font_name
);
2968 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2970 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2975 if (! NILP (Ffont_get (font
, QCname
)))
2977 font
= Fcopy_font_spec (font
);
2978 font_put_extra (font
, QCname
, Qnil
);
2981 if (NILP (AREF (font
, prop
))
2982 && prop
!= FONT_FAMILY_INDEX
2983 && prop
!= FONT_FOUNDRY_INDEX
2984 && prop
!= FONT_WIDTH_INDEX
2985 && prop
!= FONT_SIZE_INDEX
)
2987 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
2988 font
= Fcopy_font_spec (font
);
2989 ASET (font
, prop
, Qnil
);
2990 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2992 if (prop
== FONT_FAMILY_INDEX
)
2994 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2995 /* If we are setting the font family, we must also clear
2996 FONT_WIDTH_INDEX to avoid rejecting families that lack
2997 support for some widths. */
2998 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3000 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3001 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3002 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3003 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3004 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3005 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3007 else if (prop
== FONT_SIZE_INDEX
)
3009 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3010 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3011 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3013 else if (prop
== FONT_WIDTH_INDEX
)
3014 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3015 attrs
[LFACE_FONT_INDEX
] = font
;
3018 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3019 supports C and matches best with ATTRS and PIXEL_SIZE. */
3022 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3024 Lisp_Object font_entity
;
3027 FRAME_PTR f
= XFRAME (frame
);
3029 if (NILP (XCDR (entities
))
3030 && ASIZE (XCAR (entities
)) == 1)
3032 font_entity
= AREF (XCAR (entities
), 0);
3034 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3039 /* Sort fonts by properties specified in ATTRS. */
3040 prefer
= scratch_font_prefer
;
3042 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3043 ASET (prefer
, i
, Qnil
);
3044 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3046 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3048 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3049 ASET (prefer
, i
, AREF (face_font
, i
));
3051 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3052 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3053 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3054 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3055 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3056 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3057 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3059 return font_sort_entities (entities
, prefer
, frame
, c
);
3062 /* Return a font-entity satisfying SPEC and best matching with face's
3063 font related attributes in ATTRS. C, if not negative, is a
3064 character that the entity must support. */
3067 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3070 Lisp_Object frame
, entities
, val
;
3071 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3075 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3076 if (NILP (registry
[0]))
3078 registry
[0] = DEFAULT_ENCODING
;
3079 registry
[1] = Qascii_0
;
3080 registry
[2] = null_vector
;
3083 registry
[1] = null_vector
;
3085 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3087 struct charset
*encoding
, *repertory
;
3089 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3090 &encoding
, &repertory
) < 0)
3093 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3095 else if (c
> encoding
->max_char
)
3099 work
= Fcopy_font_spec (spec
);
3100 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3101 XSETFRAME (frame
, f
);
3102 pixel_size
= font_pixel_size (f
, spec
);
3103 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3105 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3107 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3109 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3110 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3111 if (! NILP (foundry
[0]))
3112 foundry
[1] = null_vector
;
3113 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3115 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3116 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3118 foundry
[2] = null_vector
;
3121 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3123 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3124 if (! NILP (adstyle
[0]))
3125 adstyle
[1] = null_vector
;
3126 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3128 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3130 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3132 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3134 adstyle
[2] = null_vector
;
3137 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3140 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3143 val
= AREF (work
, FONT_FAMILY_INDEX
);
3144 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3146 val
= attrs
[LFACE_FAMILY_INDEX
];
3147 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3151 family
= alloca ((sizeof family
[0]) * 2);
3153 family
[1] = null_vector
; /* terminator. */
3158 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3159 /* Font family names are case-sensitive under NS. */
3167 if (! NILP (alters
))
3169 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3170 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3171 family
[i
] = XCAR (alters
);
3172 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3174 family
[i
] = null_vector
;
3178 family
= alloca ((sizeof family
[0]) * 3);
3181 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3183 family
[i
] = null_vector
;
3187 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3189 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3190 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3192 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3193 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3195 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3196 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3198 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3199 entities
= font_list_entities (frame
, work
);
3200 if (! NILP (entities
))
3202 val
= font_select_entity (frame
, entities
,
3203 attrs
, pixel_size
, c
);
3216 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3220 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3221 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3222 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3223 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3224 size
= font_pixel_size (f
, spec
);
3228 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3229 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3232 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3233 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3234 if (INTEGERP (height
))
3237 abort(); /* We should never end up here. */
3241 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3245 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3246 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3250 return font_open_entity (f
, entity
, size
);
3254 /* Find a font satisfying SPEC and best matching with face's
3255 attributes in ATTRS on FRAME, and return the opened
3259 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3261 Lisp_Object entity
, name
;
3263 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3266 /* No font is listed for SPEC, but each font-backend may have
3267 the different criteria about "font matching". So, try
3269 entity
= font_matching_entity (f
, attrs
, spec
);
3273 /* Don't lose the original name that was put in initially. We need
3274 it to re-apply the font when font parameters (like hinting or dpi) have
3276 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3279 name
= Ffont_get (spec
, QCuser_spec
);
3280 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3286 /* Make FACE on frame F ready to use the font opened for FACE. */
3289 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3291 if (face
->font
->driver
->prepare_face
)
3292 face
->font
->driver
->prepare_face (f
, face
);
3296 /* Make FACE on frame F stop using the font opened for FACE. */
3299 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3301 if (face
->font
->driver
->done_face
)
3302 face
->font
->driver
->done_face (f
, face
);
3307 /* Open a font matching with font-spec SPEC on frame F. If no proper
3308 font is found, return Qnil. */
3311 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3313 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3315 /* We set up the default font-related attributes of a face to prefer
3317 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3318 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3319 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3321 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3323 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3325 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3327 return font_load_for_lface (f
, attrs
, spec
);
3331 /* Open a font matching with NAME on frame F. If no proper font is
3332 found, return Qnil. */
3335 font_open_by_name (FRAME_PTR f
, const char *name
)
3337 Lisp_Object args
[2];
3338 Lisp_Object spec
, ret
;
3341 args
[1] = make_unibyte_string (name
, strlen (name
));
3342 spec
= Ffont_spec (2, args
);
3343 ret
= font_open_by_spec (f
, spec
);
3344 /* Do not lose name originally put in. */
3346 font_put_extra (ret
, QCuser_spec
, args
[1]);
3352 /* Register font-driver DRIVER. This function is used in two ways.
3354 The first is with frame F non-NULL. In this case, make DRIVER
3355 available (but not yet activated) on F. All frame creaters
3356 (e.g. Fx_create_frame) must call this function at least once with
3357 an available font-driver.
3359 The second is with frame F NULL. In this case, DRIVER is globally
3360 registered in the variable `font_driver_list'. All font-driver
3361 implementations must call this function in its syms_of_XXXX
3362 (e.g. syms_of_xfont). */
3365 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3367 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3368 struct font_driver_list
*prev
, *list
;
3370 if (f
&& ! driver
->draw
)
3371 error ("Unusable font driver for a frame: %s",
3372 SDATA (SYMBOL_NAME (driver
->type
)));
3374 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3375 if (EQ (list
->driver
->type
, driver
->type
))
3376 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3378 list
= xmalloc (sizeof (struct font_driver_list
));
3380 list
->driver
= driver
;
3385 f
->font_driver_list
= list
;
3387 font_driver_list
= list
;
3393 free_font_driver_list (FRAME_PTR f
)
3395 struct font_driver_list
*list
, *next
;
3397 for (list
= f
->font_driver_list
; list
; list
= next
)
3402 f
->font_driver_list
= NULL
;
3406 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3407 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3408 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3410 A caller must free all realized faces if any in advance. The
3411 return value is a list of font backends actually made used on
3415 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3417 Lisp_Object active_drivers
= Qnil
;
3418 struct font_driver_list
*list
;
3420 /* At first, turn off non-requested drivers, and turn on requested
3422 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3424 struct font_driver
*driver
= list
->driver
;
3425 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3430 if (driver
->end_for_frame
)
3431 driver
->end_for_frame (f
);
3432 font_finish_cache (f
, driver
);
3437 if (! driver
->start_for_frame
3438 || driver
->start_for_frame (f
) == 0)
3440 font_prepare_cache (f
, driver
);
3447 if (NILP (new_drivers
))
3450 if (! EQ (new_drivers
, Qt
))
3452 /* Re-order the driver list according to new_drivers. */
3453 struct font_driver_list
**list_table
, **next
;
3457 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3458 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3460 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3461 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3464 list_table
[i
++] = list
;
3466 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3468 list_table
[i
++] = list
;
3469 list_table
[i
] = NULL
;
3471 next
= &f
->font_driver_list
;
3472 for (i
= 0; list_table
[i
]; i
++)
3474 *next
= list_table
[i
];
3475 next
= &(*next
)->next
;
3479 if (! f
->font_driver_list
->on
)
3480 { /* None of the drivers is enabled: enable them all.
3481 Happens if you set the list of drivers to (xft x) in your .emacs
3482 and then use it under w32 or ns. */
3483 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3485 struct font_driver
*driver
= list
->driver
;
3486 eassert (! list
->on
);
3487 if (! driver
->start_for_frame
3488 || driver
->start_for_frame (f
) == 0)
3490 font_prepare_cache (f
, driver
);
3497 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3499 active_drivers
= nconc2 (active_drivers
,
3500 Fcons (list
->driver
->type
, Qnil
));
3501 return active_drivers
;
3505 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3507 struct font_data_list
*list
, *prev
;
3509 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3510 prev
= list
, list
= list
->next
)
3511 if (list
->driver
== driver
)
3518 prev
->next
= list
->next
;
3520 f
->font_data_list
= list
->next
;
3528 list
= xmalloc (sizeof (struct font_data_list
));
3529 list
->driver
= driver
;
3530 list
->next
= f
->font_data_list
;
3531 f
->font_data_list
= list
;
3539 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3541 struct font_data_list
*list
;
3543 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3544 if (list
->driver
== driver
)
3552 /* Sets attributes on a font. Any properties that appear in ALIST and
3553 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3554 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3555 arrays of strings. This function is intended for use by the font
3556 drivers to implement their specific font_filter_properties. */
3558 font_filter_properties (Lisp_Object font
,
3560 const char *const boolean_properties
[],
3561 const char *const non_boolean_properties
[])
3566 /* Set boolean values to Qt or Qnil */
3567 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3568 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3570 Lisp_Object key
= XCAR (XCAR (it
));
3571 Lisp_Object val
= XCDR (XCAR (it
));
3572 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3574 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3576 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3577 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3580 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3581 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3582 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3583 || strcmp ("Off", str
) == 0)
3588 Ffont_put (font
, key
, val
);
3592 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3593 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3595 Lisp_Object key
= XCAR (XCAR (it
));
3596 Lisp_Object val
= XCDR (XCAR (it
));
3597 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3598 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3599 Ffont_put (font
, key
, val
);
3604 /* Return the font used to draw character C by FACE at buffer position
3605 POS in window W. If STRING is non-nil, it is a string containing C
3606 at index POS. If C is negative, get C from the current buffer or
3610 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3615 Lisp_Object font_object
;
3617 multibyte
= (NILP (string
)
3618 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3619 : STRING_MULTIBYTE (string
));
3626 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3628 c
= FETCH_CHAR (pos_byte
);
3631 c
= FETCH_BYTE (pos
);
3637 multibyte
= STRING_MULTIBYTE (string
);
3640 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3642 str
= SDATA (string
) + pos_byte
;
3643 c
= STRING_CHAR (str
);
3646 c
= SDATA (string
)[pos
];
3650 f
= XFRAME (w
->frame
);
3651 if (! FRAME_WINDOW_P (f
))
3658 if (STRINGP (string
))
3659 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3660 DEFAULT_FACE_ID
, 0);
3662 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3664 face
= FACE_FROM_ID (f
, face_id
);
3668 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3669 face
= FACE_FROM_ID (f
, face_id
);
3674 XSETFONT (font_object
, face
->font
);
3679 #ifdef HAVE_WINDOW_SYSTEM
3681 /* Check how many characters after POS (at most to *LIMIT) can be
3682 displayed by the same font on the window W. FACE, if non-NULL, is
3683 the face selected for the character at POS. If STRING is not nil,
3684 it is the string to check instead of the current buffer. In that
3685 case, FACE must be not NULL.
3687 The return value is the font-object for the character at POS.
3688 *LIMIT is set to the position where that font can't be used.
3690 It is assured that the current buffer (or STRING) is multibyte. */
3693 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3695 EMACS_INT pos_byte
, ignore
;
3697 Lisp_Object font_object
= Qnil
;
3701 pos_byte
= CHAR_TO_BYTE (pos
);
3706 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3708 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3714 pos_byte
= string_char_to_byte (string
, pos
);
3717 while (pos
< *limit
)
3719 Lisp_Object category
;
3722 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3724 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3725 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3726 if (EQ (category
, QCf
)
3727 || CHAR_VARIATION_SELECTOR_P (c
))
3729 if (NILP (font_object
))
3731 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3732 if (NILP (font_object
))
3736 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3746 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3747 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3748 Return nil otherwise.
3749 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3750 which kind of font it is. It must be one of `font-spec', `font-entity',
3752 (Lisp_Object object
, Lisp_Object extra_type
)
3754 if (NILP (extra_type
))
3755 return (FONTP (object
) ? Qt
: Qnil
);
3756 if (EQ (extra_type
, Qfont_spec
))
3757 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3758 if (EQ (extra_type
, Qfont_entity
))
3759 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3760 if (EQ (extra_type
, Qfont_object
))
3761 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3762 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3765 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3766 doc
: /* Return a newly created font-spec with arguments as properties.
3768 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3769 valid font property name listed below:
3771 `:family', `:weight', `:slant', `:width'
3773 They are the same as face attributes of the same name. See
3774 `set-face-attribute'.
3778 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3782 VALUE must be a string or a symbol specifying the additional
3783 typographic style information of a font, e.g. ``sans''.
3787 VALUE must be a string or a symbol specifying the charset registry and
3788 encoding of a font, e.g. ``iso8859-1''.
3792 VALUE must be a non-negative integer or a floating point number
3793 specifying the font size. It specifies the font size in pixels (if
3794 VALUE is an integer), or in points (if VALUE is a float).
3798 VALUE must be a string of XLFD-style or fontconfig-style font name.
3802 VALUE must be a symbol representing a script that the font must
3803 support. It may be a symbol representing a subgroup of a script
3804 listed in the variable `script-representative-chars'.
3808 VALUE must be a symbol of two-letter ISO-639 language names,
3813 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3814 required OpenType features.
3816 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3817 LANGSYS-TAG: OpenType language system tag symbol,
3818 or nil for the default language system.
3819 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3820 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3822 GSUB and GPOS may contain `nil' element. In such a case, the font
3823 must not have any of the remaining elements.
3825 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3826 be an OpenType font, and whose GPOS table of `thai' script's default
3827 language system must contain `mark' feature.
3829 usage: (font-spec ARGS...) */)
3830 (size_t nargs
, Lisp_Object
*args
)
3832 Lisp_Object spec
= font_make_spec ();
3835 for (i
= 0; i
< nargs
; i
+= 2)
3837 Lisp_Object key
= args
[i
], val
;
3841 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3844 if (EQ (key
, QCname
))
3847 font_parse_name (SSDATA (val
), spec
);
3848 font_put_extra (spec
, key
, val
);
3852 int idx
= get_font_prop_index (key
);
3856 val
= font_prop_validate (idx
, Qnil
, val
);
3857 if (idx
< FONT_EXTRA_INDEX
)
3858 ASET (spec
, idx
, val
);
3860 font_put_extra (spec
, key
, val
);
3863 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3869 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3870 doc
: /* Return a copy of FONT as a font-spec. */)
3873 Lisp_Object new_spec
, tail
, prev
, extra
;
3877 new_spec
= font_make_spec ();
3878 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3879 ASET (new_spec
, i
, AREF (font
, i
));
3880 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3881 /* We must remove :font-entity property. */
3882 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3883 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3886 extra
= XCDR (extra
);
3888 XSETCDR (prev
, XCDR (tail
));
3891 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3895 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3896 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3897 Every specified properties in FROM override the corresponding
3898 properties in TO. */)
3899 (Lisp_Object from
, Lisp_Object to
)
3901 Lisp_Object extra
, tail
;
3906 to
= Fcopy_font_spec (to
);
3907 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3908 ASET (to
, i
, AREF (from
, i
));
3909 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3910 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3911 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3913 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3916 XSETCDR (slot
, XCDR (XCAR (tail
)));
3918 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3920 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3924 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3925 doc
: /* Return the value of FONT's property KEY.
3926 FONT is a font-spec, a font-entity, or a font-object.
3927 KEY is any symbol, but these are reserved for specific meanings:
3928 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3929 :size, :name, :script, :otf
3930 See the documentation of `font-spec' for their meanings.
3931 In addition, if FONT is a font-entity or a font-object, values of
3932 :script and :otf are different from those of a font-spec as below:
3934 The value of :script may be a list of scripts that are supported by the font.
3936 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3937 representing the OpenType features supported by the font by this form:
3938 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3939 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3941 (Lisp_Object font
, Lisp_Object key
)
3949 idx
= get_font_prop_index (key
);
3950 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3951 return font_style_symbolic (font
, idx
, 0);
3952 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3953 return AREF (font
, idx
);
3954 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3955 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3957 struct font
*fontp
= XFONT_OBJECT (font
);
3959 if (fontp
->driver
->otf_capability
)
3960 val
= fontp
->driver
->otf_capability (fontp
);
3962 val
= Fcons (Qnil
, Qnil
);
3969 #ifdef HAVE_WINDOW_SYSTEM
3971 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3972 doc
: /* Return a plist of face attributes generated by FONT.
3973 FONT is a font name, a font-spec, a font-entity, or a font-object.
3974 The return value is a list of the form
3976 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3978 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3979 compatible with `set-face-attribute'. Some of these key-attribute pairs
3980 may be omitted from the list if they are not specified by FONT.
3982 The optional argument FRAME specifies the frame that the face attributes
3983 are to be displayed on. If omitted, the selected frame is used. */)
3984 (Lisp_Object font
, Lisp_Object frame
)
3987 Lisp_Object plist
[10];
3992 frame
= selected_frame
;
3993 CHECK_LIVE_FRAME (frame
);
3998 int fontset
= fs_query_fontset (font
, 0);
3999 Lisp_Object name
= font
;
4001 font
= fontset_ascii (fontset
);
4002 font
= font_spec_from_name (name
);
4004 signal_error ("Invalid font name", name
);
4006 else if (! FONTP (font
))
4007 signal_error ("Invalid font object", font
);
4009 val
= AREF (font
, FONT_FAMILY_INDEX
);
4012 plist
[n
++] = QCfamily
;
4013 plist
[n
++] = SYMBOL_NAME (val
);
4016 val
= AREF (font
, FONT_SIZE_INDEX
);
4019 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4020 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4021 plist
[n
++] = QCheight
;
4022 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4024 else if (FLOATP (val
))
4026 plist
[n
++] = QCheight
;
4027 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4030 val
= FONT_WEIGHT_FOR_FACE (font
);
4033 plist
[n
++] = QCweight
;
4037 val
= FONT_SLANT_FOR_FACE (font
);
4040 plist
[n
++] = QCslant
;
4044 val
= FONT_WIDTH_FOR_FACE (font
);
4047 plist
[n
++] = QCwidth
;
4051 return Flist (n
, plist
);
4056 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4057 doc
: /* Set one property of FONT: give property KEY value VAL.
4058 FONT is a font-spec, a font-entity, or a font-object.
4060 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4061 accepted by the function `font-spec' (which see), VAL must be what
4062 allowed in `font-spec'.
4064 If FONT is a font-entity or a font-object, KEY must not be the one
4065 accepted by `font-spec'. */)
4066 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4070 idx
= get_font_prop_index (prop
);
4071 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4073 CHECK_FONT_SPEC (font
);
4074 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4078 if (EQ (prop
, QCname
)
4079 || EQ (prop
, QCscript
)
4080 || EQ (prop
, QClang
)
4081 || EQ (prop
, QCotf
))
4082 CHECK_FONT_SPEC (font
);
4085 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4090 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4091 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4092 Optional 2nd argument FRAME specifies the target frame.
4093 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4094 Optional 4th argument PREFER, if non-nil, is a font-spec to
4095 control the order of the returned list. Fonts are sorted by
4096 how close they are to PREFER. */)
4097 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4099 Lisp_Object vec
, list
;
4103 frame
= selected_frame
;
4104 CHECK_LIVE_FRAME (frame
);
4105 CHECK_FONT_SPEC (font_spec
);
4113 if (! NILP (prefer
))
4114 CHECK_FONT_SPEC (prefer
);
4116 list
= font_list_entities (frame
, font_spec
);
4119 if (NILP (XCDR (list
))
4120 && ASIZE (XCAR (list
)) == 1)
4121 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4123 if (! NILP (prefer
))
4124 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4126 vec
= font_vconcat_entity_vectors (list
);
4127 if (n
== 0 || n
>= ASIZE (vec
))
4129 Lisp_Object args
[2];
4133 list
= Fappend (2, args
);
4137 for (list
= Qnil
, n
--; n
>= 0; n
--)
4138 list
= Fcons (AREF (vec
, n
), list
);
4143 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4144 doc
: /* List available font families on the current frame.
4145 Optional argument FRAME, if non-nil, specifies the target frame. */)
4149 struct font_driver_list
*driver_list
;
4153 frame
= selected_frame
;
4154 CHECK_LIVE_FRAME (frame
);
4157 for (driver_list
= f
->font_driver_list
; driver_list
;
4158 driver_list
= driver_list
->next
)
4159 if (driver_list
->driver
->list_family
)
4161 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4162 Lisp_Object tail
= list
;
4164 for (; CONSP (val
); val
= XCDR (val
))
4165 if (NILP (Fmemq (XCAR (val
), tail
))
4166 && SYMBOLP (XCAR (val
)))
4167 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4172 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4173 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4174 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4175 (Lisp_Object font_spec
, Lisp_Object frame
)
4177 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4184 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4185 doc
: /* Return XLFD name of FONT.
4186 FONT is a font-spec, font-entity, or font-object.
4187 If the name is too long for XLFD (maximum 255 chars), return nil.
4188 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4189 the consecutive wildcards are folded to one. */)
4190 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4197 if (FONT_OBJECT_P (font
))
4199 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4201 if (STRINGP (font_name
)
4202 && SDATA (font_name
)[0] == '-')
4204 if (NILP (fold_wildcards
))
4206 strcpy (name
, SSDATA (font_name
));
4209 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4211 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4214 if (! NILP (fold_wildcards
))
4216 char *p0
= name
, *p1
;
4218 while ((p1
= strstr (p0
, "-*-*")))
4220 strcpy (p1
, p1
+ 2);
4225 return build_string (name
);
4228 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4229 doc
: /* Clear font cache. */)
4232 Lisp_Object list
, frame
;
4234 FOR_EACH_FRAME (list
, frame
)
4236 FRAME_PTR f
= XFRAME (frame
);
4237 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4239 for (; driver_list
; driver_list
= driver_list
->next
)
4240 if (driver_list
->on
)
4242 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4243 Lisp_Object val
, tmp
;
4247 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4249 font_assert (! NILP (val
));
4250 tmp
= XCDR (XCAR (val
));
4251 if (XINT (XCAR (tmp
)) == 0)
4253 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4254 XSETCDR (cache
, XCDR (val
));
4264 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4266 struct font
*font
= XFONT_OBJECT (font_object
);
4268 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4269 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4270 struct font_metrics metrics
;
4272 LGLYPH_SET_CODE (glyph
, ecode
);
4274 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4275 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4276 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4277 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4278 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4279 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4283 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4284 doc
: /* Shape the glyph-string GSTRING.
4285 Shaping means substituting glyphs and/or adjusting positions of glyphs
4286 to get the correct visual image of character sequences set in the
4287 header of the glyph-string.
4289 If the shaping was successful, the value is GSTRING itself or a newly
4290 created glyph-string. Otherwise, the value is nil. */)
4291 (Lisp_Object gstring
)
4294 Lisp_Object font_object
, n
, glyph
;
4297 if (! composition_gstring_p (gstring
))
4298 signal_error ("Invalid glyph-string: ", gstring
);
4299 if (! NILP (LGSTRING_ID (gstring
)))
4301 font_object
= LGSTRING_FONT (gstring
);
4302 CHECK_FONT_OBJECT (font_object
);
4303 font
= XFONT_OBJECT (font_object
);
4304 if (! font
->driver
->shape
)
4307 /* Try at most three times with larger gstring each time. */
4308 for (i
= 0; i
< 3; i
++)
4310 n
= font
->driver
->shape (gstring
);
4313 gstring
= larger_vector (gstring
,
4314 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4317 if (i
== 3 || XINT (n
) == 0)
4319 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4320 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4322 glyph
= LGSTRING_GLYPH (gstring
, 0);
4323 from
= LGLYPH_FROM (glyph
);
4324 to
= LGLYPH_TO (glyph
);
4325 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4327 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4331 if (NILP (LGLYPH_ADJUSTMENT (this)))
4336 glyph
= LGSTRING_GLYPH (gstring
, j
);
4337 LGLYPH_SET_FROM (glyph
, from
);
4338 LGLYPH_SET_TO (glyph
, to
);
4340 from
= LGLYPH_FROM (this);
4341 to
= LGLYPH_TO (this);
4346 if (from
> LGLYPH_FROM (this))
4347 from
= LGLYPH_FROM (this);
4348 if (to
< LGLYPH_TO (this))
4349 to
= LGLYPH_TO (this);
4355 glyph
= LGSTRING_GLYPH (gstring
, j
);
4356 LGLYPH_SET_FROM (glyph
, from
);
4357 LGLYPH_SET_TO (glyph
, to
);
4359 return composition_gstring_put_cache (gstring
, XINT (n
));
4362 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4364 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4365 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4367 VARIATION-SELECTOR is a character code of variation selection
4368 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4369 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4370 (Lisp_Object font_object
, Lisp_Object character
)
4372 unsigned variations
[256];
4377 CHECK_FONT_OBJECT (font_object
);
4378 CHECK_CHARACTER (character
);
4379 font
= XFONT_OBJECT (font_object
);
4380 if (! font
->driver
->get_variation_glyphs
)
4382 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4386 for (i
= 0; i
< 255; i
++)
4390 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4391 /* Stops GCC whining about limited range of data type. */
4392 EMACS_INT var
= variations
[i
];
4394 if (var
> MOST_POSITIVE_FIXNUM
)
4395 code
= Fcons (make_number ((variations
[i
]) >> 16),
4396 make_number ((variations
[i
]) & 0xFFFF));
4398 code
= make_number (variations
[i
]);
4399 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4406 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4407 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4408 OTF-FEATURES specifies which features to apply in this format:
4409 (SCRIPT LANGSYS GSUB GPOS)
4411 SCRIPT is a symbol specifying a script tag of OpenType,
4412 LANGSYS is a symbol specifying a langsys tag of OpenType,
4413 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4415 If LANGYS is nil, the default langsys is selected.
4417 The features are applied in the order they appear in the list. The
4418 symbol `*' means to apply all available features not present in this
4419 list, and the remaining features are ignored. For instance, (vatu
4420 pstf * haln) is to apply vatu and pstf in this order, then to apply
4421 all available features other than vatu, pstf, and haln.
4423 The features are applied to the glyphs in the range FROM and TO of
4424 the glyph-string GSTRING-IN.
4426 If some feature is actually applicable, the resulting glyphs are
4427 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4428 this case, the value is the number of produced glyphs.
4430 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4433 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4434 produced in GSTRING-OUT, and the value is nil.
4436 See the documentation of `font-make-gstring' for the format of
4438 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4440 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4445 check_otf_features (otf_features
);
4446 CHECK_FONT_OBJECT (font_object
);
4447 font
= XFONT_OBJECT (font_object
);
4448 if (! font
->driver
->otf_drive
)
4449 error ("Font backend %s can't drive OpenType GSUB table",
4450 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4451 CHECK_CONS (otf_features
);
4452 CHECK_SYMBOL (XCAR (otf_features
));
4453 val
= XCDR (otf_features
);
4454 CHECK_SYMBOL (XCAR (val
));
4455 val
= XCDR (otf_features
);
4458 len
= check_gstring (gstring_in
);
4459 CHECK_VECTOR (gstring_out
);
4460 CHECK_NATNUM (from
);
4462 CHECK_NATNUM (index
);
4464 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4465 args_out_of_range_3 (from
, to
, make_number (len
));
4466 if (XINT (index
) >= ASIZE (gstring_out
))
4467 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4468 num
= font
->driver
->otf_drive (font
, otf_features
,
4469 gstring_in
, XINT (from
), XINT (to
),
4470 gstring_out
, XINT (index
), 0);
4473 return make_number (num
);
4476 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4478 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4479 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4481 (SCRIPT LANGSYS FEATURE ...)
4482 See the documentation of `font-drive-otf' for more detail.
4484 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4485 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4486 character code corresponding to the glyph or nil if there's no
4487 corresponding character. */)
4488 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4491 Lisp_Object gstring_in
, gstring_out
, g
;
4492 Lisp_Object alternates
;
4495 CHECK_FONT_GET_OBJECT (font_object
, font
);
4496 if (! font
->driver
->otf_drive
)
4497 error ("Font backend %s can't drive OpenType GSUB table",
4498 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4499 CHECK_CHARACTER (character
);
4500 CHECK_CONS (otf_features
);
4502 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4503 g
= LGSTRING_GLYPH (gstring_in
, 0);
4504 LGLYPH_SET_CHAR (g
, XINT (character
));
4505 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4506 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4507 gstring_out
, 0, 1)) < 0)
4508 gstring_out
= Ffont_make_gstring (font_object
,
4509 make_number (ASIZE (gstring_out
) * 2));
4511 for (i
= 0; i
< num
; i
++)
4513 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4514 int c
= LGLYPH_CHAR (g
);
4515 unsigned code
= LGLYPH_CODE (g
);
4517 alternates
= Fcons (Fcons (make_number (code
),
4518 c
> 0 ? make_number (c
) : Qnil
),
4521 return Fnreverse (alternates
);
4527 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4528 doc
: /* Open FONT-ENTITY. */)
4529 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4533 CHECK_FONT_ENTITY (font_entity
);
4535 frame
= selected_frame
;
4536 CHECK_LIVE_FRAME (frame
);
4539 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4542 CHECK_NUMBER_OR_FLOAT (size
);
4544 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4546 isize
= XINT (size
);
4550 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4553 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4554 doc
: /* Close FONT-OBJECT. */)
4555 (Lisp_Object font_object
, Lisp_Object frame
)
4557 CHECK_FONT_OBJECT (font_object
);
4559 frame
= selected_frame
;
4560 CHECK_LIVE_FRAME (frame
);
4561 font_close_object (XFRAME (frame
), font_object
);
4565 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4566 doc
: /* Return information about FONT-OBJECT.
4567 The value is a vector:
4568 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4571 NAME is a string of the font name (or nil if the font backend doesn't
4574 FILENAME is a string of the font file (or nil if the font backend
4575 doesn't provide a file name).
4577 PIXEL-SIZE is a pixel size by which the font is opened.
4579 SIZE is a maximum advance width of the font in pixels.
4581 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4584 CAPABILITY is a list whose first element is a symbol representing the
4585 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4586 remaining elements describe the details of the font capability.
4588 If the font is OpenType font, the form of the list is
4589 \(opentype GSUB GPOS)
4590 where GSUB shows which "GSUB" features the font supports, and GPOS
4591 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4592 lists of the format:
4593 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4595 If the font is not OpenType font, currently the length of the form is
4598 SCRIPT is a symbol representing OpenType script tag.
4600 LANGSYS is a symbol representing OpenType langsys tag, or nil
4601 representing the default langsys.
4603 FEATURE is a symbol representing OpenType feature tag.
4605 If the font is not OpenType font, CAPABILITY is nil. */)
4606 (Lisp_Object font_object
)
4611 CHECK_FONT_GET_OBJECT (font_object
, font
);
4613 val
= Fmake_vector (make_number (9), Qnil
);
4614 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4615 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4616 ASET (val
, 2, make_number (font
->pixel_size
));
4617 ASET (val
, 3, make_number (font
->max_width
));
4618 ASET (val
, 4, make_number (font
->ascent
));
4619 ASET (val
, 5, make_number (font
->descent
));
4620 ASET (val
, 6, make_number (font
->space_width
));
4621 ASET (val
, 7, make_number (font
->average_width
));
4622 if (font
->driver
->otf_capability
)
4623 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4627 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4629 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4630 FROM and TO are positions (integers or markers) specifying a region
4631 of the current buffer.
4632 If the optional fourth arg OBJECT is not nil, it is a string or a
4633 vector containing the target characters.
4635 Each element is a vector containing information of a glyph in this format:
4636 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4638 FROM is an index numbers of a character the glyph corresponds to.
4639 TO is the same as FROM.
4640 C is the character of the glyph.
4641 CODE is the glyph-code of C in FONT-OBJECT.
4642 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4643 ADJUSTMENT is always nil.
4644 If FONT-OBJECT doesn't have a glyph for a character,
4645 the corresponding element is nil. */)
4646 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4651 Lisp_Object
*chars
, vec
;
4654 CHECK_FONT_GET_OBJECT (font_object
, font
);
4657 EMACS_INT charpos
, bytepos
;
4659 validate_region (&from
, &to
);
4662 len
= XFASTINT (to
) - XFASTINT (from
);
4663 SAFE_ALLOCA_LISP (chars
, len
);
4664 charpos
= XFASTINT (from
);
4665 bytepos
= CHAR_TO_BYTE (charpos
);
4666 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4669 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4670 chars
[i
] = make_number (c
);
4673 else if (STRINGP (object
))
4675 const unsigned char *p
;
4677 CHECK_NUMBER (from
);
4679 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4680 || XINT (to
) > SCHARS (object
))
4681 args_out_of_range_3 (object
, from
, to
);
4684 len
= XFASTINT (to
) - XFASTINT (from
);
4685 SAFE_ALLOCA_LISP (chars
, len
);
4687 if (STRING_MULTIBYTE (object
))
4688 for (i
= 0; i
< len
; i
++)
4690 int c
= STRING_CHAR_ADVANCE (p
);
4691 chars
[i
] = make_number (c
);
4694 for (i
= 0; i
< len
; i
++)
4695 chars
[i
] = make_number (p
[i
]);
4699 CHECK_VECTOR (object
);
4700 CHECK_NUMBER (from
);
4702 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4703 || XINT (to
) > ASIZE (object
))
4704 args_out_of_range_3 (object
, from
, to
);
4707 len
= XFASTINT (to
) - XFASTINT (from
);
4708 for (i
= 0; i
< len
; i
++)
4710 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4711 CHECK_CHARACTER (elt
);
4713 chars
= &(AREF (object
, XFASTINT (from
)));
4716 vec
= Fmake_vector (make_number (len
), Qnil
);
4717 for (i
= 0; i
< len
; i
++)
4720 int c
= XFASTINT (chars
[i
]);
4722 struct font_metrics metrics
;
4724 code
= font
->driver
->encode_char (font
, c
);
4725 if (code
== FONT_INVALID_CODE
)
4727 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4728 LGLYPH_SET_FROM (g
, i
);
4729 LGLYPH_SET_TO (g
, i
);
4730 LGLYPH_SET_CHAR (g
, c
);
4731 LGLYPH_SET_CODE (g
, code
);
4732 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4733 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4734 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4735 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4736 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4737 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4740 if (! VECTORP (object
))
4745 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4746 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4747 FONT is a font-spec, font-entity, or font-object. */)
4748 (Lisp_Object spec
, Lisp_Object font
)
4750 CHECK_FONT_SPEC (spec
);
4753 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4756 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4757 doc
: /* Return a font-object for displaying a character at POSITION.
4758 Optional second arg WINDOW, if non-nil, is a window displaying
4759 the current buffer. It defaults to the currently selected window. */)
4760 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4767 CHECK_NUMBER_COERCE_MARKER (position
);
4768 pos
= XINT (position
);
4769 if (pos
< BEGV
|| pos
>= ZV
)
4770 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4774 CHECK_NUMBER (position
);
4775 CHECK_STRING (string
);
4776 pos
= XINT (position
);
4777 if (pos
< 0 || pos
>= SCHARS (string
))
4778 args_out_of_range (string
, position
);
4781 window
= selected_window
;
4782 CHECK_LIVE_WINDOW (window
);
4783 w
= XWINDOW (window
);
4785 return font_at (-1, pos
, NULL
, w
, string
);
4789 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4790 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4791 The value is a number of glyphs drawn.
4792 Type C-l to recover what previously shown. */)
4793 (Lisp_Object font_object
, Lisp_Object string
)
4795 Lisp_Object frame
= selected_frame
;
4796 FRAME_PTR f
= XFRAME (frame
);
4802 CHECK_FONT_GET_OBJECT (font_object
, font
);
4803 CHECK_STRING (string
);
4804 len
= SCHARS (string
);
4805 code
= alloca (sizeof (unsigned) * len
);
4806 for (i
= 0; i
< len
; i
++)
4808 Lisp_Object ch
= Faref (string
, make_number (i
));
4812 code
[i
] = font
->driver
->encode_char (font
, c
);
4813 if (code
[i
] == FONT_INVALID_CODE
)
4816 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4818 if (font
->driver
->prepare_face
)
4819 font
->driver
->prepare_face (f
, face
);
4820 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4821 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4822 if (font
->driver
->done_face
)
4823 font
->driver
->done_face (f
, face
);
4825 return make_number (len
);
4829 #endif /* FONT_DEBUG */
4831 #ifdef HAVE_WINDOW_SYSTEM
4833 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4834 doc
: /* Return information about a font named NAME on frame FRAME.
4835 If FRAME is omitted or nil, use the selected frame.
4836 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4837 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4839 OPENED-NAME is the name used for opening the font,
4840 FULL-NAME is the full name of the font,
4841 SIZE is the pixelsize of the font,
4842 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4843 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4844 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4845 how to compose characters.
4846 If the named font is not yet loaded, return nil. */)
4847 (Lisp_Object name
, Lisp_Object frame
)
4852 Lisp_Object font_object
;
4854 (*check_window_system_func
) ();
4857 CHECK_STRING (name
);
4859 frame
= selected_frame
;
4860 CHECK_LIVE_FRAME (frame
);
4865 int fontset
= fs_query_fontset (name
, 0);
4868 name
= fontset_ascii (fontset
);
4869 font_object
= font_open_by_name (f
, SSDATA (name
));
4871 else if (FONT_OBJECT_P (name
))
4873 else if (FONT_ENTITY_P (name
))
4874 font_object
= font_open_entity (f
, name
, 0);
4877 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4878 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4880 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4882 if (NILP (font_object
))
4884 font
= XFONT_OBJECT (font_object
);
4886 info
= Fmake_vector (make_number (7), Qnil
);
4887 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4888 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4889 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4890 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4891 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4892 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4893 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4896 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4897 close it now. Perhaps, we should manage font-objects
4898 by `reference-count'. */
4899 font_close_object (f
, font_object
);
4906 #define BUILD_STYLE_TABLE(TBL) \
4907 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4910 build_style_table (const struct table_entry
*entry
, int nelement
)
4913 Lisp_Object table
, elt
;
4915 table
= Fmake_vector (make_number (nelement
), Qnil
);
4916 for (i
= 0; i
< nelement
; i
++)
4918 for (j
= 0; entry
[i
].names
[j
]; j
++);
4919 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4920 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4921 for (j
= 0; entry
[i
].names
[j
]; j
++)
4922 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4923 ASET (table
, i
, elt
);
4928 /* The deferred font-log data of the form [ACTION ARG RESULT].
4929 If ACTION is not nil, that is added to the log when font_add_log is
4930 called next time. At that time, ACTION is set back to nil. */
4931 static Lisp_Object Vfont_log_deferred
;
4933 /* Prepend the font-related logging data in Vfont_log if it is not
4934 `t'. ACTION describes a kind of font-related action (e.g. listing,
4935 opening), ARG is the argument for the action, and RESULT is the
4936 result of the action. */
4938 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4943 if (EQ (Vfont_log
, Qt
))
4945 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4947 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4949 ASET (Vfont_log_deferred
, 0, Qnil
);
4950 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4951 AREF (Vfont_log_deferred
, 2));
4956 Lisp_Object tail
, elt
;
4957 Lisp_Object equalstr
= build_string ("=");
4959 val
= Ffont_xlfd_name (arg
, Qt
);
4960 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4964 if (EQ (XCAR (elt
), QCscript
)
4965 && SYMBOLP (XCDR (elt
)))
4966 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4967 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4968 else if (EQ (XCAR (elt
), QClang
)
4969 && SYMBOLP (XCDR (elt
)))
4970 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4971 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4972 else if (EQ (XCAR (elt
), QCotf
)
4973 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4974 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4976 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4982 && VECTORP (XCAR (result
))
4983 && ASIZE (XCAR (result
)) > 0
4984 && FONTP (AREF (XCAR (result
), 0)))
4985 result
= font_vconcat_entity_vectors (result
);
4988 val
= Ffont_xlfd_name (result
, Qt
);
4989 if (! FONT_SPEC_P (result
))
4990 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4991 build_string (":"), val
);
4994 else if (CONSP (result
))
4997 result
= Fcopy_sequence (result
);
4998 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5002 val
= Ffont_xlfd_name (val
, Qt
);
5003 XSETCAR (tail
, val
);
5006 else if (VECTORP (result
))
5008 result
= Fcopy_sequence (result
);
5009 for (i
= 0; i
< ASIZE (result
); i
++)
5011 val
= AREF (result
, i
);
5013 val
= Ffont_xlfd_name (val
, Qt
);
5014 ASET (result
, i
, val
);
5017 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5020 /* Record a font-related logging data to be added to Vfont_log when
5021 font_add_log is called next time. ACTION, ARG, RESULT are the same
5025 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5027 if (EQ (Vfont_log
, Qt
))
5029 ASET (Vfont_log_deferred
, 0, build_string (action
));
5030 ASET (Vfont_log_deferred
, 1, arg
);
5031 ASET (Vfont_log_deferred
, 2, result
);
5037 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5038 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5039 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5040 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5041 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5042 /* Note that the other elements in sort_shift_bits are not used. */
5044 staticpro (&font_charset_alist
);
5045 font_charset_alist
= Qnil
;
5047 DEFSYM (Qopentype
, "opentype");
5049 DEFSYM (Qascii_0
, "ascii-0");
5050 DEFSYM (Qiso8859_1
, "iso8859-1");
5051 DEFSYM (Qiso10646_1
, "iso10646-1");
5052 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5053 DEFSYM (Qunicode_sip
, "unicode-sip");
5057 DEFSYM (QCotf
, ":otf");
5058 DEFSYM (QClang
, ":lang");
5059 DEFSYM (QCscript
, ":script");
5060 DEFSYM (QCantialias
, ":antialias");
5062 DEFSYM (QCfoundry
, ":foundry");
5063 DEFSYM (QCadstyle
, ":adstyle");
5064 DEFSYM (QCregistry
, ":registry");
5065 DEFSYM (QCspacing
, ":spacing");
5066 DEFSYM (QCdpi
, ":dpi");
5067 DEFSYM (QCscalable
, ":scalable");
5068 DEFSYM (QCavgwidth
, ":avgwidth");
5069 DEFSYM (QCfont_entity
, ":font-entity");
5070 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5080 DEFSYM (QCuser_spec
, "user-spec");
5082 staticpro (&null_vector
);
5083 null_vector
= Fmake_vector (make_number (0), Qnil
);
5085 staticpro (&scratch_font_spec
);
5086 scratch_font_spec
= Ffont_spec (0, NULL
);
5087 staticpro (&scratch_font_prefer
);
5088 scratch_font_prefer
= Ffont_spec (0, NULL
);
5090 staticpro (&Vfont_log_deferred
);
5091 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5095 staticpro (&otf_list
);
5097 #endif /* HAVE_LIBOTF */
5101 defsubr (&Sfont_spec
);
5102 defsubr (&Sfont_get
);
5103 #ifdef HAVE_WINDOW_SYSTEM
5104 defsubr (&Sfont_face_attributes
);
5106 defsubr (&Sfont_put
);
5107 defsubr (&Slist_fonts
);
5108 defsubr (&Sfont_family_list
);
5109 defsubr (&Sfind_font
);
5110 defsubr (&Sfont_xlfd_name
);
5111 defsubr (&Sclear_font_cache
);
5112 defsubr (&Sfont_shape_gstring
);
5113 defsubr (&Sfont_variation_glyphs
);
5115 defsubr (&Sfont_drive_otf
);
5116 defsubr (&Sfont_otf_alternates
);
5120 defsubr (&Sopen_font
);
5121 defsubr (&Sclose_font
);
5122 defsubr (&Squery_font
);
5123 defsubr (&Sfont_get_glyphs
);
5124 defsubr (&Sfont_match_p
);
5125 defsubr (&Sfont_at
);
5127 defsubr (&Sdraw_string
);
5129 #endif /* FONT_DEBUG */
5130 #ifdef HAVE_WINDOW_SYSTEM
5131 defsubr (&Sfont_info
);
5134 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5136 Alist of fontname patterns vs the corresponding encoding and repertory info.
5137 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5138 where ENCODING is a charset or a char-table,
5139 and REPERTORY is a charset, a char-table, or nil.
5141 If ENCODING and REPERTORY are the same, the element can have the form
5142 \(REGEXP . ENCODING).
5144 ENCODING is for converting a character to a glyph code of the font.
5145 If ENCODING is a charset, encoding a character by the charset gives
5146 the corresponding glyph code. If ENCODING is a char-table, looking up
5147 the table by a character gives the corresponding glyph code.
5149 REPERTORY specifies a repertory of characters supported by the font.
5150 If REPERTORY is a charset, all characters beloging to the charset are
5151 supported. If REPERTORY is a char-table, all characters who have a
5152 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5153 gets the repertory information by an opened font and ENCODING. */);
5154 Vfont_encoding_alist
= Qnil
;
5156 /* FIXME: These 3 vars are not quite what they appear: setq on them
5157 won't have any effect other than disconnect them from the style
5158 table used by the font display code. So we make them read-only,
5159 to avoid this confusing situation. */
5161 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5162 doc
: /* Vector of valid font weight values.
5163 Each element has the form:
5164 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5165 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5166 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5167 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5169 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5170 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5171 See `font-weight-table' for the format of the vector. */);
5172 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5173 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5175 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5176 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5177 See `font-weight-table' for the format of the vector. */);
5178 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5179 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5181 staticpro (&font_style_table
);
5182 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5183 ASET (font_style_table
, 0, Vfont_weight_table
);
5184 ASET (font_style_table
, 1, Vfont_slant_table
);
5185 ASET (font_style_table
, 2, Vfont_width_table
);
5187 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5188 *Logging list of font related actions and results.
5189 The value t means to suppress the logging.
5190 The initial value is set to nil if the environment variable
5191 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5194 #ifdef HAVE_WINDOW_SYSTEM
5195 #ifdef HAVE_FREETYPE
5197 #ifdef HAVE_X_WINDOWS
5202 #endif /* HAVE_XFT */
5203 #endif /* HAVE_X_WINDOWS */
5204 #else /* not HAVE_FREETYPE */
5205 #ifdef HAVE_X_WINDOWS
5207 #endif /* HAVE_X_WINDOWS */
5208 #endif /* not HAVE_FREETYPE */
5211 #endif /* HAVE_BDFFONT */
5214 #endif /* WINDOWSNT */
5217 #endif /* HAVE_NS */
5218 #endif /* HAVE_WINDOW_SYSTEM */
5224 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;