1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2011 Free Software Foundation, Inc.
4 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
51 Lisp_Object Qopentype
;
53 /* Important character set strings. */
54 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
56 #define DEFAULT_ENCODING Qiso8859_1
58 /* Unicode category `Cf'. */
59 static Lisp_Object QCf
;
61 /* Special vector of zero length. This is repeatedly used by (struct
62 font_driver *)->list when a specified font is not found. */
63 static Lisp_Object null_vector
;
65 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
66 static Lisp_Object font_style_table
;
68 /* Structure used for tables mapping weight, slant, and width numeric
69 values and their names. */
74 /* The first one is a valid name as a face attribute.
75 The second one (if any) is a typical name in XLFD field. */
79 /* Table of weight numeric values and their names. This table must be
80 sorted by numeric values in ascending order. */
82 static const struct table_entry weight_table
[] =
85 { 20, { "ultra-light", "ultralight" }},
86 { 40, { "extra-light", "extralight" }},
88 { 75, { "semi-light", "semilight", "demilight", "book" }},
89 { 100, { "normal", "medium", "regular", "unspecified" }},
90 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
92 { 205, { "extra-bold", "extrabold" }},
93 { 210, { "ultra-bold", "ultrabold", "black" }}
96 /* Table of slant numeric values and their names. This table must be
97 sorted by numeric values in ascending order. */
99 static const struct table_entry slant_table
[] =
101 { 0, { "reverse-oblique", "ro" }},
102 { 10, { "reverse-italic", "ri" }},
103 { 100, { "normal", "r", "unspecified" }},
104 { 200, { "italic" ,"i", "ot" }},
105 { 210, { "oblique", "o" }}
108 /* Table of width numeric values and their names. This table must be
109 sorted by numeric values in ascending order. */
111 static const struct table_entry width_table
[] =
113 { 50, { "ultra-condensed", "ultracondensed" }},
114 { 63, { "extra-condensed", "extracondensed" }},
115 { 75, { "condensed", "compressed", "narrow" }},
116 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
117 { 100, { "normal", "medium", "regular", "unspecified" }},
118 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
119 { 125, { "expanded" }},
120 { 150, { "extra-expanded", "extraexpanded" }},
121 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
124 Lisp_Object QCfoundry
;
125 static Lisp_Object QCadstyle
, QCregistry
;
126 /* Symbols representing keys of font extra info. */
127 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
128 Lisp_Object QCantialias
, QCfont_entity
;
129 static Lisp_Object QCfc_unknown_spec
;
130 /* Symbols representing values of font spacing property. */
131 static Lisp_Object Qc
, Qm
, Qd
;
133 /* Special ADSTYLE properties to avoid fonts used for Latin
134 characters; used in xfont.c and ftfont.c. */
135 Lisp_Object Qja
, Qko
;
137 static Lisp_Object QCuser_spec
;
139 /* Alist of font registry symbol and the corresponding charsets
140 information. The information is retrieved from
141 Vfont_encoding_alist on demand.
143 Eash element has the form:
144 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
148 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
149 encodes a character code to a glyph code of a font, and
150 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
151 character is supported by a font.
153 The latter form means that the information for REGISTRY couldn't be
155 static Lisp_Object font_charset_alist
;
157 /* List of all font drivers. Each font-backend (XXXfont.c) calls
158 register_font_driver in syms_of_XXXfont to register its font-driver
160 static struct font_driver_list
*font_driver_list
;
164 /* Creaters of font-related Lisp object. */
167 font_make_spec (void)
169 Lisp_Object font_spec
;
170 struct font_spec
*spec
171 = ((struct font_spec
*)
172 allocate_pseudovector (VECSIZE (struct font_spec
),
173 FONT_SPEC_MAX
, PVEC_FONT
));
174 XSETFONT (font_spec
, spec
);
179 font_make_entity (void)
181 Lisp_Object font_entity
;
182 struct font_entity
*entity
183 = ((struct font_entity
*)
184 allocate_pseudovector (VECSIZE (struct font_entity
),
185 FONT_ENTITY_MAX
, PVEC_FONT
));
186 XSETFONT (font_entity
, entity
);
190 /* Create a font-object whose structure size is SIZE. If ENTITY is
191 not nil, copy properties from ENTITY to the font-object. If
192 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
194 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
196 Lisp_Object font_object
;
198 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
201 XSETFONT (font_object
, font
);
205 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
206 font
->props
[i
] = AREF (entity
, i
);
207 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
208 font
->props
[FONT_EXTRA_INDEX
]
209 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
212 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
218 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
219 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
220 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
222 static unsigned font_encode_char (Lisp_Object
, int);
224 /* Number of registered font drivers. */
225 static int num_font_drivers
;
228 /* Return a Lispy value of a font property value at STR and LEN bytes.
229 If STR is "*", it returns nil.
230 If FORCE_SYMBOL is zero and all characters in STR are digits, it
231 returns an integer. Otherwise, it returns a symbol interned from
235 font_intern_prop (const char *str
, int len
, int force_symbol
)
240 EMACS_INT nbytes
, nchars
;
242 if (len
== 1 && *str
== '*')
244 if (!force_symbol
&& len
>=1 && isdigit (*str
))
246 for (i
= 1; i
< len
; i
++)
247 if (! isdigit (str
[i
]))
250 return make_number (atoi (str
));
253 /* The following code is copied from the function intern (in
254 lread.c), and modified to suite our purpose. */
256 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
257 obarray
= check_obarray (obarray
);
258 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
259 if (len
== nchars
|| len
!= nbytes
)
260 /* CONTENTS contains no multibyte sequences or contains an invalid
261 multibyte sequence. We'll make a unibyte string. */
262 tem
= oblookup (obarray
, str
, len
, len
);
264 tem
= oblookup (obarray
, str
, nchars
, len
);
267 if (len
== nchars
|| len
!= nbytes
)
268 tem
= make_unibyte_string (str
, len
);
270 tem
= make_multibyte_string (str
, nchars
, len
);
271 return Fintern (tem
, obarray
);
274 /* Return a pixel size of font-spec SPEC on frame F. */
277 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
279 #ifdef HAVE_WINDOW_SYSTEM
280 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
289 font_assert (FLOATP (size
));
290 point_size
= XFLOAT_DATA (size
);
291 val
= AREF (spec
, FONT_DPI_INDEX
);
296 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
304 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
305 font vector. If VAL is not valid (i.e. not registered in
306 font_style_table), return -1 if NOERROR is zero, and return a
307 proper index if NOERROR is nonzero. In that case, register VAL in
308 font_style_table if VAL is a symbol, and return a closest index if
309 VAL is an integer. */
312 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
314 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
315 int len
= ASIZE (table
);
321 Lisp_Object args
[2], elt
;
323 /* At first try exact match. */
324 for (i
= 0; i
< len
; i
++)
325 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
326 if (EQ (val
, AREF (AREF (table
, i
), j
)))
327 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
328 | (i
<< 4) | (j
- 1));
329 /* Try also with case-folding match. */
330 s
= SSDATA (SYMBOL_NAME (val
));
331 for (i
= 0; i
< len
; i
++)
332 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
334 elt
= AREF (AREF (table
, i
), j
);
335 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
336 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
337 | (i
<< 4) | (j
- 1));
343 elt
= Fmake_vector (make_number (2), make_number (100));
346 args
[1] = Fmake_vector (make_number (1), elt
);
347 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
348 return (100 << 8) | (i
<< 4);
353 int numeric
= XINT (val
);
355 for (i
= 0, last_n
= -1; i
< len
; i
++)
357 int n
= XINT (AREF (AREF (table
, i
), 0));
360 return (n
<< 8) | (i
<< 4);
365 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
366 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
372 return ((last_n
<< 8) | ((i
- 1) << 4));
377 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
379 Lisp_Object val
= AREF (font
, prop
);
380 Lisp_Object table
, elt
;
385 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
386 i
= XINT (val
) & 0xFF;
387 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
388 elt
= AREF (table
, ((i
>> 4) & 0xF));
389 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
390 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
393 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
394 FONTNAME. ENCODING is a charset symbol that specifies the encoding
395 of the font. REPERTORY is a charset symbol or nil. */
398 find_font_encoding (Lisp_Object fontname
)
400 Lisp_Object tail
, elt
;
402 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
406 && STRINGP (XCAR (elt
))
407 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
408 && (SYMBOLP (XCDR (elt
))
409 ? CHARSETP (XCDR (elt
))
410 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
416 /* Return encoding charset and repertory charset for REGISTRY in
417 ENCODING and REPERTORY correspondingly. If correct information for
418 REGISTRY is available, return 0. Otherwise return -1. */
421 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
424 int encoding_id
, repertory_id
;
426 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
432 encoding_id
= XINT (XCAR (val
));
433 repertory_id
= XINT (XCDR (val
));
437 val
= find_font_encoding (SYMBOL_NAME (registry
));
438 if (SYMBOLP (val
) && CHARSETP (val
))
440 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
442 else if (CONSP (val
))
444 if (! CHARSETP (XCAR (val
)))
446 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
447 if (NILP (XCDR (val
)))
451 if (! CHARSETP (XCDR (val
)))
453 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
458 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
460 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
464 *encoding
= CHARSET_FROM_ID (encoding_id
);
466 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
471 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
476 /* Font property value validaters. See the comment of
477 font_property_table for the meaning of the arguments. */
479 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
480 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
481 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
482 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
483 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
484 static int get_font_prop_index (Lisp_Object
);
487 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
490 val
= Fintern (val
, Qnil
);
493 else if (EQ (prop
, QCregistry
))
494 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
500 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
502 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
503 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
509 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
513 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
515 if ((n
& 0xF) + 1 >= ASIZE (elt
))
517 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
521 else if (SYMBOLP (val
))
523 int n
= font_style_to_value (prop
, val
, 0);
525 val
= n
>= 0 ? make_number (n
) : Qerror
;
533 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
535 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
540 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
542 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
544 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
546 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
548 if (spacing
== 'c' || spacing
== 'C')
549 return make_number (FONT_SPACING_CHARCELL
);
550 if (spacing
== 'm' || spacing
== 'M')
551 return make_number (FONT_SPACING_MONO
);
552 if (spacing
== 'p' || spacing
== 'P')
553 return make_number (FONT_SPACING_PROPORTIONAL
);
554 if (spacing
== 'd' || spacing
== 'D')
555 return make_number (FONT_SPACING_DUAL
);
561 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
563 Lisp_Object tail
, tmp
;
566 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
567 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
568 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
571 if (! SYMBOLP (XCAR (val
)))
576 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
578 for (i
= 0; i
< 2; i
++)
585 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
586 if (! SYMBOLP (XCAR (tmp
)))
594 /* Structure of known font property keys and validater of the
598 /* Pointer to the key symbol. */
600 /* Function to validate PROP's value VAL, or NULL if any value is
601 ok. The value is VAL or its regularized value if VAL is valid,
602 and Qerror if not. */
603 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
604 } font_property_table
[] =
605 { { &QCtype
, font_prop_validate_symbol
},
606 { &QCfoundry
, font_prop_validate_symbol
},
607 { &QCfamily
, font_prop_validate_symbol
},
608 { &QCadstyle
, font_prop_validate_symbol
},
609 { &QCregistry
, font_prop_validate_symbol
},
610 { &QCweight
, font_prop_validate_style
},
611 { &QCslant
, font_prop_validate_style
},
612 { &QCwidth
, font_prop_validate_style
},
613 { &QCsize
, font_prop_validate_non_neg
},
614 { &QCdpi
, font_prop_validate_non_neg
},
615 { &QCspacing
, font_prop_validate_spacing
},
616 { &QCavgwidth
, font_prop_validate_non_neg
},
617 /* The order of the above entries must match with enum
618 font_property_index. */
619 { &QClang
, font_prop_validate_symbol
},
620 { &QCscript
, font_prop_validate_symbol
},
621 { &QCotf
, font_prop_validate_otf
}
624 /* Size (number of elements) of the above table. */
625 #define FONT_PROPERTY_TABLE_SIZE \
626 ((sizeof font_property_table) / (sizeof *font_property_table))
628 /* Return an index number of font property KEY or -1 if KEY is not an
629 already known property. */
632 get_font_prop_index (Lisp_Object key
)
636 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
637 if (EQ (key
, *font_property_table
[i
].key
))
642 /* Validate the font property. The property key is specified by the
643 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
644 signal an error. The value is VAL or the regularized one. */
647 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
649 Lisp_Object validated
;
654 prop
= *font_property_table
[idx
].key
;
657 idx
= get_font_prop_index (prop
);
661 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
662 if (EQ (validated
, Qerror
))
663 signal_error ("invalid font property", Fcons (prop
, val
));
668 /* Store VAL as a value of extra font property PROP in FONT while
669 keeping the sorting order. Don't check the validity of VAL. */
672 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
674 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
675 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
679 Lisp_Object prev
= Qnil
;
682 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
683 prev
= extra
, extra
= XCDR (extra
);
686 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
688 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
694 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
699 /* Font name parser and unparser */
701 static int parse_matrix (const char *);
702 static int font_expand_wildcards (Lisp_Object
*, int);
703 static int font_parse_name (char *, Lisp_Object
);
705 /* An enumerator for each field of an XLFD font name. */
706 enum xlfd_field_index
725 /* An enumerator for mask bit corresponding to each XLFD field. */
728 XLFD_FOUNDRY_MASK
= 0x0001,
729 XLFD_FAMILY_MASK
= 0x0002,
730 XLFD_WEIGHT_MASK
= 0x0004,
731 XLFD_SLANT_MASK
= 0x0008,
732 XLFD_SWIDTH_MASK
= 0x0010,
733 XLFD_ADSTYLE_MASK
= 0x0020,
734 XLFD_PIXEL_MASK
= 0x0040,
735 XLFD_POINT_MASK
= 0x0080,
736 XLFD_RESX_MASK
= 0x0100,
737 XLFD_RESY_MASK
= 0x0200,
738 XLFD_SPACING_MASK
= 0x0400,
739 XLFD_AVGWIDTH_MASK
= 0x0800,
740 XLFD_REGISTRY_MASK
= 0x1000,
741 XLFD_ENCODING_MASK
= 0x2000
745 /* Parse P pointing the pixel/point size field of the form
746 `[A B C D]' which specifies a transformation matrix:
752 by which all glyphs of the font are transformed. The spec says
753 that scalar value N for the pixel/point size is equivalent to:
754 A = N * resx/resy, B = C = 0, D = N.
756 Return the scalar value N if the form is valid. Otherwise return
760 parse_matrix (const char *p
)
766 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
769 matrix
[i
] = - strtod (p
+ 1, &end
);
771 matrix
[i
] = strtod (p
, &end
);
774 return (i
== 4 ? (int) matrix
[3] : -1);
777 /* Expand a wildcard field in FIELD (the first N fields are filled) to
778 multiple fields to fill in all 14 XLFD fields while restring a
779 field position by its contents. */
782 font_expand_wildcards (Lisp_Object
*field
, int n
)
785 Lisp_Object tmp
[XLFD_LAST_INDEX
];
786 /* Array of information about where this element can go. Nth
787 element is for Nth element of FIELD. */
789 /* Minimum possible field. */
791 /* Maxinum possible field. */
793 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
795 } range
[XLFD_LAST_INDEX
];
797 int range_from
, range_to
;
800 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
801 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
802 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
803 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
804 | XLFD_AVGWIDTH_MASK)
805 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
807 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
808 field. The value is shifted to left one bit by one in the
810 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
811 range_mask
= (range_mask
<< 1) | 1;
813 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
814 position-based retriction for FIELD[I]. */
815 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
816 i
++, range_from
++, range_to
++, range_mask
<<= 1)
818 Lisp_Object val
= field
[i
];
824 range
[i
].from
= range_from
;
825 range
[i
].to
= range_to
;
826 range
[i
].mask
= range_mask
;
830 /* The triplet FROM, TO, and MASK is a value-based
831 retriction for FIELD[I]. */
837 int numeric
= XINT (val
);
840 from
= to
= XLFD_ENCODING_INDEX
,
841 mask
= XLFD_ENCODING_MASK
;
842 else if (numeric
== 0)
843 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
844 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
845 else if (numeric
<= 48)
846 from
= to
= XLFD_PIXEL_INDEX
,
847 mask
= XLFD_PIXEL_MASK
;
849 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
850 mask
= XLFD_LARGENUM_MASK
;
852 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
853 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
854 mask
= XLFD_NULL_MASK
;
856 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
859 Lisp_Object name
= SYMBOL_NAME (val
);
861 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
862 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
863 mask
= XLFD_REGENC_MASK
;
865 from
= to
= XLFD_ENCODING_INDEX
,
866 mask
= XLFD_ENCODING_MASK
;
868 else if (range_from
<= XLFD_WEIGHT_INDEX
869 && range_to
>= XLFD_WEIGHT_INDEX
870 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
871 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
872 else if (range_from
<= XLFD_SLANT_INDEX
873 && range_to
>= XLFD_SLANT_INDEX
874 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
875 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
876 else if (range_from
<= XLFD_SWIDTH_INDEX
877 && range_to
>= XLFD_SWIDTH_INDEX
878 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
879 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
882 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
883 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
885 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
886 mask
= XLFD_SYMBOL_MASK
;
889 /* Merge position-based and value-based restrictions. */
891 while (from
< range_from
)
892 mask
&= ~(1 << from
++);
893 while (from
< 14 && ! (mask
& (1 << from
)))
895 while (to
> range_to
)
896 mask
&= ~(1 << to
--);
897 while (to
>= 0 && ! (mask
& (1 << to
)))
901 range
[i
].from
= from
;
903 range
[i
].mask
= mask
;
905 if (from
> range_from
|| to
< range_to
)
907 /* The range is narrowed by value-based restrictions.
908 Reflect it to the other fields. */
910 /* Following fields should be after FROM. */
912 /* Preceding fields should be before TO. */
913 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
915 /* Check FROM for non-wildcard field. */
916 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
918 while (range
[j
].from
< from
)
919 range
[j
].mask
&= ~(1 << range
[j
].from
++);
920 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
922 range
[j
].from
= from
;
925 from
= range
[j
].from
;
926 if (range
[j
].to
> to
)
928 while (range
[j
].to
> to
)
929 range
[j
].mask
&= ~(1 << range
[j
].to
--);
930 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
943 /* Decide all fileds from restrictions in RANGE. */
944 for (i
= j
= 0; i
< n
; i
++)
946 if (j
< range
[i
].from
)
948 if (i
== 0 || ! NILP (tmp
[i
- 1]))
949 /* None of TMP[X] corresponds to Jth field. */
951 for (; j
< range
[i
].from
; j
++)
956 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
958 for (; j
< XLFD_LAST_INDEX
; j
++)
960 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
961 field
[XLFD_ENCODING_INDEX
]
962 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
967 /* Parse NAME (null terminated) as XLFD and store information in FONT
968 (font-spec or font-entity). Size property of FONT is set as
970 specified XLFD fields FONT property
971 --------------------- -------------
972 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
973 POINT_SIZE and RESY calculated pixel size (Lisp integer)
974 POINT_SIZE POINT_SIZE/10 (Lisp float)
976 If NAME is successfully parsed, return 0. Otherwise return -1.
978 FONT is usually a font-spec, but when this function is called from
979 X font backend driver, it is a font-entity. In that case, NAME is
980 a fully specified XLFD. */
983 font_parse_xlfd (char *name
, Lisp_Object font
)
985 int len
= strlen (name
);
987 char *f
[XLFD_LAST_INDEX
+ 1];
991 if (len
> 255 || !len
)
992 /* Maximum XLFD name length is 255. */
994 /* Accept "*-.." as a fully specified XLFD. */
995 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
996 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
999 for (p
= name
+ i
; *p
; p
++)
1003 if (i
== XLFD_LAST_INDEX
)
1008 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1009 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1011 if (i
== XLFD_LAST_INDEX
)
1013 /* Fully specified XLFD. */
1016 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1017 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1018 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1019 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1021 val
= INTERN_FIELD_SYM (i
);
1024 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1026 ASET (font
, j
, make_number (n
));
1029 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1030 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1031 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1033 ASET (font
, FONT_REGISTRY_INDEX
,
1034 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1035 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1037 p
= f
[XLFD_PIXEL_INDEX
];
1038 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1039 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1042 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1044 ASET (font
, FONT_SIZE_INDEX
, val
);
1045 else if (FONT_ENTITY_P (font
))
1049 double point_size
= -1;
1051 font_assert (FONT_SPEC_P (font
));
1052 p
= f
[XLFD_POINT_INDEX
];
1054 point_size
= parse_matrix (p
);
1055 else if (isdigit (*p
))
1056 point_size
= atoi (p
), point_size
/= 10;
1057 if (point_size
>= 0)
1058 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1062 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1063 if (! NILP (val
) && ! INTEGERP (val
))
1065 ASET (font
, FONT_DPI_INDEX
, val
);
1066 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1069 val
= font_prop_validate_spacing (QCspacing
, val
);
1070 if (! INTEGERP (val
))
1072 ASET (font
, FONT_SPACING_INDEX
, val
);
1074 p
= f
[XLFD_AVGWIDTH_INDEX
];
1077 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1078 if (! NILP (val
) && ! INTEGERP (val
))
1080 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1084 int wild_card_found
= 0;
1085 Lisp_Object prop
[XLFD_LAST_INDEX
];
1087 if (FONT_ENTITY_P (font
))
1089 for (j
= 0; j
< i
; j
++)
1093 if (f
[j
][1] && f
[j
][1] != '-')
1096 wild_card_found
= 1;
1099 prop
[j
] = INTERN_FIELD (j
);
1101 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1103 if (! wild_card_found
)
1105 if (font_expand_wildcards (prop
, i
) < 0)
1108 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1109 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1110 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1111 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1112 if (! NILP (prop
[i
]))
1114 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1116 ASET (font
, j
, make_number (n
));
1118 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1119 val
= prop
[XLFD_REGISTRY_INDEX
];
1122 val
= prop
[XLFD_ENCODING_INDEX
];
1124 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1126 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1127 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1129 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1130 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1132 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1134 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1135 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1136 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1138 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1140 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1143 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1144 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1145 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1147 val
= font_prop_validate_spacing (QCspacing
,
1148 prop
[XLFD_SPACING_INDEX
]);
1149 if (! INTEGERP (val
))
1151 ASET (font
, FONT_SPACING_INDEX
, val
);
1153 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1154 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1160 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1161 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1162 0, use PIXEL_SIZE instead. */
1165 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1168 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1172 font_assert (FONTP (font
));
1174 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1177 if (i
== FONT_ADSTYLE_INDEX
)
1178 j
= XLFD_ADSTYLE_INDEX
;
1179 else if (i
== FONT_REGISTRY_INDEX
)
1180 j
= XLFD_REGISTRY_INDEX
;
1181 val
= AREF (font
, i
);
1184 if (j
== XLFD_REGISTRY_INDEX
)
1185 f
[j
] = "*-*", len
+= 4;
1187 f
[j
] = "*", len
+= 2;
1192 val
= SYMBOL_NAME (val
);
1193 if (j
== XLFD_REGISTRY_INDEX
1194 && ! strchr (SSDATA (val
), '-'))
1196 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1197 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1199 f
[j
] = p
= alloca (SBYTES (val
) + 3);
1200 sprintf (p
, "%s-*", SDATA (val
));
1201 len
+= SBYTES (val
) + 3;
1205 f
[j
] = p
= alloca (SBYTES (val
) + 4);
1206 sprintf (p
, "%s*-*", SDATA (val
));
1207 len
+= SBYTES (val
) + 4;
1211 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1215 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1218 val
= font_style_symbolic (font
, i
, 0);
1220 f
[j
] = "*", len
+= 2;
1223 val
= SYMBOL_NAME (val
);
1224 f
[j
] = SSDATA (val
), len
+= SBYTES (val
) + 1;
1228 val
= AREF (font
, FONT_SIZE_INDEX
);
1229 font_assert (NUMBERP (val
) || NILP (val
));
1237 f
[XLFD_PIXEL_INDEX
] = p
= alloca (22);
1238 len
+= sprintf (p
, "%d-*", i
) + 1;
1241 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1243 else if (FLOATP (val
))
1245 i
= XFLOAT_DATA (val
) * 10;
1246 f
[XLFD_PIXEL_INDEX
] = p
= alloca (12);
1247 len
+= sprintf (p
, "*-%d", i
) + 1;
1250 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1252 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1254 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1255 f
[XLFD_RESX_INDEX
] = p
= alloca (22);
1256 len
+= sprintf (p
, "%d-%d", i
, i
) + 1;
1259 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1260 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1262 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1264 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1265 : spacing
<= FONT_SPACING_DUAL
? "d"
1266 : spacing
<= FONT_SPACING_MONO
? "m"
1271 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1272 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1274 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (11);
1275 len
+= sprintf (p
, "%ld",
1276 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1279 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1280 len
++; /* for terminating '\0'. */
1283 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1284 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1285 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1286 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1287 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1288 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1289 f
[XLFD_REGISTRY_INDEX
]);
1292 /* Parse NAME (null terminated) and store information in FONT
1293 (font-spec or font-entity). NAME is supplied in either the
1294 Fontconfig or GTK font name format. If NAME is successfully
1295 parsed, return 0. Otherwise return -1.
1297 The fontconfig format is
1299 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1303 FAMILY [PROPS...] [SIZE]
1305 This function tries to guess which format it is. */
1308 font_parse_fcname (char *name
, Lisp_Object font
)
1311 char *size_beg
= NULL
, *size_end
= NULL
;
1312 char *props_beg
= NULL
, *family_end
= NULL
;
1313 int len
= strlen (name
);
1318 for (p
= name
; *p
; p
++)
1320 if (*p
== '\\' && p
[1])
1324 props_beg
= family_end
= p
;
1329 int decimal
= 0, size_found
= 1;
1330 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1333 if (*q
!= '.' || decimal
)
1352 Lisp_Object extra_props
= Qnil
;
1354 /* A fontconfig name with size and/or property data. */
1355 if (family_end
> name
)
1358 family
= font_intern_prop (name
, family_end
- name
, 1);
1359 ASET (font
, FONT_FAMILY_INDEX
, family
);
1363 double point_size
= strtod (size_beg
, &size_end
);
1364 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1365 if (*size_end
== ':' && size_end
[1])
1366 props_beg
= size_end
;
1370 /* Now parse ":KEY=VAL" patterns. */
1373 for (p
= props_beg
; *p
; p
= q
)
1375 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1378 /* Must be an enumerated value. */
1382 val
= font_intern_prop (p
, q
- p
, 1);
1384 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1385 && memcmp (p, STR, strlen (STR)) == 0)
1387 if (PROP_MATCH ("light")
1388 || PROP_MATCH ("medium")
1389 || PROP_MATCH ("demibold")
1390 || PROP_MATCH ("bold")
1391 || PROP_MATCH ("black"))
1392 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1393 else if (PROP_MATCH ("roman")
1394 || PROP_MATCH ("italic")
1395 || PROP_MATCH ("oblique"))
1396 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1397 else if (PROP_MATCH ("charcell"))
1398 ASET (font
, FONT_SPACING_INDEX
,
1399 make_number (FONT_SPACING_CHARCELL
));
1400 else if (PROP_MATCH ("mono"))
1401 ASET (font
, FONT_SPACING_INDEX
,
1402 make_number (FONT_SPACING_MONO
));
1403 else if (PROP_MATCH ("proportional"))
1404 ASET (font
, FONT_SPACING_INDEX
,
1405 make_number (FONT_SPACING_PROPORTIONAL
));
1414 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1415 prop
= FONT_SIZE_INDEX
;
1418 key
= font_intern_prop (p
, q
- p
, 1);
1419 prop
= get_font_prop_index (key
);
1423 for (q
= p
; *q
&& *q
!= ':'; q
++);
1424 val
= font_intern_prop (p
, q
- p
, 0);
1426 if (prop
>= FONT_FOUNDRY_INDEX
1427 && prop
< FONT_EXTRA_INDEX
)
1428 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1431 extra_props
= nconc2 (extra_props
,
1432 Fcons (Fcons (key
, val
), Qnil
));
1439 if (! NILP (extra_props
))
1441 struct font_driver_list
*driver_list
= font_driver_list
;
1442 for ( ; driver_list
; driver_list
= driver_list
->next
)
1443 if (driver_list
->driver
->filter_properties
)
1444 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1450 /* Either a fontconfig-style name with no size and property
1451 data, or a GTK-style name. */
1452 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1453 Lisp_Object width
= Qnil
, size
= Qnil
;
1457 /* Scan backwards from the end, looking for a size. */
1458 for (p
= name
+ len
- 1; p
>= name
; p
--)
1462 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1463 /* Found a font size. */
1464 size
= make_float (strtod (p
+ 1, NULL
));
1468 /* Now P points to the termination of the string, sans size.
1469 Scan backwards, looking for font properties. */
1470 for (; p
> name
; p
= q
)
1472 for (q
= p
- 1; q
>= name
; q
--)
1474 if (q
> name
&& *(q
-1) == '\\')
1475 --q
; /* Skip quoting backslashes. */
1481 word_len
= p
- word_start
;
1483 #define PROP_MATCH(STR) \
1484 (word_len == strlen (STR) \
1485 && memcmp (word_start, STR, strlen (STR)) == 0)
1486 #define PROP_SAVE(VAR, STR) \
1487 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1489 if (PROP_MATCH ("Ultra-Light"))
1490 PROP_SAVE (weight
, "ultra-light");
1491 else if (PROP_MATCH ("Light"))
1492 PROP_SAVE (weight
, "light");
1493 else if (PROP_MATCH ("Book"))
1494 PROP_SAVE (weight
, "book");
1495 else if (PROP_MATCH ("Medium"))
1496 PROP_SAVE (weight
, "medium");
1497 else if (PROP_MATCH ("Semi-Bold"))
1498 PROP_SAVE (weight
, "semi-bold");
1499 else if (PROP_MATCH ("Bold"))
1500 PROP_SAVE (weight
, "bold");
1501 else if (PROP_MATCH ("Italic"))
1502 PROP_SAVE (slant
, "italic");
1503 else if (PROP_MATCH ("Oblique"))
1504 PROP_SAVE (slant
, "oblique");
1505 else if (PROP_MATCH ("Semi-Condensed"))
1506 PROP_SAVE (width
, "semi-condensed");
1507 else if (PROP_MATCH ("Condensed"))
1508 PROP_SAVE (width
, "condensed");
1509 /* An unknown word must be part of the font name. */
1520 ASET (font
, FONT_FAMILY_INDEX
,
1521 font_intern_prop (name
, family_end
- name
, 1));
1523 ASET (font
, FONT_SIZE_INDEX
, size
);
1525 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1527 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1529 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1535 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1536 NAME (NBYTES length), and return the name length. If
1537 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1540 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1542 Lisp_Object family
, foundry
;
1543 Lisp_Object tail
, val
;
1547 Lisp_Object styles
[3];
1548 const char *style_names
[3] = { "weight", "slant", "width" };
1551 family
= AREF (font
, FONT_FAMILY_INDEX
);
1552 if (! NILP (family
))
1554 if (SYMBOLP (family
))
1556 family
= SYMBOL_NAME (family
);
1557 len
+= SBYTES (family
);
1563 val
= AREF (font
, FONT_SIZE_INDEX
);
1566 if (XINT (val
) != 0)
1567 pixel_size
= XINT (val
);
1569 len
+= 21; /* for ":pixelsize=NUM" */
1576 point_size
= (int) XFLOAT_DATA (val
);
1577 len
+= 11; /* for "-NUM" */
1580 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1581 if (! NILP (foundry
))
1583 if (SYMBOLP (foundry
))
1585 foundry
= SYMBOL_NAME (foundry
);
1586 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1592 for (i
= 0; i
< 3; i
++)
1594 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1595 if (! NILP (styles
[i
]))
1596 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1597 SDATA (SYMBOL_NAME (styles
[i
])));
1600 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1601 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1602 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1603 len
+= strlen (":spacing=100");
1604 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1605 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1606 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1608 Lisp_Object key
= XCAR (XCAR (tail
)), value
= XCDR (XCAR (tail
));
1610 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1611 if (STRINGP (value
))
1612 len
+= SBYTES (value
);
1613 else if (INTEGERP (value
))
1614 len
+= sprintf (work
, "%ld", (long) XINT (value
));
1615 else if (SYMBOLP (value
))
1616 len
+= (NILP (value
) ? 5 : 4); /* for "false" or "true" */
1622 if (! NILP (family
))
1623 p
+= sprintf (p
, "%s", SDATA (family
));
1627 p
+= sprintf (p
, "%d", point_size
);
1629 p
+= sprintf (p
, "-%d", point_size
);
1631 else if (pixel_size
> 0)
1632 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1633 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1634 p
+= sprintf (p
, ":foundry=%s",
1635 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1636 for (i
= 0; i
< 3; i
++)
1637 if (! NILP (styles
[i
]))
1638 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1639 SDATA (SYMBOL_NAME (styles
[i
])));
1640 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1641 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1642 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1643 p
+= sprintf (p
, ":spacing=%ld",
1644 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1645 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1647 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1648 p
+= sprintf (p
, ":scalable=true");
1650 p
+= sprintf (p
, ":scalable=false");
1655 /* Parse NAME (null terminated) and store information in FONT
1656 (font-spec or font-entity). If NAME is successfully parsed, return
1657 0. Otherwise return -1. */
1660 font_parse_name (char *name
, Lisp_Object font
)
1662 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1663 return font_parse_xlfd (name
, font
);
1664 return font_parse_fcname (name
, font
);
1668 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1669 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1673 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1679 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1681 CHECK_STRING (family
);
1682 len
= SBYTES (family
);
1683 p0
= SSDATA (family
);
1684 p1
= strchr (p0
, '-');
1687 if ((*p0
!= '*' && p1
- p0
> 0)
1688 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1689 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1692 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1695 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1697 if (! NILP (registry
))
1699 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1700 CHECK_STRING (registry
);
1701 len
= SBYTES (registry
);
1702 p0
= SSDATA (registry
);
1703 p1
= strchr (p0
, '-');
1706 if (SDATA (registry
)[len
- 1] == '*')
1707 registry
= concat2 (registry
, build_string ("-*"));
1709 registry
= concat2 (registry
, build_string ("*-*"));
1711 registry
= Fdowncase (registry
);
1712 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1717 /* This part (through the next ^L) is still experimental and not
1718 tested much. We may drastically change codes. */
1724 #define LGSTRING_HEADER_SIZE 6
1725 #define LGSTRING_GLYPH_SIZE 8
1728 check_gstring (gstring
)
1729 Lisp_Object gstring
;
1734 CHECK_VECTOR (gstring
);
1735 val
= AREF (gstring
, 0);
1737 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1739 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1740 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1741 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1742 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1743 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1744 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1745 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1746 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1747 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1748 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1749 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1751 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1753 val
= LGSTRING_GLYPH (gstring
, i
);
1755 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1757 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1759 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1760 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1761 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1762 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1763 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1764 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1765 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1766 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1768 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1770 if (ASIZE (val
) < 3)
1772 for (j
= 0; j
< 3; j
++)
1773 CHECK_NUMBER (AREF (val
, j
));
1778 error ("Invalid glyph-string format");
1783 check_otf_features (otf_features
)
1784 Lisp_Object otf_features
;
1788 CHECK_CONS (otf_features
);
1789 CHECK_SYMBOL (XCAR (otf_features
));
1790 otf_features
= XCDR (otf_features
);
1791 CHECK_CONS (otf_features
);
1792 CHECK_SYMBOL (XCAR (otf_features
));
1793 otf_features
= XCDR (otf_features
);
1794 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1796 CHECK_SYMBOL (Fcar (val
));
1797 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1798 error ("Invalid OTF GSUB feature: %s",
1799 SDATA (SYMBOL_NAME (XCAR (val
))));
1801 otf_features
= XCDR (otf_features
);
1802 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1804 CHECK_SYMBOL (Fcar (val
));
1805 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1806 error ("Invalid OTF GPOS feature: %s",
1807 SDATA (SYMBOL_NAME (XCAR (val
))));
1814 Lisp_Object otf_list
;
1817 otf_tag_symbol (tag
)
1822 OTF_tag_name (tag
, name
);
1823 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1830 Lisp_Object val
= Fassoc (file
, otf_list
);
1834 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1837 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1838 val
= make_save_value (otf
, 0);
1839 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1845 /* Return a list describing which scripts/languages FONT supports by
1846 which GSUB/GPOS features of OpenType tables. See the comment of
1847 (struct font_driver).otf_capability. */
1850 font_otf_capability (font
)
1854 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1857 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1860 for (i
= 0; i
< 2; i
++)
1862 OTF_GSUB_GPOS
*gsub_gpos
;
1863 Lisp_Object script_list
= Qnil
;
1866 if (OTF_get_features (otf
, i
== 0) < 0)
1868 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1869 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1871 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1872 Lisp_Object langsys_list
= Qnil
;
1873 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1876 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1878 OTF_LangSys
*langsys
;
1879 Lisp_Object feature_list
= Qnil
;
1880 Lisp_Object langsys_tag
;
1883 if (k
== script
->LangSysCount
)
1885 langsys
= &script
->DefaultLangSys
;
1890 langsys
= script
->LangSys
+ k
;
1892 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1894 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1896 OTF_Feature
*feature
1897 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1898 Lisp_Object feature_tag
1899 = otf_tag_symbol (feature
->FeatureTag
);
1901 feature_list
= Fcons (feature_tag
, feature_list
);
1903 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1906 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1911 XSETCAR (capability
, script_list
);
1913 XSETCDR (capability
, script_list
);
1919 /* Parse OTF features in SPEC and write a proper features spec string
1920 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1921 assured that the sufficient memory has already allocated for
1925 generate_otf_features (spec
, features
)
1935 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1941 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1946 else if (! asterisk
)
1948 val
= SYMBOL_NAME (val
);
1949 p
+= sprintf (p
, "%s", SDATA (val
));
1953 val
= SYMBOL_NAME (val
);
1954 p
+= sprintf (p
, "~%s", SDATA (val
));
1958 error ("OTF spec too long");
1962 font_otf_DeviceTable (device_table
)
1963 OTF_DeviceTable
*device_table
;
1965 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1967 return Fcons (make_number (len
),
1968 make_unibyte_string (device_table
->DeltaValue
, len
));
1972 font_otf_ValueRecord (value_format
, value_record
)
1974 OTF_ValueRecord
*value_record
;
1976 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1978 if (value_format
& OTF_XPlacement
)
1979 ASET (val
, 0, make_number (value_record
->XPlacement
));
1980 if (value_format
& OTF_YPlacement
)
1981 ASET (val
, 1, make_number (value_record
->YPlacement
));
1982 if (value_format
& OTF_XAdvance
)
1983 ASET (val
, 2, make_number (value_record
->XAdvance
));
1984 if (value_format
& OTF_YAdvance
)
1985 ASET (val
, 3, make_number (value_record
->YAdvance
));
1986 if (value_format
& OTF_XPlaDevice
)
1987 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1988 if (value_format
& OTF_YPlaDevice
)
1989 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1990 if (value_format
& OTF_XAdvDevice
)
1991 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1992 if (value_format
& OTF_YAdvDevice
)
1993 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1998 font_otf_Anchor (anchor
)
2003 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2004 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2005 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2006 if (anchor
->AnchorFormat
== 2)
2007 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2010 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2011 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2015 #endif /* HAVE_LIBOTF */
2021 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2022 static int font_compare (const void *, const void *);
2023 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2027 font_rescale_ratio (Lisp_Object font_entity
)
2029 Lisp_Object tail
, elt
;
2030 Lisp_Object name
= Qnil
;
2032 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2035 if (FLOATP (XCDR (elt
)))
2037 if (STRINGP (XCAR (elt
)))
2040 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2041 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2042 return XFLOAT_DATA (XCDR (elt
));
2044 else if (FONT_SPEC_P (XCAR (elt
)))
2046 if (font_match_p (XCAR (elt
), font_entity
))
2047 return XFLOAT_DATA (XCDR (elt
));
2054 /* We sort fonts by scoring each of them against a specified
2055 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2056 the value is, the closer the font is to the font-spec.
2058 The lowest 2 bits of the score is used for driver type. The font
2059 available by the most preferred font driver is 0.
2061 Each 7-bit in the higher 28 bits are used for numeric properties
2062 WEIGHT, SLANT, WIDTH, and SIZE. */
2064 /* How many bits to shift to store the difference value of each font
2065 property in a score. Note that flots for FONT_TYPE_INDEX and
2066 FONT_REGISTRY_INDEX are not used. */
2067 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2069 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2070 The return value indicates how different ENTITY is compared with
2074 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2079 /* Score three style numeric fields. Maximum difference is 127. */
2080 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2081 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2083 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2084 - (XINT (spec_prop
[i
]) >> 8));
2087 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2090 /* Score the size. Maximum difference is 127. */
2091 i
= FONT_SIZE_INDEX
;
2092 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2093 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2095 /* We use the higher 6-bit for the actual size difference. The
2096 lowest bit is set if the DPI is different. */
2098 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2100 if (CONSP (Vface_font_rescale_alist
))
2101 pixel_size
*= font_rescale_ratio (entity
);
2102 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2106 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2107 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2109 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2110 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2112 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2119 /* Concatenate all elements of LIST into one vector. LIST is a list
2120 of font-entity vectors. */
2123 font_vconcat_entity_vectors (Lisp_Object list
)
2125 int nargs
= XINT (Flength (list
));
2126 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2129 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2130 args
[i
] = XCAR (list
);
2131 return Fvconcat (nargs
, args
);
2135 /* The structure for elements being sorted by qsort. */
2136 struct font_sort_data
2139 int font_driver_preference
;
2144 /* The comparison function for qsort. */
2147 font_compare (const void *d1
, const void *d2
)
2149 const struct font_sort_data
*data1
= d1
;
2150 const struct font_sort_data
*data2
= d2
;
2152 if (data1
->score
< data2
->score
)
2154 else if (data1
->score
> data2
->score
)
2156 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2160 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2161 If PREFER specifies a point-size, calculate the corresponding
2162 pixel-size from QCdpi property of PREFER or from the Y-resolution
2163 of FRAME before sorting.
2165 If BEST-ONLY is nonzero, return the best matching entity (that
2166 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2167 if BEST-ONLY is negative). Otherwise, return the sorted result as
2168 a single vector of font-entities.
2170 This function does no optimization for the case that the total
2171 number of elements is 1. The caller should avoid calling this in
2175 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2177 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2179 struct font_sort_data
*data
;
2180 unsigned best_score
;
2181 Lisp_Object best_entity
;
2182 struct frame
*f
= XFRAME (frame
);
2183 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2186 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2187 prefer_prop
[i
] = AREF (prefer
, i
);
2188 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2189 prefer_prop
[FONT_SIZE_INDEX
]
2190 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2192 if (NILP (XCDR (list
)))
2194 /* What we have to take care of is this single vector. */
2196 maxlen
= ASIZE (vec
);
2200 /* We don't have to perform sort, so there's no need of creating
2201 a single vector. But, we must find the length of the longest
2204 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2205 if (maxlen
< ASIZE (XCAR (tail
)))
2206 maxlen
= ASIZE (XCAR (tail
));
2210 /* We have to create a single vector to sort it. */
2211 vec
= font_vconcat_entity_vectors (list
);
2212 maxlen
= ASIZE (vec
);
2215 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2216 best_score
= 0xFFFFFFFF;
2219 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2221 int font_driver_preference
= 0;
2222 Lisp_Object current_font_driver
;
2228 /* We are sure that the length of VEC > 0. */
2229 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2230 /* Score the elements. */
2231 for (i
= 0; i
< len
; i
++)
2233 data
[i
].entity
= AREF (vec
, i
);
2235 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2237 ? font_score (data
[i
].entity
, prefer_prop
)
2239 if (best_only
&& best_score
> data
[i
].score
)
2241 best_score
= data
[i
].score
;
2242 best_entity
= data
[i
].entity
;
2243 if (best_score
== 0)
2246 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2248 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2249 font_driver_preference
++;
2251 data
[i
].font_driver_preference
= font_driver_preference
;
2254 /* Sort if necessary. */
2257 qsort (data
, len
, sizeof *data
, font_compare
);
2258 for (i
= 0; i
< len
; i
++)
2259 ASET (vec
, i
, data
[i
].entity
);
2268 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2273 /* API of Font Service Layer. */
2275 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2276 sort_shift_bits. Finternal_set_font_selection_order calls this
2277 function with font_sort_order after setting up it. */
2280 font_update_sort_order (int *order
)
2284 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2286 int xlfd_idx
= order
[i
];
2288 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2289 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2290 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2291 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2292 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2293 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2295 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2300 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2305 table
= assq_no_quit (script
, table
);
2308 table
= XCDR (table
);
2309 if (! NILP (langsys
))
2311 table
= assq_no_quit (langsys
, table
);
2317 val
= assq_no_quit (Qnil
, table
);
2319 table
= XCAR (table
);
2323 table
= XCDR (table
);
2324 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2326 if (NILP (XCAR (features
)))
2331 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2337 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2340 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2342 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2344 script
= XCAR (spec
);
2348 langsys
= XCAR (spec
);
2359 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2360 XCAR (otf_capability
)))
2362 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2363 XCDR (otf_capability
)))
2370 /* Check if FONT (font-entity or font-object) matches with the font
2371 specification SPEC. */
2374 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2376 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2377 Lisp_Object extra
, font_extra
;
2380 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2381 if (! NILP (AREF (spec
, i
))
2382 && ! NILP (AREF (font
, i
))
2383 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2385 props
= XFONT_SPEC (spec
)->props
;
2386 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2388 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2389 prop
[i
] = AREF (spec
, i
);
2390 prop
[FONT_SIZE_INDEX
]
2391 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2395 if (font_score (font
, props
) > 0)
2397 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2398 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2399 for (; CONSP (extra
); extra
= XCDR (extra
))
2401 Lisp_Object key
= XCAR (XCAR (extra
));
2402 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2404 if (EQ (key
, QClang
))
2406 val2
= assq_no_quit (key
, font_extra
);
2415 if (NILP (Fmemq (val
, val2
)))
2420 ? NILP (Fmemq (val
, XCDR (val2
)))
2424 else if (EQ (key
, QCscript
))
2426 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2432 /* All characters in the list must be supported. */
2433 for (; CONSP (val2
); val2
= XCDR (val2
))
2435 if (! NATNUMP (XCAR (val2
)))
2437 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2438 == FONT_INVALID_CODE
)
2442 else if (VECTORP (val2
))
2444 /* At most one character in the vector must be supported. */
2445 for (i
= 0; i
< ASIZE (val2
); i
++)
2447 if (! NATNUMP (AREF (val2
, i
)))
2449 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2450 != FONT_INVALID_CODE
)
2453 if (i
== ASIZE (val2
))
2458 else if (EQ (key
, QCotf
))
2462 if (! FONT_OBJECT_P (font
))
2464 fontp
= XFONT_OBJECT (font
);
2465 if (! fontp
->driver
->otf_capability
)
2467 val2
= fontp
->driver
->otf_capability (fontp
);
2468 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2479 Each font backend has the callback function get_cache, and it
2480 returns a cons cell of which cdr part can be freely used for
2481 caching fonts. The cons cell may be shared by multiple frames
2482 and/or multiple font drivers. So, we arrange the cdr part as this:
2484 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2486 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2487 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2488 cons (FONT-SPEC FONT-ENTITY ...). */
2490 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2491 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2492 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2493 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2494 struct font_driver
*);
2497 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2499 Lisp_Object cache
, val
;
2501 cache
= driver
->get_cache (f
);
2503 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2507 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2508 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2512 val
= XCDR (XCAR (val
));
2513 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2519 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2521 Lisp_Object cache
, val
, tmp
;
2524 cache
= driver
->get_cache (f
);
2526 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2527 cache
= val
, val
= XCDR (val
);
2528 font_assert (! NILP (val
));
2529 tmp
= XCDR (XCAR (val
));
2530 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2531 if (XINT (XCAR (tmp
)) == 0)
2533 font_clear_cache (f
, XCAR (val
), driver
);
2534 XSETCDR (cache
, XCDR (val
));
2540 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2542 Lisp_Object val
= driver
->get_cache (f
);
2543 Lisp_Object type
= driver
->type
;
2545 font_assert (CONSP (val
));
2546 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2547 font_assert (CONSP (val
));
2548 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2549 val
= XCDR (XCAR (val
));
2553 static int num_fonts
;
2556 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2558 Lisp_Object tail
, elt
;
2559 Lisp_Object tail2
, entity
;
2561 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2562 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2565 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2566 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2568 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2570 entity
= XCAR (tail2
);
2572 if (FONT_ENTITY_P (entity
)
2573 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2575 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2577 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2579 Lisp_Object val
= XCAR (objlist
);
2580 struct font
*font
= XFONT_OBJECT (val
);
2582 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2584 font_assert (font
&& driver
== font
->driver
);
2585 driver
->close (f
, font
);
2589 if (driver
->free_entity
)
2590 driver
->free_entity (entity
);
2595 XSETCDR (cache
, Qnil
);
2599 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2601 /* Check each font-entity in VEC, and return a list of font-entities
2602 that satisfy this condition:
2603 (1) matches with SPEC and SIZE if SPEC is not nil, and
2604 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2608 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2610 Lisp_Object entity
, val
;
2611 enum font_property_index prop
;
2614 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2616 entity
= AREF (vec
, i
);
2617 if (! NILP (Vface_ignored_fonts
))
2620 Lisp_Object tail
, regexp
;
2622 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2624 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2626 regexp
= XCAR (tail
);
2627 if (STRINGP (regexp
)
2628 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2637 val
= Fcons (entity
, val
);
2640 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2641 if (INTEGERP (AREF (spec
, prop
))
2642 && ((XINT (AREF (spec
, prop
)) >> 8)
2643 != (XINT (AREF (entity
, prop
)) >> 8)))
2644 prop
= FONT_SPEC_MAX
;
2645 if (prop
< FONT_SPEC_MAX
2647 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2649 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2652 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2653 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2654 prop
= FONT_SPEC_MAX
;
2656 if (prop
< FONT_SPEC_MAX
2657 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2658 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2659 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2660 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2661 prop
= FONT_SPEC_MAX
;
2662 if (prop
< FONT_SPEC_MAX
2663 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2664 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2665 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2666 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2667 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2668 prop
= FONT_SPEC_MAX
;
2669 if (prop
< FONT_SPEC_MAX
)
2670 val
= Fcons (entity
, val
);
2672 return (Fvconcat (1, &val
));
2676 /* Return a list of vectors of font-entities matching with SPEC on
2677 FRAME. Each elements in the list is a vector of entities from the
2678 same font-driver. */
2681 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2683 FRAME_PTR f
= XFRAME (frame
);
2684 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2685 Lisp_Object ftype
, val
;
2686 Lisp_Object list
= Qnil
;
2688 int need_filtering
= 0;
2691 font_assert (FONT_SPEC_P (spec
));
2693 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2694 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2695 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2696 size
= font_pixel_size (f
, spec
);
2700 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2701 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2702 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2703 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2704 if (i
!= FONT_SPACING_INDEX
)
2706 ASET (scratch_font_spec
, i
, Qnil
);
2707 if (! NILP (AREF (spec
, i
)))
2710 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2711 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2713 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2715 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2717 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2719 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2720 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2727 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2731 val
= Fvconcat (1, &val
);
2732 copy
= copy_font_spec (scratch_font_spec
);
2733 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2734 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2738 || ! NILP (Vface_ignored_fonts
)))
2739 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2740 if (ASIZE (val
) > 0)
2741 list
= Fcons (val
, list
);
2744 list
= Fnreverse (list
);
2745 FONT_ADD_LOG ("list", spec
, list
);
2750 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2751 nil, is an array of face's attributes, which specifies preferred
2752 font-related attributes. */
2755 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2757 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2758 Lisp_Object ftype
, size
, entity
;
2760 Lisp_Object work
= copy_font_spec (spec
);
2762 XSETFRAME (frame
, f
);
2763 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2764 size
= AREF (spec
, FONT_SIZE_INDEX
);
2767 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2768 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2769 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2770 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2773 for (; driver_list
; driver_list
= driver_list
->next
)
2775 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2777 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2780 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2781 entity
= assoc_no_quit (work
, XCDR (cache
));
2783 entity
= XCDR (entity
);
2786 entity
= driver_list
->driver
->match (frame
, work
);
2787 copy
= copy_font_spec (work
);
2788 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2789 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2791 if (! NILP (entity
))
2794 FONT_ADD_LOG ("match", work
, entity
);
2799 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2800 opened font object. */
2803 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2805 struct font_driver_list
*driver_list
;
2806 Lisp_Object objlist
, size
, val
, font_object
;
2808 int min_width
, height
;
2809 int scaled_pixel_size
= pixel_size
;
2811 font_assert (FONT_ENTITY_P (entity
));
2812 size
= AREF (entity
, FONT_SIZE_INDEX
);
2813 if (XINT (size
) != 0)
2814 scaled_pixel_size
= pixel_size
= XINT (size
);
2815 else if (CONSP (Vface_font_rescale_alist
))
2816 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2818 val
= AREF (entity
, FONT_TYPE_INDEX
);
2819 for (driver_list
= f
->font_driver_list
;
2820 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2821 driver_list
= driver_list
->next
);
2825 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2826 objlist
= XCDR (objlist
))
2828 Lisp_Object fn
= XCAR (objlist
);
2829 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2830 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2832 if (driver_list
->driver
->cached_font_ok
== NULL
2833 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2838 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2839 if (!NILP (font_object
))
2840 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2841 FONT_ADD_LOG ("open", entity
, font_object
);
2842 if (NILP (font_object
))
2844 ASET (entity
, FONT_OBJLIST_INDEX
,
2845 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2848 font
= XFONT_OBJECT (font_object
);
2849 min_width
= (font
->min_width
? font
->min_width
2850 : font
->average_width
? font
->average_width
2851 : font
->space_width
? font
->space_width
2853 height
= (font
->height
? font
->height
: 1);
2854 #ifdef HAVE_WINDOW_SYSTEM
2855 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2856 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2858 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2859 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2860 fonts_changed_p
= 1;
2864 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2865 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2866 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2867 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2875 /* Close FONT_OBJECT that is opened on frame F. */
2878 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2880 struct font
*font
= XFONT_OBJECT (font_object
);
2882 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2883 /* Already closed. */
2885 FONT_ADD_LOG ("close", font_object
, Qnil
);
2886 font
->driver
->close (f
, font
);
2887 #ifdef HAVE_WINDOW_SYSTEM
2888 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2889 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2895 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2896 FONT is a font-entity and it must be opened to check. */
2899 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2903 if (FONT_ENTITY_P (font
))
2905 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2906 struct font_driver_list
*driver_list
;
2908 for (driver_list
= f
->font_driver_list
;
2909 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2910 driver_list
= driver_list
->next
);
2913 if (! driver_list
->driver
->has_char
)
2915 return driver_list
->driver
->has_char (font
, c
);
2918 font_assert (FONT_OBJECT_P (font
));
2919 fontp
= XFONT_OBJECT (font
);
2920 if (fontp
->driver
->has_char
)
2922 int result
= fontp
->driver
->has_char (font
, c
);
2927 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2931 /* Return the glyph ID of FONT_OBJECT for character C. */
2934 font_encode_char (Lisp_Object font_object
, int c
)
2938 font_assert (FONT_OBJECT_P (font_object
));
2939 font
= XFONT_OBJECT (font_object
);
2940 return font
->driver
->encode_char (font
, c
);
2944 /* Return the name of FONT_OBJECT. */
2947 font_get_name (Lisp_Object font_object
)
2949 font_assert (FONT_OBJECT_P (font_object
));
2950 return AREF (font_object
, FONT_NAME_INDEX
);
2954 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2955 could not be parsed by font_parse_name, return Qnil. */
2958 font_spec_from_name (Lisp_Object font_name
)
2960 Lisp_Object spec
= Ffont_spec (0, NULL
);
2962 CHECK_STRING (font_name
);
2963 if (font_parse_name (SSDATA (font_name
), spec
) == -1)
2965 font_put_extra (spec
, QCname
, font_name
);
2966 font_put_extra (spec
, QCuser_spec
, font_name
);
2972 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2974 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2979 if (! NILP (Ffont_get (font
, QCname
)))
2981 font
= copy_font_spec (font
);
2982 font_put_extra (font
, QCname
, Qnil
);
2985 if (NILP (AREF (font
, prop
))
2986 && prop
!= FONT_FAMILY_INDEX
2987 && prop
!= FONT_FOUNDRY_INDEX
2988 && prop
!= FONT_WIDTH_INDEX
2989 && prop
!= FONT_SIZE_INDEX
)
2991 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
2992 font
= copy_font_spec (font
);
2993 ASET (font
, prop
, Qnil
);
2994 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2996 if (prop
== FONT_FAMILY_INDEX
)
2998 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2999 /* If we are setting the font family, we must also clear
3000 FONT_WIDTH_INDEX to avoid rejecting families that lack
3001 support for some widths. */
3002 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3004 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3005 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3006 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3007 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3008 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3009 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3011 else if (prop
== FONT_SIZE_INDEX
)
3013 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3014 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3015 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3017 else if (prop
== FONT_WIDTH_INDEX
)
3018 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3019 attrs
[LFACE_FONT_INDEX
] = font
;
3022 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3023 supports C and matches best with ATTRS and PIXEL_SIZE. */
3026 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3028 Lisp_Object font_entity
;
3031 FRAME_PTR f
= XFRAME (frame
);
3033 if (NILP (XCDR (entities
))
3034 && ASIZE (XCAR (entities
)) == 1)
3036 font_entity
= AREF (XCAR (entities
), 0);
3038 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3043 /* Sort fonts by properties specified in ATTRS. */
3044 prefer
= scratch_font_prefer
;
3046 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3047 ASET (prefer
, i
, Qnil
);
3048 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3050 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3052 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3053 ASET (prefer
, i
, AREF (face_font
, i
));
3055 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3056 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3057 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3058 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3059 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3060 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3061 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3063 return font_sort_entities (entities
, prefer
, frame
, c
);
3066 /* Return a font-entity satisfying SPEC and best matching with face's
3067 font related attributes in ATTRS. C, if not negative, is a
3068 character that the entity must support. */
3071 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3074 Lisp_Object frame
, entities
, val
;
3075 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3079 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3080 if (NILP (registry
[0]))
3082 registry
[0] = DEFAULT_ENCODING
;
3083 registry
[1] = Qascii_0
;
3084 registry
[2] = null_vector
;
3087 registry
[1] = null_vector
;
3089 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3091 struct charset
*encoding
, *repertory
;
3093 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3094 &encoding
, &repertory
) < 0)
3097 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3099 else if (c
> encoding
->max_char
)
3103 work
= copy_font_spec (spec
);
3104 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3105 XSETFRAME (frame
, f
);
3106 pixel_size
= font_pixel_size (f
, spec
);
3107 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3109 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3111 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3113 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3114 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3115 if (! NILP (foundry
[0]))
3116 foundry
[1] = null_vector
;
3117 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3119 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3120 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3122 foundry
[2] = null_vector
;
3125 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3127 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3128 if (! NILP (adstyle
[0]))
3129 adstyle
[1] = null_vector
;
3130 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3132 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3134 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3136 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3138 adstyle
[2] = null_vector
;
3141 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3144 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3147 val
= AREF (work
, FONT_FAMILY_INDEX
);
3148 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3150 val
= attrs
[LFACE_FAMILY_INDEX
];
3151 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3155 family
= alloca ((sizeof family
[0]) * 2);
3157 family
[1] = null_vector
; /* terminator. */
3162 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3163 /* Font family names are case-sensitive under NS. */
3171 if (! NILP (alters
))
3173 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3174 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3175 family
[i
] = XCAR (alters
);
3176 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3178 family
[i
] = null_vector
;
3182 family
= alloca ((sizeof family
[0]) * 3);
3185 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3187 family
[i
] = null_vector
;
3191 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3193 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3194 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3196 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3197 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3199 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3200 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3202 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3203 entities
= font_list_entities (frame
, work
);
3204 if (! NILP (entities
))
3206 val
= font_select_entity (frame
, entities
,
3207 attrs
, pixel_size
, c
);
3220 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3224 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3225 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3226 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3227 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3228 size
= font_pixel_size (f
, spec
);
3232 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3233 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3236 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3237 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3238 if (INTEGERP (height
))
3241 abort(); /* We should never end up here. */
3245 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3249 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3250 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3254 return font_open_entity (f
, entity
, size
);
3258 /* Find a font satisfying SPEC and best matching with face's
3259 attributes in ATTRS on FRAME, and return the opened
3263 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3265 Lisp_Object entity
, name
;
3267 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3270 /* No font is listed for SPEC, but each font-backend may have
3271 the different criteria about "font matching". So, try
3273 entity
= font_matching_entity (f
, attrs
, spec
);
3277 /* Don't lose the original name that was put in initially. We need
3278 it to re-apply the font when font parameters (like hinting or dpi) have
3280 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3283 name
= Ffont_get (spec
, QCuser_spec
);
3284 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3290 /* Make FACE on frame F ready to use the font opened for FACE. */
3293 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3295 if (face
->font
->driver
->prepare_face
)
3296 face
->font
->driver
->prepare_face (f
, face
);
3300 /* Make FACE on frame F stop using the font opened for FACE. */
3303 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3305 if (face
->font
->driver
->done_face
)
3306 face
->font
->driver
->done_face (f
, face
);
3311 /* Open a font matching with font-spec SPEC on frame F. If no proper
3312 font is found, return Qnil. */
3315 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3317 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3319 /* We set up the default font-related attributes of a face to prefer
3321 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3322 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3323 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3325 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3327 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3329 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3331 return font_load_for_lface (f
, attrs
, spec
);
3335 /* Open a font matching with NAME on frame F. If no proper font is
3336 found, return Qnil. */
3339 font_open_by_name (FRAME_PTR f
, const char *name
)
3341 Lisp_Object args
[2];
3342 Lisp_Object spec
, ret
;
3345 args
[1] = make_unibyte_string (name
, strlen (name
));
3346 spec
= Ffont_spec (2, args
);
3347 ret
= font_open_by_spec (f
, spec
);
3348 /* Do not lose name originally put in. */
3350 font_put_extra (ret
, QCuser_spec
, args
[1]);
3356 /* Register font-driver DRIVER. This function is used in two ways.
3358 The first is with frame F non-NULL. In this case, make DRIVER
3359 available (but not yet activated) on F. All frame creaters
3360 (e.g. Fx_create_frame) must call this function at least once with
3361 an available font-driver.
3363 The second is with frame F NULL. In this case, DRIVER is globally
3364 registered in the variable `font_driver_list'. All font-driver
3365 implementations must call this function in its syms_of_XXXX
3366 (e.g. syms_of_xfont). */
3369 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3371 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3372 struct font_driver_list
*prev
, *list
;
3374 if (f
&& ! driver
->draw
)
3375 error ("Unusable font driver for a frame: %s",
3376 SDATA (SYMBOL_NAME (driver
->type
)));
3378 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3379 if (EQ (list
->driver
->type
, driver
->type
))
3380 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3382 list
= xmalloc (sizeof (struct font_driver_list
));
3384 list
->driver
= driver
;
3389 f
->font_driver_list
= list
;
3391 font_driver_list
= list
;
3397 free_font_driver_list (FRAME_PTR f
)
3399 struct font_driver_list
*list
, *next
;
3401 for (list
= f
->font_driver_list
; list
; list
= next
)
3406 f
->font_driver_list
= NULL
;
3410 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3411 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3412 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3414 A caller must free all realized faces if any in advance. The
3415 return value is a list of font backends actually made used on
3419 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3421 Lisp_Object active_drivers
= Qnil
;
3422 struct font_driver_list
*list
;
3424 /* At first, turn off non-requested drivers, and turn on requested
3426 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3428 struct font_driver
*driver
= list
->driver
;
3429 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3434 if (driver
->end_for_frame
)
3435 driver
->end_for_frame (f
);
3436 font_finish_cache (f
, driver
);
3441 if (! driver
->start_for_frame
3442 || driver
->start_for_frame (f
) == 0)
3444 font_prepare_cache (f
, driver
);
3451 if (NILP (new_drivers
))
3454 if (! EQ (new_drivers
, Qt
))
3456 /* Re-order the driver list according to new_drivers. */
3457 struct font_driver_list
**list_table
, **next
;
3461 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3462 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3464 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3465 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3468 list_table
[i
++] = list
;
3470 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3472 list_table
[i
++] = list
;
3473 list_table
[i
] = NULL
;
3475 next
= &f
->font_driver_list
;
3476 for (i
= 0; list_table
[i
]; i
++)
3478 *next
= list_table
[i
];
3479 next
= &(*next
)->next
;
3483 if (! f
->font_driver_list
->on
)
3484 { /* None of the drivers is enabled: enable them all.
3485 Happens if you set the list of drivers to (xft x) in your .emacs
3486 and then use it under w32 or ns. */
3487 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3489 struct font_driver
*driver
= list
->driver
;
3490 eassert (! list
->on
);
3491 if (! driver
->start_for_frame
3492 || driver
->start_for_frame (f
) == 0)
3494 font_prepare_cache (f
, driver
);
3501 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3503 active_drivers
= nconc2 (active_drivers
,
3504 Fcons (list
->driver
->type
, Qnil
));
3505 return active_drivers
;
3509 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3511 struct font_data_list
*list
, *prev
;
3513 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3514 prev
= list
, list
= list
->next
)
3515 if (list
->driver
== driver
)
3522 prev
->next
= list
->next
;
3524 f
->font_data_list
= list
->next
;
3532 list
= xmalloc (sizeof (struct font_data_list
));
3533 list
->driver
= driver
;
3534 list
->next
= f
->font_data_list
;
3535 f
->font_data_list
= list
;
3543 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3545 struct font_data_list
*list
;
3547 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3548 if (list
->driver
== driver
)
3556 /* Sets attributes on a font. Any properties that appear in ALIST and
3557 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3558 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3559 arrays of strings. This function is intended for use by the font
3560 drivers to implement their specific font_filter_properties. */
3562 font_filter_properties (Lisp_Object font
,
3564 const char *const boolean_properties
[],
3565 const char *const non_boolean_properties
[])
3570 /* Set boolean values to Qt or Qnil */
3571 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3572 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3574 Lisp_Object key
= XCAR (XCAR (it
));
3575 Lisp_Object val
= XCDR (XCAR (it
));
3576 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3578 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3580 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3581 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3584 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3585 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3586 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3587 || strcmp ("Off", str
) == 0)
3592 Ffont_put (font
, key
, val
);
3596 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3597 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3599 Lisp_Object key
= XCAR (XCAR (it
));
3600 Lisp_Object val
= XCDR (XCAR (it
));
3601 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3602 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3603 Ffont_put (font
, key
, val
);
3608 /* Return the font used to draw character C by FACE at buffer position
3609 POS in window W. If STRING is non-nil, it is a string containing C
3610 at index POS. If C is negative, get C from the current buffer or
3614 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3619 Lisp_Object font_object
;
3621 multibyte
= (NILP (string
)
3622 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3623 : STRING_MULTIBYTE (string
));
3630 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3632 c
= FETCH_CHAR (pos_byte
);
3635 c
= FETCH_BYTE (pos
);
3641 multibyte
= STRING_MULTIBYTE (string
);
3644 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3646 str
= SDATA (string
) + pos_byte
;
3647 c
= STRING_CHAR (str
);
3650 c
= SDATA (string
)[pos
];
3654 f
= XFRAME (w
->frame
);
3655 if (! FRAME_WINDOW_P (f
))
3662 if (STRINGP (string
))
3663 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3664 DEFAULT_FACE_ID
, 0);
3666 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3668 face
= FACE_FROM_ID (f
, face_id
);
3672 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3673 face
= FACE_FROM_ID (f
, face_id
);
3678 XSETFONT (font_object
, face
->font
);
3683 #ifdef HAVE_WINDOW_SYSTEM
3685 /* Check how many characters after POS (at most to *LIMIT) can be
3686 displayed by the same font on the window W. FACE, if non-NULL, is
3687 the face selected for the character at POS. If STRING is not nil,
3688 it is the string to check instead of the current buffer. In that
3689 case, FACE must be not NULL.
3691 The return value is the font-object for the character at POS.
3692 *LIMIT is set to the position where that font can't be used.
3694 It is assured that the current buffer (or STRING) is multibyte. */
3697 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3699 EMACS_INT pos_byte
, ignore
;
3701 Lisp_Object font_object
= Qnil
;
3705 pos_byte
= CHAR_TO_BYTE (pos
);
3710 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3712 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3718 pos_byte
= string_char_to_byte (string
, pos
);
3721 while (pos
< *limit
)
3723 Lisp_Object category
;
3726 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3728 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3729 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3730 if (EQ (category
, QCf
)
3731 || CHAR_VARIATION_SELECTOR_P (c
))
3733 if (NILP (font_object
))
3735 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3736 if (NILP (font_object
))
3740 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3750 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3751 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3752 Return nil otherwise.
3753 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3754 which kind of font it is. It must be one of `font-spec', `font-entity',
3756 (Lisp_Object object
, Lisp_Object extra_type
)
3758 if (NILP (extra_type
))
3759 return (FONTP (object
) ? Qt
: Qnil
);
3760 if (EQ (extra_type
, Qfont_spec
))
3761 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3762 if (EQ (extra_type
, Qfont_entity
))
3763 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3764 if (EQ (extra_type
, Qfont_object
))
3765 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3766 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3769 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3770 doc
: /* Return a newly created font-spec with arguments as properties.
3772 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3773 valid font property name listed below:
3775 `:family', `:weight', `:slant', `:width'
3777 They are the same as face attributes of the same name. See
3778 `set-face-attribute'.
3782 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3786 VALUE must be a string or a symbol specifying the additional
3787 typographic style information of a font, e.g. ``sans''.
3791 VALUE must be a string or a symbol specifying the charset registry and
3792 encoding of a font, e.g. ``iso8859-1''.
3796 VALUE must be a non-negative integer or a floating point number
3797 specifying the font size. It specifies the font size in pixels (if
3798 VALUE is an integer), or in points (if VALUE is a float).
3802 VALUE must be a string of XLFD-style or fontconfig-style font name.
3806 VALUE must be a symbol representing a script that the font must
3807 support. It may be a symbol representing a subgroup of a script
3808 listed in the variable `script-representative-chars'.
3812 VALUE must be a symbol of two-letter ISO-639 language names,
3817 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3818 required OpenType features.
3820 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3821 LANGSYS-TAG: OpenType language system tag symbol,
3822 or nil for the default language system.
3823 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3824 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3826 GSUB and GPOS may contain `nil' element. In such a case, the font
3827 must not have any of the remaining elements.
3829 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3830 be an OpenType font, and whose GPOS table of `thai' script's default
3831 language system must contain `mark' feature.
3833 usage: (font-spec ARGS...) */)
3834 (size_t nargs
, Lisp_Object
*args
)
3836 Lisp_Object spec
= font_make_spec ();
3839 for (i
= 0; i
< nargs
; i
+= 2)
3841 Lisp_Object key
= args
[i
], val
;
3845 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3848 if (EQ (key
, QCname
))
3851 font_parse_name (SSDATA (val
), spec
);
3852 font_put_extra (spec
, key
, val
);
3856 int idx
= get_font_prop_index (key
);
3860 val
= font_prop_validate (idx
, Qnil
, val
);
3861 if (idx
< FONT_EXTRA_INDEX
)
3862 ASET (spec
, idx
, val
);
3864 font_put_extra (spec
, key
, val
);
3867 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3873 /* Return a copy of FONT as a font-spec. */
3875 copy_font_spec (Lisp_Object font
)
3877 Lisp_Object new_spec
, tail
, prev
, extra
;
3881 new_spec
= font_make_spec ();
3882 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3883 ASET (new_spec
, i
, AREF (font
, i
));
3884 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3885 /* We must remove :font-entity property. */
3886 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3887 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3890 extra
= XCDR (extra
);
3892 XSETCDR (prev
, XCDR (tail
));
3895 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3899 /* Merge font-specs FROM and TO, and return a new font-spec.
3900 Every specified property in FROM overrides the corresponding
3903 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3905 Lisp_Object extra
, tail
;
3910 to
= copy_font_spec (to
);
3911 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3912 ASET (to
, i
, AREF (from
, i
));
3913 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3914 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3915 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3917 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3920 XSETCDR (slot
, XCDR (XCAR (tail
)));
3922 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3924 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3928 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3929 doc
: /* Return the value of FONT's property KEY.
3930 FONT is a font-spec, a font-entity, or a font-object.
3931 KEY is any symbol, but these are reserved for specific meanings:
3932 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3933 :size, :name, :script, :otf
3934 See the documentation of `font-spec' for their meanings.
3935 In addition, if FONT is a font-entity or a font-object, values of
3936 :script and :otf are different from those of a font-spec as below:
3938 The value of :script may be a list of scripts that are supported by the font.
3940 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3941 representing the OpenType features supported by the font by this form:
3942 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3943 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3945 (Lisp_Object font
, Lisp_Object key
)
3953 idx
= get_font_prop_index (key
);
3954 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3955 return font_style_symbolic (font
, idx
, 0);
3956 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3957 return AREF (font
, idx
);
3958 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3959 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3961 struct font
*fontp
= XFONT_OBJECT (font
);
3963 if (fontp
->driver
->otf_capability
)
3964 val
= fontp
->driver
->otf_capability (fontp
);
3966 val
= Fcons (Qnil
, Qnil
);
3973 #ifdef HAVE_WINDOW_SYSTEM
3975 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3976 doc
: /* Return a plist of face attributes generated by FONT.
3977 FONT is a font name, a font-spec, a font-entity, or a font-object.
3978 The return value is a list of the form
3980 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3982 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3983 compatible with `set-face-attribute'. Some of these key-attribute pairs
3984 may be omitted from the list if they are not specified by FONT.
3986 The optional argument FRAME specifies the frame that the face attributes
3987 are to be displayed on. If omitted, the selected frame is used. */)
3988 (Lisp_Object font
, Lisp_Object frame
)
3991 Lisp_Object plist
[10];
3996 frame
= selected_frame
;
3997 CHECK_LIVE_FRAME (frame
);
4002 int fontset
= fs_query_fontset (font
, 0);
4003 Lisp_Object name
= font
;
4005 font
= fontset_ascii (fontset
);
4006 font
= font_spec_from_name (name
);
4008 signal_error ("Invalid font name", name
);
4010 else if (! FONTP (font
))
4011 signal_error ("Invalid font object", font
);
4013 val
= AREF (font
, FONT_FAMILY_INDEX
);
4016 plist
[n
++] = QCfamily
;
4017 plist
[n
++] = SYMBOL_NAME (val
);
4020 val
= AREF (font
, FONT_SIZE_INDEX
);
4023 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4024 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4025 plist
[n
++] = QCheight
;
4026 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4028 else if (FLOATP (val
))
4030 plist
[n
++] = QCheight
;
4031 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4034 val
= FONT_WEIGHT_FOR_FACE (font
);
4037 plist
[n
++] = QCweight
;
4041 val
= FONT_SLANT_FOR_FACE (font
);
4044 plist
[n
++] = QCslant
;
4048 val
= FONT_WIDTH_FOR_FACE (font
);
4051 plist
[n
++] = QCwidth
;
4055 return Flist (n
, plist
);
4060 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4061 doc
: /* Set one property of FONT: give property KEY value VAL.
4062 FONT is a font-spec, a font-entity, or a font-object.
4064 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4065 accepted by the function `font-spec' (which see), VAL must be what
4066 allowed in `font-spec'.
4068 If FONT is a font-entity or a font-object, KEY must not be the one
4069 accepted by `font-spec'. */)
4070 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4074 idx
= get_font_prop_index (prop
);
4075 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4077 CHECK_FONT_SPEC (font
);
4078 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4082 if (EQ (prop
, QCname
)
4083 || EQ (prop
, QCscript
)
4084 || EQ (prop
, QClang
)
4085 || EQ (prop
, QCotf
))
4086 CHECK_FONT_SPEC (font
);
4089 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4094 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4095 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4096 Optional 2nd argument FRAME specifies the target frame.
4097 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4098 Optional 4th argument PREFER, if non-nil, is a font-spec to
4099 control the order of the returned list. Fonts are sorted by
4100 how close they are to PREFER. */)
4101 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4103 Lisp_Object vec
, list
;
4107 frame
= selected_frame
;
4108 CHECK_LIVE_FRAME (frame
);
4109 CHECK_FONT_SPEC (font_spec
);
4117 if (! NILP (prefer
))
4118 CHECK_FONT_SPEC (prefer
);
4120 list
= font_list_entities (frame
, font_spec
);
4123 if (NILP (XCDR (list
))
4124 && ASIZE (XCAR (list
)) == 1)
4125 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4127 if (! NILP (prefer
))
4128 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4130 vec
= font_vconcat_entity_vectors (list
);
4131 if (n
== 0 || n
>= ASIZE (vec
))
4133 Lisp_Object args
[2];
4137 list
= Fappend (2, args
);
4141 for (list
= Qnil
, n
--; n
>= 0; n
--)
4142 list
= Fcons (AREF (vec
, n
), list
);
4147 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4148 doc
: /* List available font families on the current frame.
4149 Optional argument FRAME, if non-nil, specifies the target frame. */)
4153 struct font_driver_list
*driver_list
;
4157 frame
= selected_frame
;
4158 CHECK_LIVE_FRAME (frame
);
4161 for (driver_list
= f
->font_driver_list
; driver_list
;
4162 driver_list
= driver_list
->next
)
4163 if (driver_list
->driver
->list_family
)
4165 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4166 Lisp_Object tail
= list
;
4168 for (; CONSP (val
); val
= XCDR (val
))
4169 if (NILP (Fmemq (XCAR (val
), tail
))
4170 && SYMBOLP (XCAR (val
)))
4171 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4176 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4177 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4178 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4179 (Lisp_Object font_spec
, Lisp_Object frame
)
4181 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4188 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4189 doc
: /* Return XLFD name of FONT.
4190 FONT is a font-spec, font-entity, or font-object.
4191 If the name is too long for XLFD (maximum 255 chars), return nil.
4192 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4193 the consecutive wildcards are folded to one. */)
4194 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4201 if (FONT_OBJECT_P (font
))
4203 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4205 if (STRINGP (font_name
)
4206 && SDATA (font_name
)[0] == '-')
4208 if (NILP (fold_wildcards
))
4210 strcpy (name
, SSDATA (font_name
));
4213 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4215 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4218 if (! NILP (fold_wildcards
))
4220 char *p0
= name
, *p1
;
4222 while ((p1
= strstr (p0
, "-*-*")))
4224 strcpy (p1
, p1
+ 2);
4229 return build_string (name
);
4232 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4233 doc
: /* Clear font cache. */)
4236 Lisp_Object list
, frame
;
4238 FOR_EACH_FRAME (list
, frame
)
4240 FRAME_PTR f
= XFRAME (frame
);
4241 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4243 for (; driver_list
; driver_list
= driver_list
->next
)
4244 if (driver_list
->on
)
4246 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4247 Lisp_Object val
, tmp
;
4251 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4253 font_assert (! NILP (val
));
4254 tmp
= XCDR (XCAR (val
));
4255 if (XINT (XCAR (tmp
)) == 0)
4257 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4258 XSETCDR (cache
, XCDR (val
));
4268 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4270 struct font
*font
= XFONT_OBJECT (font_object
);
4272 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4273 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4274 struct font_metrics metrics
;
4276 LGLYPH_SET_CODE (glyph
, ecode
);
4278 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4279 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4280 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4281 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4282 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4283 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4287 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4288 doc
: /* Shape the glyph-string GSTRING.
4289 Shaping means substituting glyphs and/or adjusting positions of glyphs
4290 to get the correct visual image of character sequences set in the
4291 header of the glyph-string.
4293 If the shaping was successful, the value is GSTRING itself or a newly
4294 created glyph-string. Otherwise, the value is nil. */)
4295 (Lisp_Object gstring
)
4298 Lisp_Object font_object
, n
, glyph
;
4301 if (! composition_gstring_p (gstring
))
4302 signal_error ("Invalid glyph-string: ", gstring
);
4303 if (! NILP (LGSTRING_ID (gstring
)))
4305 font_object
= LGSTRING_FONT (gstring
);
4306 CHECK_FONT_OBJECT (font_object
);
4307 font
= XFONT_OBJECT (font_object
);
4308 if (! font
->driver
->shape
)
4311 /* Try at most three times with larger gstring each time. */
4312 for (i
= 0; i
< 3; i
++)
4314 n
= font
->driver
->shape (gstring
);
4317 gstring
= larger_vector (gstring
,
4318 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4321 if (i
== 3 || XINT (n
) == 0)
4323 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4324 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4326 glyph
= LGSTRING_GLYPH (gstring
, 0);
4327 from
= LGLYPH_FROM (glyph
);
4328 to
= LGLYPH_TO (glyph
);
4329 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4331 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4335 if (NILP (LGLYPH_ADJUSTMENT (this)))
4340 glyph
= LGSTRING_GLYPH (gstring
, j
);
4341 LGLYPH_SET_FROM (glyph
, from
);
4342 LGLYPH_SET_TO (glyph
, to
);
4344 from
= LGLYPH_FROM (this);
4345 to
= LGLYPH_TO (this);
4350 if (from
> LGLYPH_FROM (this))
4351 from
= LGLYPH_FROM (this);
4352 if (to
< LGLYPH_TO (this))
4353 to
= LGLYPH_TO (this);
4359 glyph
= LGSTRING_GLYPH (gstring
, j
);
4360 LGLYPH_SET_FROM (glyph
, from
);
4361 LGLYPH_SET_TO (glyph
, to
);
4363 return composition_gstring_put_cache (gstring
, XINT (n
));
4366 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4368 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4369 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4371 VARIATION-SELECTOR is a character code of variation selection
4372 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4373 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4374 (Lisp_Object font_object
, Lisp_Object character
)
4376 unsigned variations
[256];
4381 CHECK_FONT_OBJECT (font_object
);
4382 CHECK_CHARACTER (character
);
4383 font
= XFONT_OBJECT (font_object
);
4384 if (! font
->driver
->get_variation_glyphs
)
4386 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4390 for (i
= 0; i
< 255; i
++)
4394 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4395 /* Stops GCC whining about limited range of data type. */
4396 EMACS_INT var
= variations
[i
];
4398 if (var
> MOST_POSITIVE_FIXNUM
)
4399 code
= Fcons (make_number ((variations
[i
]) >> 16),
4400 make_number ((variations
[i
]) & 0xFFFF));
4402 code
= make_number (variations
[i
]);
4403 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4410 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4411 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4412 OTF-FEATURES specifies which features to apply in this format:
4413 (SCRIPT LANGSYS GSUB GPOS)
4415 SCRIPT is a symbol specifying a script tag of OpenType,
4416 LANGSYS is a symbol specifying a langsys tag of OpenType,
4417 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4419 If LANGYS is nil, the default langsys is selected.
4421 The features are applied in the order they appear in the list. The
4422 symbol `*' means to apply all available features not present in this
4423 list, and the remaining features are ignored. For instance, (vatu
4424 pstf * haln) is to apply vatu and pstf in this order, then to apply
4425 all available features other than vatu, pstf, and haln.
4427 The features are applied to the glyphs in the range FROM and TO of
4428 the glyph-string GSTRING-IN.
4430 If some feature is actually applicable, the resulting glyphs are
4431 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4432 this case, the value is the number of produced glyphs.
4434 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4437 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4438 produced in GSTRING-OUT, and the value is nil.
4440 See the documentation of `font-make-gstring' for the format of
4442 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4444 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4449 check_otf_features (otf_features
);
4450 CHECK_FONT_OBJECT (font_object
);
4451 font
= XFONT_OBJECT (font_object
);
4452 if (! font
->driver
->otf_drive
)
4453 error ("Font backend %s can't drive OpenType GSUB table",
4454 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4455 CHECK_CONS (otf_features
);
4456 CHECK_SYMBOL (XCAR (otf_features
));
4457 val
= XCDR (otf_features
);
4458 CHECK_SYMBOL (XCAR (val
));
4459 val
= XCDR (otf_features
);
4462 len
= check_gstring (gstring_in
);
4463 CHECK_VECTOR (gstring_out
);
4464 CHECK_NATNUM (from
);
4466 CHECK_NATNUM (index
);
4468 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4469 args_out_of_range_3 (from
, to
, make_number (len
));
4470 if (XINT (index
) >= ASIZE (gstring_out
))
4471 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4472 num
= font
->driver
->otf_drive (font
, otf_features
,
4473 gstring_in
, XINT (from
), XINT (to
),
4474 gstring_out
, XINT (index
), 0);
4477 return make_number (num
);
4480 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4482 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4483 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4485 (SCRIPT LANGSYS FEATURE ...)
4486 See the documentation of `font-drive-otf' for more detail.
4488 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4489 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4490 character code corresponding to the glyph or nil if there's no
4491 corresponding character. */)
4492 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4495 Lisp_Object gstring_in
, gstring_out
, g
;
4496 Lisp_Object alternates
;
4499 CHECK_FONT_GET_OBJECT (font_object
, font
);
4500 if (! font
->driver
->otf_drive
)
4501 error ("Font backend %s can't drive OpenType GSUB table",
4502 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4503 CHECK_CHARACTER (character
);
4504 CHECK_CONS (otf_features
);
4506 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4507 g
= LGSTRING_GLYPH (gstring_in
, 0);
4508 LGLYPH_SET_CHAR (g
, XINT (character
));
4509 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4510 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4511 gstring_out
, 0, 1)) < 0)
4512 gstring_out
= Ffont_make_gstring (font_object
,
4513 make_number (ASIZE (gstring_out
) * 2));
4515 for (i
= 0; i
< num
; i
++)
4517 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4518 int c
= LGLYPH_CHAR (g
);
4519 unsigned code
= LGLYPH_CODE (g
);
4521 alternates
= Fcons (Fcons (make_number (code
),
4522 c
> 0 ? make_number (c
) : Qnil
),
4525 return Fnreverse (alternates
);
4531 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4532 doc
: /* Open FONT-ENTITY. */)
4533 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4537 CHECK_FONT_ENTITY (font_entity
);
4539 frame
= selected_frame
;
4540 CHECK_LIVE_FRAME (frame
);
4543 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4546 CHECK_NUMBER_OR_FLOAT (size
);
4548 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4550 isize
= XINT (size
);
4554 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4557 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4558 doc
: /* Close FONT-OBJECT. */)
4559 (Lisp_Object font_object
, Lisp_Object frame
)
4561 CHECK_FONT_OBJECT (font_object
);
4563 frame
= selected_frame
;
4564 CHECK_LIVE_FRAME (frame
);
4565 font_close_object (XFRAME (frame
), font_object
);
4569 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4570 doc
: /* Return information about FONT-OBJECT.
4571 The value is a vector:
4572 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4575 NAME is a string of the font name (or nil if the font backend doesn't
4578 FILENAME is a string of the font file (or nil if the font backend
4579 doesn't provide a file name).
4581 PIXEL-SIZE is a pixel size by which the font is opened.
4583 SIZE is a maximum advance width of the font in pixels.
4585 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4588 CAPABILITY is a list whose first element is a symbol representing the
4589 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4590 remaining elements describe the details of the font capability.
4592 If the font is OpenType font, the form of the list is
4593 \(opentype GSUB GPOS)
4594 where GSUB shows which "GSUB" features the font supports, and GPOS
4595 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4596 lists of the format:
4597 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4599 If the font is not OpenType font, currently the length of the form is
4602 SCRIPT is a symbol representing OpenType script tag.
4604 LANGSYS is a symbol representing OpenType langsys tag, or nil
4605 representing the default langsys.
4607 FEATURE is a symbol representing OpenType feature tag.
4609 If the font is not OpenType font, CAPABILITY is nil. */)
4610 (Lisp_Object font_object
)
4615 CHECK_FONT_GET_OBJECT (font_object
, font
);
4617 val
= Fmake_vector (make_number (9), Qnil
);
4618 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4619 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4620 ASET (val
, 2, make_number (font
->pixel_size
));
4621 ASET (val
, 3, make_number (font
->max_width
));
4622 ASET (val
, 4, make_number (font
->ascent
));
4623 ASET (val
, 5, make_number (font
->descent
));
4624 ASET (val
, 6, make_number (font
->space_width
));
4625 ASET (val
, 7, make_number (font
->average_width
));
4626 if (font
->driver
->otf_capability
)
4627 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4631 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4633 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4634 FROM and TO are positions (integers or markers) specifying a region
4635 of the current buffer.
4636 If the optional fourth arg OBJECT is not nil, it is a string or a
4637 vector containing the target characters.
4639 Each element is a vector containing information of a glyph in this format:
4640 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4642 FROM is an index numbers of a character the glyph corresponds to.
4643 TO is the same as FROM.
4644 C is the character of the glyph.
4645 CODE is the glyph-code of C in FONT-OBJECT.
4646 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4647 ADJUSTMENT is always nil.
4648 If FONT-OBJECT doesn't have a glyph for a character,
4649 the corresponding element is nil. */)
4650 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4655 Lisp_Object
*chars
, vec
;
4658 CHECK_FONT_GET_OBJECT (font_object
, font
);
4661 EMACS_INT charpos
, bytepos
;
4663 validate_region (&from
, &to
);
4666 len
= XFASTINT (to
) - XFASTINT (from
);
4667 SAFE_ALLOCA_LISP (chars
, len
);
4668 charpos
= XFASTINT (from
);
4669 bytepos
= CHAR_TO_BYTE (charpos
);
4670 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4673 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4674 chars
[i
] = make_number (c
);
4677 else if (STRINGP (object
))
4679 const unsigned char *p
;
4681 CHECK_NUMBER (from
);
4683 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4684 || XINT (to
) > SCHARS (object
))
4685 args_out_of_range_3 (object
, from
, to
);
4688 len
= XFASTINT (to
) - XFASTINT (from
);
4689 SAFE_ALLOCA_LISP (chars
, len
);
4691 if (STRING_MULTIBYTE (object
))
4692 for (i
= 0; i
< len
; i
++)
4694 int c
= STRING_CHAR_ADVANCE (p
);
4695 chars
[i
] = make_number (c
);
4698 for (i
= 0; i
< len
; i
++)
4699 chars
[i
] = make_number (p
[i
]);
4703 CHECK_VECTOR (object
);
4704 CHECK_NUMBER (from
);
4706 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4707 || XINT (to
) > ASIZE (object
))
4708 args_out_of_range_3 (object
, from
, to
);
4711 len
= XFASTINT (to
) - XFASTINT (from
);
4712 for (i
= 0; i
< len
; i
++)
4714 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4715 CHECK_CHARACTER (elt
);
4717 chars
= &(AREF (object
, XFASTINT (from
)));
4720 vec
= Fmake_vector (make_number (len
), Qnil
);
4721 for (i
= 0; i
< len
; i
++)
4724 int c
= XFASTINT (chars
[i
]);
4726 struct font_metrics metrics
;
4728 code
= font
->driver
->encode_char (font
, c
);
4729 if (code
== FONT_INVALID_CODE
)
4731 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4732 LGLYPH_SET_FROM (g
, i
);
4733 LGLYPH_SET_TO (g
, i
);
4734 LGLYPH_SET_CHAR (g
, c
);
4735 LGLYPH_SET_CODE (g
, code
);
4736 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4737 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4738 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4739 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4740 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4741 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4744 if (! VECTORP (object
))
4749 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4750 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4751 FONT is a font-spec, font-entity, or font-object. */)
4752 (Lisp_Object spec
, Lisp_Object font
)
4754 CHECK_FONT_SPEC (spec
);
4757 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4760 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4761 doc
: /* Return a font-object for displaying a character at POSITION.
4762 Optional second arg WINDOW, if non-nil, is a window displaying
4763 the current buffer. It defaults to the currently selected window. */)
4764 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4771 CHECK_NUMBER_COERCE_MARKER (position
);
4772 pos
= XINT (position
);
4773 if (pos
< BEGV
|| pos
>= ZV
)
4774 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4778 CHECK_NUMBER (position
);
4779 CHECK_STRING (string
);
4780 pos
= XINT (position
);
4781 if (pos
< 0 || pos
>= SCHARS (string
))
4782 args_out_of_range (string
, position
);
4785 window
= selected_window
;
4786 CHECK_LIVE_WINDOW (window
);
4787 w
= XWINDOW (window
);
4789 return font_at (-1, pos
, NULL
, w
, string
);
4793 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4794 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4795 The value is a number of glyphs drawn.
4796 Type C-l to recover what previously shown. */)
4797 (Lisp_Object font_object
, Lisp_Object string
)
4799 Lisp_Object frame
= selected_frame
;
4800 FRAME_PTR f
= XFRAME (frame
);
4806 CHECK_FONT_GET_OBJECT (font_object
, font
);
4807 CHECK_STRING (string
);
4808 len
= SCHARS (string
);
4809 code
= alloca (sizeof (unsigned) * len
);
4810 for (i
= 0; i
< len
; i
++)
4812 Lisp_Object ch
= Faref (string
, make_number (i
));
4816 code
[i
] = font
->driver
->encode_char (font
, c
);
4817 if (code
[i
] == FONT_INVALID_CODE
)
4820 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4822 if (font
->driver
->prepare_face
)
4823 font
->driver
->prepare_face (f
, face
);
4824 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4825 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4826 if (font
->driver
->done_face
)
4827 font
->driver
->done_face (f
, face
);
4829 return make_number (len
);
4833 #endif /* FONT_DEBUG */
4835 #ifdef HAVE_WINDOW_SYSTEM
4837 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4838 doc
: /* Return information about a font named NAME on frame FRAME.
4839 If FRAME is omitted or nil, use the selected frame.
4840 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4841 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4843 OPENED-NAME is the name used for opening the font,
4844 FULL-NAME is the full name of the font,
4845 SIZE is the pixelsize of the font,
4846 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4847 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4848 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4849 how to compose characters.
4850 If the named font is not yet loaded, return nil. */)
4851 (Lisp_Object name
, Lisp_Object frame
)
4856 Lisp_Object font_object
;
4858 (*check_window_system_func
) ();
4861 CHECK_STRING (name
);
4863 frame
= selected_frame
;
4864 CHECK_LIVE_FRAME (frame
);
4869 int fontset
= fs_query_fontset (name
, 0);
4872 name
= fontset_ascii (fontset
);
4873 font_object
= font_open_by_name (f
, SSDATA (name
));
4875 else if (FONT_OBJECT_P (name
))
4877 else if (FONT_ENTITY_P (name
))
4878 font_object
= font_open_entity (f
, name
, 0);
4881 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4882 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4884 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4886 if (NILP (font_object
))
4888 font
= XFONT_OBJECT (font_object
);
4890 info
= Fmake_vector (make_number (7), Qnil
);
4891 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4892 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4893 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4894 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4895 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4896 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4897 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4900 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4901 close it now. Perhaps, we should manage font-objects
4902 by `reference-count'. */
4903 font_close_object (f
, font_object
);
4910 #define BUILD_STYLE_TABLE(TBL) \
4911 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4914 build_style_table (const struct table_entry
*entry
, int nelement
)
4917 Lisp_Object table
, elt
;
4919 table
= Fmake_vector (make_number (nelement
), Qnil
);
4920 for (i
= 0; i
< nelement
; i
++)
4922 for (j
= 0; entry
[i
].names
[j
]; j
++);
4923 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4924 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4925 for (j
= 0; entry
[i
].names
[j
]; j
++)
4926 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4927 ASET (table
, i
, elt
);
4932 /* The deferred font-log data of the form [ACTION ARG RESULT].
4933 If ACTION is not nil, that is added to the log when font_add_log is
4934 called next time. At that time, ACTION is set back to nil. */
4935 static Lisp_Object Vfont_log_deferred
;
4937 /* Prepend the font-related logging data in Vfont_log if it is not
4938 `t'. ACTION describes a kind of font-related action (e.g. listing,
4939 opening), ARG is the argument for the action, and RESULT is the
4940 result of the action. */
4942 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4947 if (EQ (Vfont_log
, Qt
))
4949 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4951 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4953 ASET (Vfont_log_deferred
, 0, Qnil
);
4954 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4955 AREF (Vfont_log_deferred
, 2));
4960 Lisp_Object tail
, elt
;
4961 Lisp_Object equalstr
= build_string ("=");
4963 val
= Ffont_xlfd_name (arg
, Qt
);
4964 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4968 if (EQ (XCAR (elt
), QCscript
)
4969 && SYMBOLP (XCDR (elt
)))
4970 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4971 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4972 else if (EQ (XCAR (elt
), QClang
)
4973 && SYMBOLP (XCDR (elt
)))
4974 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4975 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4976 else if (EQ (XCAR (elt
), QCotf
)
4977 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4978 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4980 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4986 && VECTORP (XCAR (result
))
4987 && ASIZE (XCAR (result
)) > 0
4988 && FONTP (AREF (XCAR (result
), 0)))
4989 result
= font_vconcat_entity_vectors (result
);
4992 val
= Ffont_xlfd_name (result
, Qt
);
4993 if (! FONT_SPEC_P (result
))
4994 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4995 build_string (":"), val
);
4998 else if (CONSP (result
))
5001 result
= Fcopy_sequence (result
);
5002 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5006 val
= Ffont_xlfd_name (val
, Qt
);
5007 XSETCAR (tail
, val
);
5010 else if (VECTORP (result
))
5012 result
= Fcopy_sequence (result
);
5013 for (i
= 0; i
< ASIZE (result
); i
++)
5015 val
= AREF (result
, i
);
5017 val
= Ffont_xlfd_name (val
, Qt
);
5018 ASET (result
, i
, val
);
5021 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5024 /* Record a font-related logging data to be added to Vfont_log when
5025 font_add_log is called next time. ACTION, ARG, RESULT are the same
5029 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5031 if (EQ (Vfont_log
, Qt
))
5033 ASET (Vfont_log_deferred
, 0, build_string (action
));
5034 ASET (Vfont_log_deferred
, 1, arg
);
5035 ASET (Vfont_log_deferred
, 2, result
);
5041 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5042 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5043 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5044 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5045 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5046 /* Note that the other elements in sort_shift_bits are not used. */
5048 staticpro (&font_charset_alist
);
5049 font_charset_alist
= Qnil
;
5051 DEFSYM (Qopentype
, "opentype");
5053 DEFSYM (Qascii_0
, "ascii-0");
5054 DEFSYM (Qiso8859_1
, "iso8859-1");
5055 DEFSYM (Qiso10646_1
, "iso10646-1");
5056 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5057 DEFSYM (Qunicode_sip
, "unicode-sip");
5061 DEFSYM (QCotf
, ":otf");
5062 DEFSYM (QClang
, ":lang");
5063 DEFSYM (QCscript
, ":script");
5064 DEFSYM (QCantialias
, ":antialias");
5066 DEFSYM (QCfoundry
, ":foundry");
5067 DEFSYM (QCadstyle
, ":adstyle");
5068 DEFSYM (QCregistry
, ":registry");
5069 DEFSYM (QCspacing
, ":spacing");
5070 DEFSYM (QCdpi
, ":dpi");
5071 DEFSYM (QCscalable
, ":scalable");
5072 DEFSYM (QCavgwidth
, ":avgwidth");
5073 DEFSYM (QCfont_entity
, ":font-entity");
5074 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5084 DEFSYM (QCuser_spec
, "user-spec");
5086 staticpro (&null_vector
);
5087 null_vector
= Fmake_vector (make_number (0), Qnil
);
5089 staticpro (&scratch_font_spec
);
5090 scratch_font_spec
= Ffont_spec (0, NULL
);
5091 staticpro (&scratch_font_prefer
);
5092 scratch_font_prefer
= Ffont_spec (0, NULL
);
5094 staticpro (&Vfont_log_deferred
);
5095 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5099 staticpro (&otf_list
);
5101 #endif /* HAVE_LIBOTF */
5105 defsubr (&Sfont_spec
);
5106 defsubr (&Sfont_get
);
5107 #ifdef HAVE_WINDOW_SYSTEM
5108 defsubr (&Sfont_face_attributes
);
5110 defsubr (&Sfont_put
);
5111 defsubr (&Slist_fonts
);
5112 defsubr (&Sfont_family_list
);
5113 defsubr (&Sfind_font
);
5114 defsubr (&Sfont_xlfd_name
);
5115 defsubr (&Sclear_font_cache
);
5116 defsubr (&Sfont_shape_gstring
);
5117 defsubr (&Sfont_variation_glyphs
);
5119 defsubr (&Sfont_drive_otf
);
5120 defsubr (&Sfont_otf_alternates
);
5124 defsubr (&Sopen_font
);
5125 defsubr (&Sclose_font
);
5126 defsubr (&Squery_font
);
5127 defsubr (&Sfont_get_glyphs
);
5128 defsubr (&Sfont_match_p
);
5129 defsubr (&Sfont_at
);
5131 defsubr (&Sdraw_string
);
5133 #endif /* FONT_DEBUG */
5134 #ifdef HAVE_WINDOW_SYSTEM
5135 defsubr (&Sfont_info
);
5138 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5140 Alist of fontname patterns vs the corresponding encoding and repertory info.
5141 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5142 where ENCODING is a charset or a char-table,
5143 and REPERTORY is a charset, a char-table, or nil.
5145 If ENCODING and REPERTORY are the same, the element can have the form
5146 \(REGEXP . ENCODING).
5148 ENCODING is for converting a character to a glyph code of the font.
5149 If ENCODING is a charset, encoding a character by the charset gives
5150 the corresponding glyph code. If ENCODING is a char-table, looking up
5151 the table by a character gives the corresponding glyph code.
5153 REPERTORY specifies a repertory of characters supported by the font.
5154 If REPERTORY is a charset, all characters beloging to the charset are
5155 supported. If REPERTORY is a char-table, all characters who have a
5156 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5157 gets the repertory information by an opened font and ENCODING. */);
5158 Vfont_encoding_alist
= Qnil
;
5160 /* FIXME: These 3 vars are not quite what they appear: setq on them
5161 won't have any effect other than disconnect them from the style
5162 table used by the font display code. So we make them read-only,
5163 to avoid this confusing situation. */
5165 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5166 doc
: /* Vector of valid font weight values.
5167 Each element has the form:
5168 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5169 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5170 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5171 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5173 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5174 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5175 See `font-weight-table' for the format of the vector. */);
5176 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5177 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5179 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5180 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5181 See `font-weight-table' for the format of the vector. */);
5182 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5183 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5185 staticpro (&font_style_table
);
5186 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5187 ASET (font_style_table
, 0, Vfont_weight_table
);
5188 ASET (font_style_table
, 1, Vfont_slant_table
);
5189 ASET (font_style_table
, 2, Vfont_width_table
);
5191 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5192 *Logging list of font related actions and results.
5193 The value t means to suppress the logging.
5194 The initial value is set to nil if the environment variable
5195 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5198 #ifdef HAVE_WINDOW_SYSTEM
5199 #ifdef HAVE_FREETYPE
5201 #ifdef HAVE_X_WINDOWS
5206 #endif /* HAVE_XFT */
5207 #endif /* HAVE_X_WINDOWS */
5208 #else /* not HAVE_FREETYPE */
5209 #ifdef HAVE_X_WINDOWS
5211 #endif /* HAVE_X_WINDOWS */
5212 #endif /* not HAVE_FREETYPE */
5215 #endif /* HAVE_BDFFONT */
5218 #endif /* WINDOWSNT */
5221 #endif /* HAVE_NS */
5222 #endif /* HAVE_WINDOW_SYSTEM */
5228 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;