1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2012 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/>. */
30 #include "character.h"
34 #include "dispextern.h"
36 #include "composite.h"
42 #endif /* HAVE_X_WINDOWS */
46 #endif /* HAVE_NTGUI */
52 Lisp_Object Qopentype
;
54 /* Important character set strings. */
55 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
57 #define DEFAULT_ENCODING Qiso8859_1
59 /* Unicode category `Cf'. */
60 static Lisp_Object QCf
;
62 /* Special vector of zero length. This is repeatedly used by (struct
63 font_driver *)->list when a specified font is not found. */
64 static Lisp_Object null_vector
;
66 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
67 static Lisp_Object font_style_table
;
69 /* Structure used for tables mapping weight, slant, and width numeric
70 values and their names. */
75 /* The first one is a valid name as a face attribute.
76 The second one (if any) is a typical name in XLFD field. */
80 /* Table of weight numeric values and their names. This table must be
81 sorted by numeric values in ascending order. */
83 static const struct table_entry weight_table
[] =
86 { 20, { "ultra-light", "ultralight" }},
87 { 40, { "extra-light", "extralight" }},
89 { 75, { "semi-light", "semilight", "demilight", "book" }},
90 { 100, { "normal", "medium", "regular", "unspecified" }},
91 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
93 { 205, { "extra-bold", "extrabold" }},
94 { 210, { "ultra-bold", "ultrabold", "black" }}
97 /* Table of slant numeric values and their names. This table must be
98 sorted by numeric values in ascending order. */
100 static const struct table_entry slant_table
[] =
102 { 0, { "reverse-oblique", "ro" }},
103 { 10, { "reverse-italic", "ri" }},
104 { 100, { "normal", "r", "unspecified" }},
105 { 200, { "italic" ,"i", "ot" }},
106 { 210, { "oblique", "o" }}
109 /* Table of width numeric values and their names. This table must be
110 sorted by numeric values in ascending order. */
112 static const struct table_entry width_table
[] =
114 { 50, { "ultra-condensed", "ultracondensed" }},
115 { 63, { "extra-condensed", "extracondensed" }},
116 { 75, { "condensed", "compressed", "narrow" }},
117 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
118 { 100, { "normal", "medium", "regular", "unspecified" }},
119 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
120 { 125, { "expanded" }},
121 { 150, { "extra-expanded", "extraexpanded" }},
122 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
125 Lisp_Object QCfoundry
;
126 static Lisp_Object QCadstyle
, QCregistry
;
127 /* Symbols representing keys of font extra info. */
128 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
129 Lisp_Object QCantialias
, QCfont_entity
;
130 static Lisp_Object QCfc_unknown_spec
;
131 /* Symbols representing values of font spacing property. */
132 static Lisp_Object Qc
, Qm
, Qd
;
134 /* Special ADSTYLE properties to avoid fonts used for Latin
135 characters; used in xfont.c and ftfont.c. */
136 Lisp_Object Qja
, Qko
;
138 static Lisp_Object QCuser_spec
;
140 /* Alist of font registry symbols and the corresponding charset
141 information. The information is retrieved from
142 Vfont_encoding_alist on demand.
144 Eash element has the form:
145 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
149 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
150 encodes a character code to a glyph code of a font, and
151 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
152 character is supported by a font.
154 The latter form means that the information for REGISTRY couldn't be
156 static Lisp_Object font_charset_alist
;
158 /* List of all font drivers. Each font-backend (XXXfont.c) calls
159 register_font_driver in syms_of_XXXfont to register its font-driver
161 static struct font_driver_list
*font_driver_list
;
165 /* Creators of font-related Lisp object. */
168 font_make_spec (void)
170 Lisp_Object font_spec
;
171 struct font_spec
*spec
172 = ((struct font_spec
*)
173 allocate_pseudovector (VECSIZE (struct font_spec
),
174 FONT_SPEC_MAX
, PVEC_FONT
));
175 XSETFONT (font_spec
, spec
);
180 font_make_entity (void)
182 Lisp_Object font_entity
;
183 struct font_entity
*entity
184 = ((struct font_entity
*)
185 allocate_pseudovector (VECSIZE (struct font_entity
),
186 FONT_ENTITY_MAX
, PVEC_FONT
));
187 XSETFONT (font_entity
, entity
);
191 /* Create a font-object whose structure size is SIZE. If ENTITY is
192 not nil, copy properties from ENTITY to the font-object. If
193 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
195 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
197 Lisp_Object font_object
;
199 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
202 XSETFONT (font_object
, font
);
206 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
207 font
->props
[i
] = AREF (entity
, i
);
208 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
209 font
->props
[FONT_EXTRA_INDEX
]
210 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
213 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
219 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
220 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
221 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
223 static unsigned font_encode_char (Lisp_Object
, int);
225 /* Number of registered font drivers. */
226 static int num_font_drivers
;
229 /* Return a Lispy value of a font property value at STR and LEN bytes.
230 If STR is "*", return nil.
231 If FORCE_SYMBOL is zero and all characters in STR are digits,
232 return an integer. Otherwise, return a symbol interned from
236 font_intern_prop (const char *str
, ptrdiff_t len
, int force_symbol
)
241 ptrdiff_t nbytes
, nchars
;
243 if (len
== 1 && *str
== '*')
245 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
247 for (i
= 1; i
< len
; i
++)
248 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
255 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
258 return make_number (n
);
259 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
263 xsignal1 (Qoverflow_error
, make_string (str
, len
));
267 /* This code is similar to intern function from lread.c. */
268 obarray
= check_obarray (Vobarray
);
269 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
270 tem
= oblookup (obarray
, str
,
271 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
275 if (len
== nchars
|| len
!= nbytes
)
276 tem
= make_unibyte_string (str
, len
);
278 tem
= make_multibyte_string (str
, nchars
, len
);
279 return Fintern (tem
, obarray
);
282 /* Return a pixel size of font-spec SPEC on frame F. */
285 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
287 #ifdef HAVE_WINDOW_SYSTEM
288 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
297 font_assert (FLOATP (size
));
298 point_size
= XFLOAT_DATA (size
);
299 val
= AREF (spec
, FONT_DPI_INDEX
);
304 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
312 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
313 font vector. If VAL is not valid (i.e. not registered in
314 font_style_table), return -1 if NOERROR is zero, and return a
315 proper index if NOERROR is nonzero. In that case, register VAL in
316 font_style_table if VAL is a symbol, and return the closest index if
317 VAL is an integer. */
320 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
322 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
325 CHECK_VECTOR (table
);
332 Lisp_Object args
[2], elt
;
334 /* At first try exact match. */
335 for (i
= 0; i
< len
; i
++)
337 CHECK_VECTOR (AREF (table
, i
));
338 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
339 if (EQ (val
, AREF (AREF (table
, i
), j
)))
341 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
342 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
343 | (i
<< 4) | (j
- 1));
346 /* Try also with case-folding match. */
347 s
= SSDATA (SYMBOL_NAME (val
));
348 for (i
= 0; i
< len
; i
++)
349 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
351 elt
= AREF (AREF (table
, i
), j
);
352 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
354 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
355 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
356 | (i
<< 4) | (j
- 1));
363 elt
= Fmake_vector (make_number (2), make_number (100));
366 args
[1] = Fmake_vector (make_number (1), elt
);
367 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
368 return (100 << 8) | (i
<< 4);
373 EMACS_INT numeric
= XINT (val
);
375 for (i
= 0, last_n
= -1; i
< len
; i
++)
379 CHECK_VECTOR (AREF (table
, i
));
380 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
381 n
= XINT (AREF (AREF (table
, i
), 0));
383 return (n
<< 8) | (i
<< 4);
388 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
389 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
395 return ((last_n
<< 8) | ((i
- 1) << 4));
400 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
402 Lisp_Object val
= AREF (font
, prop
);
403 Lisp_Object table
, elt
;
408 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
409 CHECK_VECTOR (table
);
410 i
= XINT (val
) & 0xFF;
411 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
412 elt
= AREF (table
, ((i
>> 4) & 0xF));
414 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
415 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
420 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
421 FONTNAME. ENCODING is a charset symbol that specifies the encoding
422 of the font. REPERTORY is a charset symbol or nil. */
425 find_font_encoding (Lisp_Object fontname
)
427 Lisp_Object tail
, elt
;
429 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
433 && STRINGP (XCAR (elt
))
434 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
435 && (SYMBOLP (XCDR (elt
))
436 ? CHARSETP (XCDR (elt
))
437 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
443 /* Return encoding charset and repertory charset for REGISTRY in
444 ENCODING and REPERTORY correspondingly. If correct information for
445 REGISTRY is available, return 0. Otherwise return -1. */
448 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
451 int encoding_id
, repertory_id
;
453 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
459 encoding_id
= XINT (XCAR (val
));
460 repertory_id
= XINT (XCDR (val
));
464 val
= find_font_encoding (SYMBOL_NAME (registry
));
465 if (SYMBOLP (val
) && CHARSETP (val
))
467 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
469 else if (CONSP (val
))
471 if (! CHARSETP (XCAR (val
)))
473 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
474 if (NILP (XCDR (val
)))
478 if (! CHARSETP (XCDR (val
)))
480 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
485 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
487 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
491 *encoding
= CHARSET_FROM_ID (encoding_id
);
493 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
498 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
503 /* Font property value validators. See the comment of
504 font_property_table for the meaning of the arguments. */
506 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
507 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
508 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
509 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
510 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
511 static int get_font_prop_index (Lisp_Object
);
514 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
517 val
= Fintern (val
, Qnil
);
520 else if (EQ (prop
, QCregistry
))
521 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
527 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
529 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
530 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
534 EMACS_INT n
= XINT (val
);
535 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
537 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
541 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
544 if ((n
& 0xF) + 1 >= ASIZE (elt
))
548 CHECK_NUMBER (AREF (elt
, 0));
549 if (XINT (AREF (elt
, 0)) != (n
>> 8))
554 else if (SYMBOLP (val
))
556 int n
= font_style_to_value (prop
, val
, 0);
558 val
= n
>= 0 ? make_number (n
) : Qerror
;
566 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
568 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
573 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
575 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
577 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
579 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
581 if (spacing
== 'c' || spacing
== 'C')
582 return make_number (FONT_SPACING_CHARCELL
);
583 if (spacing
== 'm' || spacing
== 'M')
584 return make_number (FONT_SPACING_MONO
);
585 if (spacing
== 'p' || spacing
== 'P')
586 return make_number (FONT_SPACING_PROPORTIONAL
);
587 if (spacing
== 'd' || spacing
== 'D')
588 return make_number (FONT_SPACING_DUAL
);
594 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
596 Lisp_Object tail
, tmp
;
599 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
600 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
601 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
604 if (! SYMBOLP (XCAR (val
)))
609 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
611 for (i
= 0; i
< 2; i
++)
618 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
619 if (! SYMBOLP (XCAR (tmp
)))
627 /* Structure of known font property keys and validator of the
631 /* Pointer to the key symbol. */
633 /* Function to validate PROP's value VAL, or NULL if any value is
634 ok. The value is VAL or its regularized value if VAL is valid,
635 and Qerror if not. */
636 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
637 } font_property_table
[] =
638 { { &QCtype
, font_prop_validate_symbol
},
639 { &QCfoundry
, font_prop_validate_symbol
},
640 { &QCfamily
, font_prop_validate_symbol
},
641 { &QCadstyle
, font_prop_validate_symbol
},
642 { &QCregistry
, font_prop_validate_symbol
},
643 { &QCweight
, font_prop_validate_style
},
644 { &QCslant
, font_prop_validate_style
},
645 { &QCwidth
, font_prop_validate_style
},
646 { &QCsize
, font_prop_validate_non_neg
},
647 { &QCdpi
, font_prop_validate_non_neg
},
648 { &QCspacing
, font_prop_validate_spacing
},
649 { &QCavgwidth
, font_prop_validate_non_neg
},
650 /* The order of the above entries must match with enum
651 font_property_index. */
652 { &QClang
, font_prop_validate_symbol
},
653 { &QCscript
, font_prop_validate_symbol
},
654 { &QCotf
, font_prop_validate_otf
}
657 /* Size (number of elements) of the above table. */
658 #define FONT_PROPERTY_TABLE_SIZE \
659 ((sizeof font_property_table) / (sizeof *font_property_table))
661 /* Return an index number of font property KEY or -1 if KEY is not an
662 already known property. */
665 get_font_prop_index (Lisp_Object key
)
669 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
670 if (EQ (key
, *font_property_table
[i
].key
))
675 /* Validate the font property. The property key is specified by the
676 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
677 signal an error. The value is VAL or the regularized one. */
680 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
682 Lisp_Object validated
;
687 prop
= *font_property_table
[idx
].key
;
690 idx
= get_font_prop_index (prop
);
694 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
695 if (EQ (validated
, Qerror
))
696 signal_error ("invalid font property", Fcons (prop
, val
));
701 /* Store VAL as a value of extra font property PROP in FONT while
702 keeping the sorting order. Don't check the validity of VAL. */
705 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
707 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
708 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
712 Lisp_Object prev
= Qnil
;
715 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
716 prev
= extra
, extra
= XCDR (extra
);
719 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
721 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
727 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
732 /* Font name parser and unparser */
734 static int parse_matrix (const char *);
735 static int font_expand_wildcards (Lisp_Object
*, int);
736 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
738 /* An enumerator for each field of an XLFD font name. */
739 enum xlfd_field_index
758 /* An enumerator for mask bit corresponding to each XLFD field. */
761 XLFD_FOUNDRY_MASK
= 0x0001,
762 XLFD_FAMILY_MASK
= 0x0002,
763 XLFD_WEIGHT_MASK
= 0x0004,
764 XLFD_SLANT_MASK
= 0x0008,
765 XLFD_SWIDTH_MASK
= 0x0010,
766 XLFD_ADSTYLE_MASK
= 0x0020,
767 XLFD_PIXEL_MASK
= 0x0040,
768 XLFD_POINT_MASK
= 0x0080,
769 XLFD_RESX_MASK
= 0x0100,
770 XLFD_RESY_MASK
= 0x0200,
771 XLFD_SPACING_MASK
= 0x0400,
772 XLFD_AVGWIDTH_MASK
= 0x0800,
773 XLFD_REGISTRY_MASK
= 0x1000,
774 XLFD_ENCODING_MASK
= 0x2000
778 /* Parse P pointing to the pixel/point size field of the form
779 `[A B C D]' which specifies a transformation matrix:
785 by which all glyphs of the font are transformed. The spec says
786 that scalar value N for the pixel/point size is equivalent to:
787 A = N * resx/resy, B = C = 0, D = N.
789 Return the scalar value N if the form is valid. Otherwise return
793 parse_matrix (const char *p
)
799 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
802 matrix
[i
] = - strtod (p
+ 1, &end
);
804 matrix
[i
] = strtod (p
, &end
);
807 return (i
== 4 ? (int) matrix
[3] : -1);
810 /* Expand a wildcard field in FIELD (the first N fields are filled) to
811 multiple fields to fill in all 14 XLFD fields while restricting a
812 field position by its contents. */
815 font_expand_wildcards (Lisp_Object
*field
, int n
)
818 Lisp_Object tmp
[XLFD_LAST_INDEX
];
819 /* Array of information about where this element can go. Nth
820 element is for Nth element of FIELD. */
822 /* Minimum possible field. */
824 /* Maximum possible field. */
826 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
828 } range
[XLFD_LAST_INDEX
];
830 int range_from
, range_to
;
833 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
834 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
835 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
836 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
837 | XLFD_AVGWIDTH_MASK)
838 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
840 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
841 field. The value is shifted to left one bit by one in the
843 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
844 range_mask
= (range_mask
<< 1) | 1;
846 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
847 position-based restriction for FIELD[I]. */
848 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
849 i
++, range_from
++, range_to
++, range_mask
<<= 1)
851 Lisp_Object val
= field
[i
];
857 range
[i
].from
= range_from
;
858 range
[i
].to
= range_to
;
859 range
[i
].mask
= range_mask
;
863 /* The triplet FROM, TO, and MASK is a value-based
864 restriction for FIELD[I]. */
870 EMACS_INT numeric
= XINT (val
);
873 from
= to
= XLFD_ENCODING_INDEX
,
874 mask
= XLFD_ENCODING_MASK
;
875 else if (numeric
== 0)
876 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
877 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
878 else if (numeric
<= 48)
879 from
= to
= XLFD_PIXEL_INDEX
,
880 mask
= XLFD_PIXEL_MASK
;
882 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
883 mask
= XLFD_LARGENUM_MASK
;
885 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
886 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
887 mask
= XLFD_NULL_MASK
;
889 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
892 Lisp_Object name
= SYMBOL_NAME (val
);
894 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
895 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
896 mask
= XLFD_REGENC_MASK
;
898 from
= to
= XLFD_ENCODING_INDEX
,
899 mask
= XLFD_ENCODING_MASK
;
901 else if (range_from
<= XLFD_WEIGHT_INDEX
902 && range_to
>= XLFD_WEIGHT_INDEX
903 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
904 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
905 else if (range_from
<= XLFD_SLANT_INDEX
906 && range_to
>= XLFD_SLANT_INDEX
907 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
908 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
909 else if (range_from
<= XLFD_SWIDTH_INDEX
910 && range_to
>= XLFD_SWIDTH_INDEX
911 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
912 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
915 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
916 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
918 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
919 mask
= XLFD_SYMBOL_MASK
;
922 /* Merge position-based and value-based restrictions. */
924 while (from
< range_from
)
925 mask
&= ~(1 << from
++);
926 while (from
< 14 && ! (mask
& (1 << from
)))
928 while (to
> range_to
)
929 mask
&= ~(1 << to
--);
930 while (to
>= 0 && ! (mask
& (1 << to
)))
934 range
[i
].from
= from
;
936 range
[i
].mask
= mask
;
938 if (from
> range_from
|| to
< range_to
)
940 /* The range is narrowed by value-based restrictions.
941 Reflect it to the other fields. */
943 /* Following fields should be after FROM. */
945 /* Preceding fields should be before TO. */
946 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
948 /* Check FROM for non-wildcard field. */
949 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
951 while (range
[j
].from
< from
)
952 range
[j
].mask
&= ~(1 << range
[j
].from
++);
953 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
955 range
[j
].from
= from
;
958 from
= range
[j
].from
;
959 if (range
[j
].to
> to
)
961 while (range
[j
].to
> to
)
962 range
[j
].mask
&= ~(1 << range
[j
].to
--);
963 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
976 /* Decide all fields from restrictions in RANGE. */
977 for (i
= j
= 0; i
< n
; i
++)
979 if (j
< range
[i
].from
)
981 if (i
== 0 || ! NILP (tmp
[i
- 1]))
982 /* None of TMP[X] corresponds to Jth field. */
984 for (; j
< range
[i
].from
; j
++)
989 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
991 for (; j
< XLFD_LAST_INDEX
; j
++)
993 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
994 field
[XLFD_ENCODING_INDEX
]
995 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1000 /* Parse NAME (null terminated) as XLFD and store information in FONT
1001 (font-spec or font-entity). Size property of FONT is set as
1003 specified XLFD fields FONT property
1004 --------------------- -------------
1005 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1006 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1007 POINT_SIZE POINT_SIZE/10 (Lisp float)
1009 If NAME is successfully parsed, return 0. Otherwise return -1.
1011 FONT is usually a font-spec, but when this function is called from
1012 X font backend driver, it is a font-entity. In that case, NAME is
1013 a fully specified XLFD. */
1016 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1019 char *f
[XLFD_LAST_INDEX
+ 1];
1023 if (len
> 255 || !len
)
1024 /* Maximum XLFD name length is 255. */
1026 /* Accept "*-.." as a fully specified XLFD. */
1027 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1028 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1031 for (p
= name
+ i
; *p
; p
++)
1035 if (i
== XLFD_LAST_INDEX
)
1040 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1041 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1043 if (i
== XLFD_LAST_INDEX
)
1045 /* Fully specified XLFD. */
1048 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1049 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1050 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1051 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1053 val
= INTERN_FIELD_SYM (i
);
1056 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1058 ASET (font
, j
, make_number (n
));
1061 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1062 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1063 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1065 ASET (font
, FONT_REGISTRY_INDEX
,
1066 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1067 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1069 p
= f
[XLFD_PIXEL_INDEX
];
1070 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1071 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1074 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1076 ASET (font
, FONT_SIZE_INDEX
, val
);
1077 else if (FONT_ENTITY_P (font
))
1081 double point_size
= -1;
1083 font_assert (FONT_SPEC_P (font
));
1084 p
= f
[XLFD_POINT_INDEX
];
1086 point_size
= parse_matrix (p
);
1087 else if (isdigit (*p
))
1088 point_size
= atoi (p
), point_size
/= 10;
1089 if (point_size
>= 0)
1090 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1094 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1095 if (! NILP (val
) && ! INTEGERP (val
))
1097 ASET (font
, FONT_DPI_INDEX
, val
);
1098 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1101 val
= font_prop_validate_spacing (QCspacing
, val
);
1102 if (! INTEGERP (val
))
1104 ASET (font
, FONT_SPACING_INDEX
, val
);
1106 p
= f
[XLFD_AVGWIDTH_INDEX
];
1109 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1110 if (! NILP (val
) && ! INTEGERP (val
))
1112 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1116 int wild_card_found
= 0;
1117 Lisp_Object prop
[XLFD_LAST_INDEX
];
1119 if (FONT_ENTITY_P (font
))
1121 for (j
= 0; j
< i
; j
++)
1125 if (f
[j
][1] && f
[j
][1] != '-')
1128 wild_card_found
= 1;
1131 prop
[j
] = INTERN_FIELD (j
);
1133 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1135 if (! wild_card_found
)
1137 if (font_expand_wildcards (prop
, i
) < 0)
1140 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1141 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1142 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1143 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1144 if (! NILP (prop
[i
]))
1146 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1148 ASET (font
, j
, make_number (n
));
1150 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1151 val
= prop
[XLFD_REGISTRY_INDEX
];
1154 val
= prop
[XLFD_ENCODING_INDEX
];
1156 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1158 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1159 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1161 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1162 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1164 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1166 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1167 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1168 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1170 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1172 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1175 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1176 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1177 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1179 val
= font_prop_validate_spacing (QCspacing
,
1180 prop
[XLFD_SPACING_INDEX
]);
1181 if (! INTEGERP (val
))
1183 ASET (font
, FONT_SPACING_INDEX
, val
);
1185 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1186 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1192 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1193 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1194 0, use PIXEL_SIZE instead. */
1197 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1200 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1204 font_assert (FONTP (font
));
1206 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1209 if (i
== FONT_ADSTYLE_INDEX
)
1210 j
= XLFD_ADSTYLE_INDEX
;
1211 else if (i
== FONT_REGISTRY_INDEX
)
1212 j
= XLFD_REGISTRY_INDEX
;
1213 val
= AREF (font
, i
);
1216 if (j
== XLFD_REGISTRY_INDEX
)
1224 val
= SYMBOL_NAME (val
);
1225 if (j
== XLFD_REGISTRY_INDEX
1226 && ! strchr (SSDATA (val
), '-'))
1228 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1229 ptrdiff_t alloc
= SBYTES (val
) + 4;
1230 if (nbytes
<= alloc
)
1232 f
[j
] = p
= alloca (alloc
);
1233 sprintf (p
, "%s%s-*", SDATA (val
),
1234 "*" + (SDATA (val
)[SBYTES (val
) - 1] == '*'));
1237 f
[j
] = SSDATA (val
);
1241 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1244 val
= font_style_symbolic (font
, i
, 0);
1249 val
= SYMBOL_NAME (val
);
1250 f
[j
] = SSDATA (val
);
1254 val
= AREF (font
, FONT_SIZE_INDEX
);
1255 font_assert (NUMBERP (val
) || NILP (val
));
1258 EMACS_INT v
= XINT (val
);
1263 f
[XLFD_PIXEL_INDEX
] = p
=
1264 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1265 sprintf (p
, "%"pI
"d-*", v
);
1268 f
[XLFD_PIXEL_INDEX
] = "*-*";
1270 else if (FLOATP (val
))
1272 double v
= XFLOAT_DATA (val
) * 10;
1273 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1274 sprintf (p
, "*-%.0f", v
);
1277 f
[XLFD_PIXEL_INDEX
] = "*-*";
1279 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1281 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1282 f
[XLFD_RESX_INDEX
] = p
=
1283 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1284 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1287 f
[XLFD_RESX_INDEX
] = "*-*";
1288 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1290 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1292 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1293 : spacing
<= FONT_SPACING_DUAL
? "d"
1294 : spacing
<= FONT_SPACING_MONO
? "m"
1298 f
[XLFD_SPACING_INDEX
] = "*";
1299 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1301 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1302 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1305 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1306 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1307 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1308 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1309 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1310 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1311 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1312 f
[XLFD_REGISTRY_INDEX
]);
1313 return len
< nbytes
? len
: -1;
1316 /* Parse NAME (null terminated) and store information in FONT
1317 (font-spec or font-entity). NAME is supplied in either the
1318 Fontconfig or GTK font name format. If NAME is successfully
1319 parsed, return 0. Otherwise return -1.
1321 The fontconfig format is
1323 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1327 FAMILY [PROPS...] [SIZE]
1329 This function tries to guess which format it is. */
1332 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1335 char *size_beg
= NULL
, *size_end
= NULL
;
1336 char *props_beg
= NULL
, *family_end
= NULL
;
1341 for (p
= name
; *p
; p
++)
1343 if (*p
== '\\' && p
[1])
1347 props_beg
= family_end
= p
;
1352 int decimal
= 0, size_found
= 1;
1353 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1356 if (*q
!= '.' || decimal
)
1375 Lisp_Object extra_props
= Qnil
;
1377 /* A fontconfig name with size and/or property data. */
1378 if (family_end
> name
)
1381 family
= font_intern_prop (name
, family_end
- name
, 1);
1382 ASET (font
, FONT_FAMILY_INDEX
, family
);
1386 double point_size
= strtod (size_beg
, &size_end
);
1387 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1388 if (*size_end
== ':' && size_end
[1])
1389 props_beg
= size_end
;
1393 /* Now parse ":KEY=VAL" patterns. */
1396 for (p
= props_beg
; *p
; p
= q
)
1398 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1401 /* Must be an enumerated value. */
1405 val
= font_intern_prop (p
, q
- p
, 1);
1407 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1408 && memcmp (p, STR, strlen (STR)) == 0)
1410 if (PROP_MATCH ("light")
1411 || PROP_MATCH ("medium")
1412 || PROP_MATCH ("demibold")
1413 || PROP_MATCH ("bold")
1414 || PROP_MATCH ("black"))
1415 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1416 else if (PROP_MATCH ("roman")
1417 || PROP_MATCH ("italic")
1418 || PROP_MATCH ("oblique"))
1419 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1420 else if (PROP_MATCH ("charcell"))
1421 ASET (font
, FONT_SPACING_INDEX
,
1422 make_number (FONT_SPACING_CHARCELL
));
1423 else if (PROP_MATCH ("mono"))
1424 ASET (font
, FONT_SPACING_INDEX
,
1425 make_number (FONT_SPACING_MONO
));
1426 else if (PROP_MATCH ("proportional"))
1427 ASET (font
, FONT_SPACING_INDEX
,
1428 make_number (FONT_SPACING_PROPORTIONAL
));
1437 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1438 prop
= FONT_SIZE_INDEX
;
1441 key
= font_intern_prop (p
, q
- p
, 1);
1442 prop
= get_font_prop_index (key
);
1446 for (q
= p
; *q
&& *q
!= ':'; q
++);
1447 val
= font_intern_prop (p
, q
- p
, 0);
1449 if (prop
>= FONT_FOUNDRY_INDEX
1450 && prop
< FONT_EXTRA_INDEX
)
1451 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1454 extra_props
= nconc2 (extra_props
,
1455 Fcons (Fcons (key
, val
), Qnil
));
1462 if (! NILP (extra_props
))
1464 struct font_driver_list
*driver_list
= font_driver_list
;
1465 for ( ; driver_list
; driver_list
= driver_list
->next
)
1466 if (driver_list
->driver
->filter_properties
)
1467 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1473 /* Either a fontconfig-style name with no size and property
1474 data, or a GTK-style name. */
1475 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1476 Lisp_Object width
= Qnil
, size
= Qnil
;
1480 /* Scan backwards from the end, looking for a size. */
1481 for (p
= name
+ len
- 1; p
>= name
; p
--)
1485 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1486 /* Found a font size. */
1487 size
= make_float (strtod (p
+ 1, NULL
));
1491 /* Now P points to the termination of the string, sans size.
1492 Scan backwards, looking for font properties. */
1493 for (; p
> name
; p
= q
)
1495 for (q
= p
- 1; q
>= name
; q
--)
1497 if (q
> name
&& *(q
-1) == '\\')
1498 --q
; /* Skip quoting backslashes. */
1504 word_len
= p
- word_start
;
1506 #define PROP_MATCH(STR) \
1507 (word_len == strlen (STR) \
1508 && memcmp (word_start, STR, strlen (STR)) == 0)
1509 #define PROP_SAVE(VAR, STR) \
1510 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1512 if (PROP_MATCH ("Ultra-Light"))
1513 PROP_SAVE (weight
, "ultra-light");
1514 else if (PROP_MATCH ("Light"))
1515 PROP_SAVE (weight
, "light");
1516 else if (PROP_MATCH ("Book"))
1517 PROP_SAVE (weight
, "book");
1518 else if (PROP_MATCH ("Medium"))
1519 PROP_SAVE (weight
, "medium");
1520 else if (PROP_MATCH ("Semi-Bold"))
1521 PROP_SAVE (weight
, "semi-bold");
1522 else if (PROP_MATCH ("Bold"))
1523 PROP_SAVE (weight
, "bold");
1524 else if (PROP_MATCH ("Italic"))
1525 PROP_SAVE (slant
, "italic");
1526 else if (PROP_MATCH ("Oblique"))
1527 PROP_SAVE (slant
, "oblique");
1528 else if (PROP_MATCH ("Semi-Condensed"))
1529 PROP_SAVE (width
, "semi-condensed");
1530 else if (PROP_MATCH ("Condensed"))
1531 PROP_SAVE (width
, "condensed");
1532 /* An unknown word must be part of the font name. */
1543 ASET (font
, FONT_FAMILY_INDEX
,
1544 font_intern_prop (name
, family_end
- name
, 1));
1546 ASET (font
, FONT_SIZE_INDEX
, size
);
1548 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1550 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1552 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1558 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1559 NAME (NBYTES length), and return the name length. If
1560 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1563 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1565 Lisp_Object family
, foundry
;
1571 Lisp_Object styles
[3];
1572 const char *style_names
[3] = { "weight", "slant", "width" };
1574 family
= AREF (font
, FONT_FAMILY_INDEX
);
1575 if (! NILP (family
))
1577 if (SYMBOLP (family
))
1578 family
= SYMBOL_NAME (family
);
1583 val
= AREF (font
, FONT_SIZE_INDEX
);
1586 if (XINT (val
) != 0)
1587 pixel_size
= XINT (val
);
1595 point_size
= (int) XFLOAT_DATA (val
);
1598 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1599 if (! NILP (foundry
))
1601 if (SYMBOLP (foundry
))
1602 foundry
= SYMBOL_NAME (foundry
);
1607 for (i
= 0; i
< 3; i
++)
1608 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1611 lim
= name
+ nbytes
;
1612 if (! NILP (family
))
1614 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1615 if (! (0 <= len
&& len
< lim
- p
))
1621 int len
= snprintf (p
, lim
- p
, "-%d" + (p
== name
), point_size
);
1622 if (! (0 <= len
&& len
< lim
- p
))
1626 else if (pixel_size
> 0)
1628 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1629 if (! (0 <= len
&& len
< lim
- p
))
1633 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1635 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1636 SSDATA (SYMBOL_NAME (AREF (font
,
1637 FONT_FOUNDRY_INDEX
))));
1638 if (! (0 <= len
&& len
< lim
- p
))
1642 for (i
= 0; i
< 3; i
++)
1643 if (! NILP (styles
[i
]))
1645 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1646 SSDATA (SYMBOL_NAME (styles
[i
])));
1647 if (! (0 <= len
&& len
< lim
- p
))
1652 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1654 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1655 XINT (AREF (font
, FONT_DPI_INDEX
)));
1656 if (! (0 <= len
&& len
< lim
- p
))
1661 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1663 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1664 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1665 if (! (0 <= len
&& len
< lim
- p
))
1670 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1672 int len
= snprintf (p
, lim
- p
,
1673 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1675 : ":scalable=false"));
1676 if (! (0 <= len
&& len
< lim
- p
))
1684 /* Parse NAME (null terminated) and store information in FONT
1685 (font-spec or font-entity). If NAME is successfully parsed, return
1686 0. Otherwise return -1. */
1689 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1691 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1692 return font_parse_xlfd (name
, namelen
, font
);
1693 return font_parse_fcname (name
, namelen
, font
);
1697 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1698 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1702 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1708 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1710 CHECK_STRING (family
);
1711 len
= SBYTES (family
);
1712 p0
= SSDATA (family
);
1713 p1
= strchr (p0
, '-');
1716 if ((*p0
!= '*' && p1
- p0
> 0)
1717 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1718 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1721 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1724 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1726 if (! NILP (registry
))
1728 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1729 CHECK_STRING (registry
);
1730 len
= SBYTES (registry
);
1731 p0
= SSDATA (registry
);
1732 p1
= strchr (p0
, '-');
1735 if (SDATA (registry
)[len
- 1] == '*')
1736 registry
= concat2 (registry
, build_string ("-*"));
1738 registry
= concat2 (registry
, build_string ("*-*"));
1740 registry
= Fdowncase (registry
);
1741 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1746 /* This part (through the next ^L) is still experimental and not
1747 tested much. We may drastically change codes. */
1753 #define LGSTRING_HEADER_SIZE 6
1754 #define LGSTRING_GLYPH_SIZE 8
1757 check_gstring (Lisp_Object gstring
)
1763 CHECK_VECTOR (gstring
);
1764 val
= AREF (gstring
, 0);
1766 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1768 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1769 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1770 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1771 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1772 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1773 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1774 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1775 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1776 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1777 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1778 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1780 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1782 val
= LGSTRING_GLYPH (gstring
, i
);
1784 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1786 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1788 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1789 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1790 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1791 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1792 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1793 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1794 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1795 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1797 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1799 if (ASIZE (val
) < 3)
1801 for (j
= 0; j
< 3; j
++)
1802 CHECK_NUMBER (AREF (val
, j
));
1807 error ("Invalid glyph-string format");
1812 check_otf_features (Lisp_Object otf_features
)
1816 CHECK_CONS (otf_features
);
1817 CHECK_SYMBOL (XCAR (otf_features
));
1818 otf_features
= XCDR (otf_features
);
1819 CHECK_CONS (otf_features
);
1820 CHECK_SYMBOL (XCAR (otf_features
));
1821 otf_features
= XCDR (otf_features
);
1822 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1824 CHECK_SYMBOL (XCAR (val
));
1825 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1826 error ("Invalid OTF GSUB feature: %s",
1827 SDATA (SYMBOL_NAME (XCAR (val
))));
1829 otf_features
= XCDR (otf_features
);
1830 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1832 CHECK_SYMBOL (XCAR (val
));
1833 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1834 error ("Invalid OTF GPOS feature: %s",
1835 SDATA (SYMBOL_NAME (XCAR (val
))));
1842 Lisp_Object otf_list
;
1845 otf_tag_symbol (OTF_Tag tag
)
1849 OTF_tag_name (tag
, name
);
1850 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1854 otf_open (Lisp_Object file
)
1856 Lisp_Object val
= Fassoc (file
, otf_list
);
1860 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1863 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1864 val
= make_save_value (otf
, 0);
1865 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1871 /* Return a list describing which scripts/languages FONT supports by
1872 which GSUB/GPOS features of OpenType tables. See the comment of
1873 (struct font_driver).otf_capability. */
1876 font_otf_capability (struct font
*font
)
1879 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1882 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1885 for (i
= 0; i
< 2; i
++)
1887 OTF_GSUB_GPOS
*gsub_gpos
;
1888 Lisp_Object script_list
= Qnil
;
1891 if (OTF_get_features (otf
, i
== 0) < 0)
1893 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1894 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1896 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1897 Lisp_Object langsys_list
= Qnil
;
1898 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1901 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1903 OTF_LangSys
*langsys
;
1904 Lisp_Object feature_list
= Qnil
;
1905 Lisp_Object langsys_tag
;
1908 if (k
== script
->LangSysCount
)
1910 langsys
= &script
->DefaultLangSys
;
1915 langsys
= script
->LangSys
+ k
;
1917 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1919 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1921 OTF_Feature
*feature
1922 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1923 Lisp_Object feature_tag
1924 = otf_tag_symbol (feature
->FeatureTag
);
1926 feature_list
= Fcons (feature_tag
, feature_list
);
1928 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1931 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1936 XSETCAR (capability
, script_list
);
1938 XSETCDR (capability
, script_list
);
1944 /* Parse OTF features in SPEC and write a proper features spec string
1945 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1946 assured that the sufficient memory has already allocated for
1950 generate_otf_features (Lisp_Object spec
, char *features
)
1958 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1964 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1969 else if (! asterisk
)
1971 val
= SYMBOL_NAME (val
);
1972 p
+= esprintf (p
, "%s", SDATA (val
));
1976 val
= SYMBOL_NAME (val
);
1977 p
+= esprintf (p
, "~%s", SDATA (val
));
1981 error ("OTF spec too long");
1985 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1987 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1989 return Fcons (make_number (len
),
1990 make_unibyte_string (device_table
->DeltaValue
, len
));
1994 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
1996 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1998 if (value_format
& OTF_XPlacement
)
1999 ASET (val
, 0, make_number (value_record
->XPlacement
));
2000 if (value_format
& OTF_YPlacement
)
2001 ASET (val
, 1, make_number (value_record
->YPlacement
));
2002 if (value_format
& OTF_XAdvance
)
2003 ASET (val
, 2, make_number (value_record
->XAdvance
));
2004 if (value_format
& OTF_YAdvance
)
2005 ASET (val
, 3, make_number (value_record
->YAdvance
));
2006 if (value_format
& OTF_XPlaDevice
)
2007 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2008 if (value_format
& OTF_YPlaDevice
)
2009 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2010 if (value_format
& OTF_XAdvDevice
)
2011 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2012 if (value_format
& OTF_YAdvDevice
)
2013 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2018 font_otf_Anchor (OTF_Anchor
*anchor
)
2022 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2023 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2024 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2025 if (anchor
->AnchorFormat
== 2)
2026 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2029 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2030 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2034 #endif /* HAVE_LIBOTF */
2040 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2041 static int font_compare (const void *, const void *);
2042 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2046 font_rescale_ratio (Lisp_Object font_entity
)
2048 Lisp_Object tail
, elt
;
2049 Lisp_Object name
= Qnil
;
2051 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2054 if (FLOATP (XCDR (elt
)))
2056 if (STRINGP (XCAR (elt
)))
2059 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2060 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2061 return XFLOAT_DATA (XCDR (elt
));
2063 else if (FONT_SPEC_P (XCAR (elt
)))
2065 if (font_match_p (XCAR (elt
), font_entity
))
2066 return XFLOAT_DATA (XCDR (elt
));
2073 /* We sort fonts by scoring each of them against a specified
2074 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2075 the value is, the closer the font is to the font-spec.
2077 The lowest 2 bits of the score are used for driver type. The font
2078 available by the most preferred font driver is 0.
2080 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2081 WEIGHT, SLANT, WIDTH, and SIZE. */
2083 /* How many bits to shift to store the difference value of each font
2084 property in a score. Note that floats for FONT_TYPE_INDEX and
2085 FONT_REGISTRY_INDEX are not used. */
2086 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2088 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2089 The return value indicates how different ENTITY is compared with
2093 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2098 /* Score three style numeric fields. Maximum difference is 127. */
2099 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2100 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2102 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2103 - (XINT (spec_prop
[i
]) >> 8));
2106 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2109 /* Score the size. Maximum difference is 127. */
2110 i
= FONT_SIZE_INDEX
;
2111 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2112 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2114 /* We use the higher 6-bit for the actual size difference. The
2115 lowest bit is set if the DPI is different. */
2117 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2119 if (CONSP (Vface_font_rescale_alist
))
2120 pixel_size
*= font_rescale_ratio (entity
);
2121 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2125 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2126 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2128 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2129 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2131 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2138 /* Concatenate all elements of LIST into one vector. LIST is a list
2139 of font-entity vectors. */
2142 font_vconcat_entity_vectors (Lisp_Object list
)
2144 int nargs
= XINT (Flength (list
));
2145 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2148 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2149 args
[i
] = XCAR (list
);
2150 return Fvconcat (nargs
, args
);
2154 /* The structure for elements being sorted by qsort. */
2155 struct font_sort_data
2158 int font_driver_preference
;
2163 /* The comparison function for qsort. */
2166 font_compare (const void *d1
, const void *d2
)
2168 const struct font_sort_data
*data1
= d1
;
2169 const struct font_sort_data
*data2
= d2
;
2171 if (data1
->score
< data2
->score
)
2173 else if (data1
->score
> data2
->score
)
2175 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2179 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2180 If PREFER specifies a point-size, calculate the corresponding
2181 pixel-size from QCdpi property of PREFER or from the Y-resolution
2182 of FRAME before sorting.
2184 If BEST-ONLY is nonzero, return the best matching entity (that
2185 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2186 if BEST-ONLY is negative). Otherwise, return the sorted result as
2187 a single vector of font-entities.
2189 This function does no optimization for the case that the total
2190 number of elements is 1. The caller should avoid calling this in
2194 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2196 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2198 struct font_sort_data
*data
;
2199 unsigned best_score
;
2200 Lisp_Object best_entity
;
2201 struct frame
*f
= XFRAME (frame
);
2202 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2205 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2206 prefer_prop
[i
] = AREF (prefer
, i
);
2207 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2208 prefer_prop
[FONT_SIZE_INDEX
]
2209 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2211 if (NILP (XCDR (list
)))
2213 /* What we have to take care of is this single vector. */
2215 maxlen
= ASIZE (vec
);
2219 /* We don't have to perform sort, so there's no need of creating
2220 a single vector. But, we must find the length of the longest
2223 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2224 if (maxlen
< ASIZE (XCAR (tail
)))
2225 maxlen
= ASIZE (XCAR (tail
));
2229 /* We have to create a single vector to sort it. */
2230 vec
= font_vconcat_entity_vectors (list
);
2231 maxlen
= ASIZE (vec
);
2234 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2235 best_score
= 0xFFFFFFFF;
2238 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2240 int font_driver_preference
= 0;
2241 Lisp_Object current_font_driver
;
2247 /* We are sure that the length of VEC > 0. */
2248 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2249 /* Score the elements. */
2250 for (i
= 0; i
< len
; i
++)
2252 data
[i
].entity
= AREF (vec
, i
);
2254 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2256 ? font_score (data
[i
].entity
, prefer_prop
)
2258 if (best_only
&& best_score
> data
[i
].score
)
2260 best_score
= data
[i
].score
;
2261 best_entity
= data
[i
].entity
;
2262 if (best_score
== 0)
2265 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2267 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2268 font_driver_preference
++;
2270 data
[i
].font_driver_preference
= font_driver_preference
;
2273 /* Sort if necessary. */
2276 qsort (data
, len
, sizeof *data
, font_compare
);
2277 for (i
= 0; i
< len
; i
++)
2278 ASET (vec
, i
, data
[i
].entity
);
2287 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2292 /* API of Font Service Layer. */
2294 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2295 sort_shift_bits. Finternal_set_font_selection_order calls this
2296 function with font_sort_order after setting up it. */
2299 font_update_sort_order (int *order
)
2303 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2305 int xlfd_idx
= order
[i
];
2307 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2308 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2309 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2310 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2311 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2312 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2314 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2319 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2324 table
= assq_no_quit (script
, table
);
2327 table
= XCDR (table
);
2328 if (! NILP (langsys
))
2330 table
= assq_no_quit (langsys
, table
);
2336 val
= assq_no_quit (Qnil
, table
);
2338 table
= XCAR (table
);
2342 table
= XCDR (table
);
2343 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2345 if (NILP (XCAR (features
)))
2350 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2356 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2359 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2361 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2363 script
= XCAR (spec
);
2367 langsys
= XCAR (spec
);
2378 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2379 XCAR (otf_capability
)))
2381 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2382 XCDR (otf_capability
)))
2389 /* Check if FONT (font-entity or font-object) matches with the font
2390 specification SPEC. */
2393 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2395 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2396 Lisp_Object extra
, font_extra
;
2399 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2400 if (! NILP (AREF (spec
, i
))
2401 && ! NILP (AREF (font
, i
))
2402 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2404 props
= XFONT_SPEC (spec
)->props
;
2405 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2407 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2408 prop
[i
] = AREF (spec
, i
);
2409 prop
[FONT_SIZE_INDEX
]
2410 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2414 if (font_score (font
, props
) > 0)
2416 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2417 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2418 for (; CONSP (extra
); extra
= XCDR (extra
))
2420 Lisp_Object key
= XCAR (XCAR (extra
));
2421 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2423 if (EQ (key
, QClang
))
2425 val2
= assq_no_quit (key
, font_extra
);
2434 if (NILP (Fmemq (val
, val2
)))
2439 ? NILP (Fmemq (val
, XCDR (val2
)))
2443 else if (EQ (key
, QCscript
))
2445 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2451 /* All characters in the list must be supported. */
2452 for (; CONSP (val2
); val2
= XCDR (val2
))
2454 if (! CHARACTERP (XCAR (val2
)))
2456 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2457 == FONT_INVALID_CODE
)
2461 else if (VECTORP (val2
))
2463 /* At most one character in the vector must be supported. */
2464 for (i
= 0; i
< ASIZE (val2
); i
++)
2466 if (! CHARACTERP (AREF (val2
, i
)))
2468 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2469 != FONT_INVALID_CODE
)
2472 if (i
== ASIZE (val2
))
2477 else if (EQ (key
, QCotf
))
2481 if (! FONT_OBJECT_P (font
))
2483 fontp
= XFONT_OBJECT (font
);
2484 if (! fontp
->driver
->otf_capability
)
2486 val2
= fontp
->driver
->otf_capability (fontp
);
2487 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2498 Each font backend has the callback function get_cache, and it
2499 returns a cons cell of which cdr part can be freely used for
2500 caching fonts. The cons cell may be shared by multiple frames
2501 and/or multiple font drivers. So, we arrange the cdr part as this:
2503 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2505 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2506 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2507 cons (FONT-SPEC FONT-ENTITY ...). */
2509 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2510 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2511 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2512 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2513 struct font_driver
*);
2516 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2518 Lisp_Object cache
, val
;
2520 cache
= driver
->get_cache (f
);
2522 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2526 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2527 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2531 val
= XCDR (XCAR (val
));
2532 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2538 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2540 Lisp_Object cache
, val
, tmp
;
2543 cache
= driver
->get_cache (f
);
2545 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2546 cache
= val
, val
= XCDR (val
);
2547 font_assert (! NILP (val
));
2548 tmp
= XCDR (XCAR (val
));
2549 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2550 if (XINT (XCAR (tmp
)) == 0)
2552 font_clear_cache (f
, XCAR (val
), driver
);
2553 XSETCDR (cache
, XCDR (val
));
2559 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2561 Lisp_Object val
= driver
->get_cache (f
);
2562 Lisp_Object type
= driver
->type
;
2564 font_assert (CONSP (val
));
2565 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2566 font_assert (CONSP (val
));
2567 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2568 val
= XCDR (XCAR (val
));
2572 static int num_fonts
;
2575 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2577 Lisp_Object tail
, elt
;
2578 Lisp_Object tail2
, entity
;
2580 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2581 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2584 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2585 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2587 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2589 entity
= XCAR (tail2
);
2591 if (FONT_ENTITY_P (entity
)
2592 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2594 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2596 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2598 Lisp_Object val
= XCAR (objlist
);
2599 struct font
*font
= XFONT_OBJECT (val
);
2601 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2603 font_assert (font
&& driver
== font
->driver
);
2604 driver
->close (f
, font
);
2608 if (driver
->free_entity
)
2609 driver
->free_entity (entity
);
2614 XSETCDR (cache
, Qnil
);
2618 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2620 /* Check each font-entity in VEC, and return a list of font-entities
2621 that satisfy these conditions:
2622 (1) matches with SPEC and SIZE if SPEC is not nil, and
2623 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2627 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2629 Lisp_Object entity
, val
;
2630 enum font_property_index prop
;
2633 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2635 entity
= AREF (vec
, i
);
2636 if (! NILP (Vface_ignored_fonts
))
2640 Lisp_Object tail
, regexp
;
2642 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2645 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2647 regexp
= XCAR (tail
);
2648 if (STRINGP (regexp
)
2649 && fast_c_string_match_ignore_case (regexp
, name
,
2659 val
= Fcons (entity
, val
);
2662 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2663 if (INTEGERP (AREF (spec
, prop
))
2664 && ((XINT (AREF (spec
, prop
)) >> 8)
2665 != (XINT (AREF (entity
, prop
)) >> 8)))
2666 prop
= FONT_SPEC_MAX
;
2667 if (prop
< FONT_SPEC_MAX
2669 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2671 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2674 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2675 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2676 prop
= FONT_SPEC_MAX
;
2678 if (prop
< FONT_SPEC_MAX
2679 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2680 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2681 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2682 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2683 prop
= FONT_SPEC_MAX
;
2684 if (prop
< FONT_SPEC_MAX
2685 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2686 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2687 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2688 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2689 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2690 prop
= FONT_SPEC_MAX
;
2691 if (prop
< FONT_SPEC_MAX
)
2692 val
= Fcons (entity
, val
);
2694 return (Fvconcat (1, &val
));
2698 /* Return a list of vectors of font-entities matching with SPEC on
2699 FRAME. Each elements in the list is a vector of entities from the
2700 same font-driver. */
2703 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2705 FRAME_PTR f
= XFRAME (frame
);
2706 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2707 Lisp_Object ftype
, val
;
2708 Lisp_Object list
= Qnil
;
2710 int need_filtering
= 0;
2713 font_assert (FONT_SPEC_P (spec
));
2715 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2716 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2717 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2718 size
= font_pixel_size (f
, spec
);
2722 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2723 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2724 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2725 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2726 if (i
!= FONT_SPACING_INDEX
)
2728 ASET (scratch_font_spec
, i
, Qnil
);
2729 if (! NILP (AREF (spec
, i
)))
2732 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2733 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2735 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2737 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2739 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2741 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2742 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2749 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2753 val
= Fvconcat (1, &val
);
2754 copy
= copy_font_spec (scratch_font_spec
);
2755 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2756 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2760 || ! NILP (Vface_ignored_fonts
)))
2761 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2762 if (ASIZE (val
) > 0)
2763 list
= Fcons (val
, list
);
2766 list
= Fnreverse (list
);
2767 FONT_ADD_LOG ("list", spec
, list
);
2772 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2773 nil, is an array of face's attributes, which specifies preferred
2774 font-related attributes. */
2777 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2779 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2780 Lisp_Object ftype
, size
, entity
;
2782 Lisp_Object work
= copy_font_spec (spec
);
2784 XSETFRAME (frame
, f
);
2785 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2786 size
= AREF (spec
, FONT_SIZE_INDEX
);
2789 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2790 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2791 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2792 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2795 for (; driver_list
; driver_list
= driver_list
->next
)
2797 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2799 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2802 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2803 entity
= assoc_no_quit (work
, XCDR (cache
));
2805 entity
= XCDR (entity
);
2808 entity
= driver_list
->driver
->match (frame
, work
);
2809 copy
= copy_font_spec (work
);
2810 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2811 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2813 if (! NILP (entity
))
2816 FONT_ADD_LOG ("match", work
, entity
);
2821 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2822 opened font object. */
2825 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2827 struct font_driver_list
*driver_list
;
2828 Lisp_Object objlist
, size
, val
, font_object
;
2830 int min_width
, height
;
2831 int scaled_pixel_size
= pixel_size
;
2833 font_assert (FONT_ENTITY_P (entity
));
2834 size
= AREF (entity
, FONT_SIZE_INDEX
);
2835 if (XINT (size
) != 0)
2836 scaled_pixel_size
= pixel_size
= XINT (size
);
2837 else if (CONSP (Vface_font_rescale_alist
))
2838 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2840 val
= AREF (entity
, FONT_TYPE_INDEX
);
2841 for (driver_list
= f
->font_driver_list
;
2842 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2843 driver_list
= driver_list
->next
);
2847 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2848 objlist
= XCDR (objlist
))
2850 Lisp_Object fn
= XCAR (objlist
);
2851 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2852 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2854 if (driver_list
->driver
->cached_font_ok
== NULL
2855 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2860 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2861 if (!NILP (font_object
))
2862 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2863 FONT_ADD_LOG ("open", entity
, font_object
);
2864 if (NILP (font_object
))
2866 ASET (entity
, FONT_OBJLIST_INDEX
,
2867 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2870 font
= XFONT_OBJECT (font_object
);
2871 min_width
= (font
->min_width
? font
->min_width
2872 : font
->average_width
? font
->average_width
2873 : font
->space_width
? font
->space_width
2875 height
= (font
->height
? font
->height
: 1);
2876 #ifdef HAVE_WINDOW_SYSTEM
2877 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2878 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2880 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2881 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2882 fonts_changed_p
= 1;
2886 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2887 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2888 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2889 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2897 /* Close FONT_OBJECT that is opened on frame F. */
2900 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2902 struct font
*font
= XFONT_OBJECT (font_object
);
2904 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2905 /* Already closed. */
2907 FONT_ADD_LOG ("close", font_object
, Qnil
);
2908 font
->driver
->close (f
, font
);
2909 #ifdef HAVE_WINDOW_SYSTEM
2910 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2911 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2917 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2918 FONT is a font-entity and it must be opened to check. */
2921 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2925 if (FONT_ENTITY_P (font
))
2927 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2928 struct font_driver_list
*driver_list
;
2930 for (driver_list
= f
->font_driver_list
;
2931 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2932 driver_list
= driver_list
->next
);
2935 if (! driver_list
->driver
->has_char
)
2937 return driver_list
->driver
->has_char (font
, c
);
2940 font_assert (FONT_OBJECT_P (font
));
2941 fontp
= XFONT_OBJECT (font
);
2942 if (fontp
->driver
->has_char
)
2944 int result
= fontp
->driver
->has_char (font
, c
);
2949 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2953 /* Return the glyph ID of FONT_OBJECT for character C. */
2956 font_encode_char (Lisp_Object font_object
, int c
)
2960 font_assert (FONT_OBJECT_P (font_object
));
2961 font
= XFONT_OBJECT (font_object
);
2962 return font
->driver
->encode_char (font
, c
);
2966 /* Return the name of FONT_OBJECT. */
2969 font_get_name (Lisp_Object font_object
)
2971 font_assert (FONT_OBJECT_P (font_object
));
2972 return AREF (font_object
, FONT_NAME_INDEX
);
2976 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2977 could not be parsed by font_parse_name, return Qnil. */
2980 font_spec_from_name (Lisp_Object font_name
)
2982 Lisp_Object spec
= Ffont_spec (0, NULL
);
2984 CHECK_STRING (font_name
);
2985 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2987 font_put_extra (spec
, QCname
, font_name
);
2988 font_put_extra (spec
, QCuser_spec
, font_name
);
2994 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
2996 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3001 if (! NILP (Ffont_get (font
, QCname
)))
3003 font
= copy_font_spec (font
);
3004 font_put_extra (font
, QCname
, Qnil
);
3007 if (NILP (AREF (font
, prop
))
3008 && prop
!= FONT_FAMILY_INDEX
3009 && prop
!= FONT_FOUNDRY_INDEX
3010 && prop
!= FONT_WIDTH_INDEX
3011 && prop
!= FONT_SIZE_INDEX
)
3013 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3014 font
= copy_font_spec (font
);
3015 ASET (font
, prop
, Qnil
);
3016 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3018 if (prop
== FONT_FAMILY_INDEX
)
3020 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3021 /* If we are setting the font family, we must also clear
3022 FONT_WIDTH_INDEX to avoid rejecting families that lack
3023 support for some widths. */
3024 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3026 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3027 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3028 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3029 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3030 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3031 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3033 else if (prop
== FONT_SIZE_INDEX
)
3035 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3036 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3037 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3039 else if (prop
== FONT_WIDTH_INDEX
)
3040 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3041 attrs
[LFACE_FONT_INDEX
] = font
;
3044 /* Select a font from ENTITIES (list of font-entity vectors) that
3045 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3048 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3050 Lisp_Object font_entity
;
3053 FRAME_PTR f
= XFRAME (frame
);
3055 if (NILP (XCDR (entities
))
3056 && ASIZE (XCAR (entities
)) == 1)
3058 font_entity
= AREF (XCAR (entities
), 0);
3060 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3065 /* Sort fonts by properties specified in ATTRS. */
3066 prefer
= scratch_font_prefer
;
3068 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3069 ASET (prefer
, i
, Qnil
);
3070 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3072 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3074 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3075 ASET (prefer
, i
, AREF (face_font
, i
));
3077 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3078 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3079 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3080 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3081 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3082 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3083 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3085 return font_sort_entities (entities
, prefer
, frame
, c
);
3088 /* Return a font-entity that satisfies SPEC and is the best match for
3089 face's font related attributes in ATTRS. C, if not negative, is a
3090 character that the entity must support. */
3093 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3096 Lisp_Object frame
, entities
, val
;
3097 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3102 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3103 if (NILP (registry
[0]))
3105 registry
[0] = DEFAULT_ENCODING
;
3106 registry
[1] = Qascii_0
;
3107 registry
[2] = null_vector
;
3110 registry
[1] = null_vector
;
3112 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3114 struct charset
*encoding
, *repertory
;
3116 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3117 &encoding
, &repertory
) < 0)
3120 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3122 else if (c
> encoding
->max_char
)
3126 work
= copy_font_spec (spec
);
3127 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3128 XSETFRAME (frame
, f
);
3129 pixel_size
= font_pixel_size (f
, spec
);
3130 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3132 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3134 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3136 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3137 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3138 if (! NILP (foundry
[0]))
3139 foundry
[1] = null_vector
;
3140 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3142 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3143 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3145 foundry
[2] = null_vector
;
3148 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3150 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3151 if (! NILP (adstyle
[0]))
3152 adstyle
[1] = null_vector
;
3153 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3155 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3157 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3159 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3161 adstyle
[2] = null_vector
;
3164 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3167 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3170 val
= AREF (work
, FONT_FAMILY_INDEX
);
3171 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3173 val
= attrs
[LFACE_FAMILY_INDEX
];
3174 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3178 family
= alloca ((sizeof family
[0]) * 2);
3180 family
[1] = null_vector
; /* terminator. */
3185 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3187 if (! NILP (alters
))
3189 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3190 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3191 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3192 family
[i
] = XCAR (alters
);
3193 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3195 family
[i
] = null_vector
;
3199 family
= alloca ((sizeof family
[0]) * 3);
3202 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3204 family
[i
] = null_vector
;
3208 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3210 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3211 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3213 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3214 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3216 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3217 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3219 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3220 entities
= font_list_entities (frame
, work
);
3221 if (! NILP (entities
))
3223 val
= font_select_entity (frame
, entities
,
3224 attrs
, pixel_size
, c
);
3239 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3243 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3244 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3245 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3246 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3247 size
= font_pixel_size (f
, spec
);
3251 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3252 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3255 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3256 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3257 if (INTEGERP (height
))
3260 abort (); /* We should never end up here. */
3264 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3268 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3269 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3273 return font_open_entity (f
, entity
, size
);
3277 /* Find a font that satisfies SPEC and is the best match for
3278 face's attributes in ATTRS on FRAME, and return the opened
3282 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3284 Lisp_Object entity
, name
;
3286 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3289 /* No font is listed for SPEC, but each font-backend may have
3290 different criteria about "font matching". So, try it. */
3291 entity
= font_matching_entity (f
, attrs
, spec
);
3295 /* Don't lose the original name that was put in initially. We need
3296 it to re-apply the font when font parameters (like hinting or dpi) have
3298 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3301 name
= Ffont_get (spec
, QCuser_spec
);
3302 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3308 /* Make FACE on frame F ready to use the font opened for FACE. */
3311 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3313 if (face
->font
->driver
->prepare_face
)
3314 face
->font
->driver
->prepare_face (f
, face
);
3318 /* Make FACE on frame F stop using the font opened for FACE. */
3321 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3323 if (face
->font
->driver
->done_face
)
3324 face
->font
->driver
->done_face (f
, face
);
3329 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3330 font is found, return Qnil. */
3333 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3335 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3337 /* We set up the default font-related attributes of a face to prefer
3339 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3340 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3341 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3343 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3345 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3347 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3349 return font_load_for_lface (f
, attrs
, spec
);
3353 /* Open a font that matches NAME on frame F. If no proper font is
3354 found, return Qnil. */
3357 font_open_by_name (FRAME_PTR f
, const char *name
, ptrdiff_t len
)
3359 Lisp_Object args
[2];
3360 Lisp_Object spec
, ret
;
3363 args
[1] = make_unibyte_string (name
, len
);
3364 spec
= Ffont_spec (2, args
);
3365 ret
= font_open_by_spec (f
, spec
);
3366 /* Do not lose name originally put in. */
3368 font_put_extra (ret
, QCuser_spec
, args
[1]);
3374 /* Register font-driver DRIVER. This function is used in two ways.
3376 The first is with frame F non-NULL. In this case, make DRIVER
3377 available (but not yet activated) on F. All frame creators
3378 (e.g. Fx_create_frame) must call this function at least once with
3379 an available font-driver.
3381 The second is with frame F NULL. In this case, DRIVER is globally
3382 registered in the variable `font_driver_list'. All font-driver
3383 implementations must call this function in its syms_of_XXXX
3384 (e.g. syms_of_xfont). */
3387 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3389 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3390 struct font_driver_list
*prev
, *list
;
3392 if (f
&& ! driver
->draw
)
3393 error ("Unusable font driver for a frame: %s",
3394 SDATA (SYMBOL_NAME (driver
->type
)));
3396 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3397 if (EQ (list
->driver
->type
, driver
->type
))
3398 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3400 list
= xmalloc (sizeof *list
);
3402 list
->driver
= driver
;
3407 f
->font_driver_list
= list
;
3409 font_driver_list
= list
;
3415 free_font_driver_list (FRAME_PTR f
)
3417 struct font_driver_list
*list
, *next
;
3419 for (list
= f
->font_driver_list
; list
; list
= next
)
3424 f
->font_driver_list
= NULL
;
3428 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3429 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3430 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3432 A caller must free all realized faces if any in advance. The
3433 return value is a list of font backends actually made used on
3437 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3439 Lisp_Object active_drivers
= Qnil
;
3440 struct font_driver_list
*list
;
3442 /* At first, turn off non-requested drivers, and turn on requested
3444 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3446 struct font_driver
*driver
= list
->driver
;
3447 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3452 if (driver
->end_for_frame
)
3453 driver
->end_for_frame (f
);
3454 font_finish_cache (f
, driver
);
3459 if (! driver
->start_for_frame
3460 || driver
->start_for_frame (f
) == 0)
3462 font_prepare_cache (f
, driver
);
3469 if (NILP (new_drivers
))
3472 if (! EQ (new_drivers
, Qt
))
3474 /* Re-order the driver list according to new_drivers. */
3475 struct font_driver_list
**list_table
, **next
;
3479 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3480 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3482 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3483 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3486 list_table
[i
++] = list
;
3488 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3490 list_table
[i
++] = list
;
3491 list_table
[i
] = NULL
;
3493 next
= &f
->font_driver_list
;
3494 for (i
= 0; list_table
[i
]; i
++)
3496 *next
= list_table
[i
];
3497 next
= &(*next
)->next
;
3501 if (! f
->font_driver_list
->on
)
3502 { /* None of the drivers is enabled: enable them all.
3503 Happens if you set the list of drivers to (xft x) in your .emacs
3504 and then use it under w32 or ns. */
3505 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3507 struct font_driver
*driver
= list
->driver
;
3508 eassert (! list
->on
);
3509 if (! driver
->start_for_frame
3510 || driver
->start_for_frame (f
) == 0)
3512 font_prepare_cache (f
, driver
);
3519 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3521 active_drivers
= nconc2 (active_drivers
,
3522 Fcons (list
->driver
->type
, Qnil
));
3523 return active_drivers
;
3527 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3529 struct font_data_list
*list
, *prev
;
3531 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3532 prev
= list
, list
= list
->next
)
3533 if (list
->driver
== driver
)
3540 prev
->next
= list
->next
;
3542 f
->font_data_list
= list
->next
;
3550 list
= xmalloc (sizeof *list
);
3551 list
->driver
= driver
;
3552 list
->next
= f
->font_data_list
;
3553 f
->font_data_list
= list
;
3561 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3563 struct font_data_list
*list
;
3565 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3566 if (list
->driver
== driver
)
3574 /* Sets attributes on a font. Any properties that appear in ALIST and
3575 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3576 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3577 arrays of strings. This function is intended for use by the font
3578 drivers to implement their specific font_filter_properties. */
3580 font_filter_properties (Lisp_Object font
,
3582 const char *const boolean_properties
[],
3583 const char *const non_boolean_properties
[])
3588 /* Set boolean values to Qt or Qnil */
3589 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3590 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3592 Lisp_Object key
= XCAR (XCAR (it
));
3593 Lisp_Object val
= XCDR (XCAR (it
));
3594 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3596 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3598 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3599 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3602 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3603 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3604 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3605 || strcmp ("Off", str
) == 0)
3610 Ffont_put (font
, key
, val
);
3614 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3615 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3617 Lisp_Object key
= XCAR (XCAR (it
));
3618 Lisp_Object val
= XCDR (XCAR (it
));
3619 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3620 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3621 Ffont_put (font
, key
, val
);
3626 /* Return the font used to draw character C by FACE at buffer position
3627 POS in window W. If STRING is non-nil, it is a string containing C
3628 at index POS. If C is negative, get C from the current buffer or
3632 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3637 Lisp_Object font_object
;
3639 multibyte
= (NILP (string
)
3640 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3641 : STRING_MULTIBYTE (string
));
3648 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3650 c
= FETCH_CHAR (pos_byte
);
3653 c
= FETCH_BYTE (pos
);
3659 multibyte
= STRING_MULTIBYTE (string
);
3662 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3664 str
= SDATA (string
) + pos_byte
;
3665 c
= STRING_CHAR (str
);
3668 c
= SDATA (string
)[pos
];
3672 f
= XFRAME (w
->frame
);
3673 if (! FRAME_WINDOW_P (f
))
3680 if (STRINGP (string
))
3681 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3682 DEFAULT_FACE_ID
, 0);
3684 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3686 face
= FACE_FROM_ID (f
, face_id
);
3690 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3691 face
= FACE_FROM_ID (f
, face_id
);
3696 XSETFONT (font_object
, face
->font
);
3701 #ifdef HAVE_WINDOW_SYSTEM
3703 /* Check how many characters after POS (at most to *LIMIT) can be
3704 displayed by the same font in the window W. FACE, if non-NULL, is
3705 the face selected for the character at POS. If STRING is not nil,
3706 it is the string to check instead of the current buffer. In that
3707 case, FACE must be not NULL.
3709 The return value is the font-object for the character at POS.
3710 *LIMIT is set to the position where that font can't be used.
3712 It is assured that the current buffer (or STRING) is multibyte. */
3715 font_range (ptrdiff_t pos
, ptrdiff_t *limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3717 ptrdiff_t pos_byte
, ignore
;
3719 Lisp_Object font_object
= Qnil
;
3723 pos_byte
= CHAR_TO_BYTE (pos
);
3728 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3730 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3736 pos_byte
= string_char_to_byte (string
, pos
);
3739 while (pos
< *limit
)
3741 Lisp_Object category
;
3744 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3746 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3747 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3748 if (INTEGERP (category
)
3749 && (XINT (category
) == UNICODE_CATEGORY_Cf
3750 || CHAR_VARIATION_SELECTOR_P (c
)))
3752 if (NILP (font_object
))
3754 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3755 if (NILP (font_object
))
3759 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3769 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3770 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3771 Return nil otherwise.
3772 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3773 which kind of font it is. It must be one of `font-spec', `font-entity',
3775 (Lisp_Object object
, Lisp_Object extra_type
)
3777 if (NILP (extra_type
))
3778 return (FONTP (object
) ? Qt
: Qnil
);
3779 if (EQ (extra_type
, Qfont_spec
))
3780 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3781 if (EQ (extra_type
, Qfont_entity
))
3782 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3783 if (EQ (extra_type
, Qfont_object
))
3784 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3785 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3788 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3789 doc
: /* Return a newly created font-spec with arguments as properties.
3791 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3792 valid font property name listed below:
3794 `:family', `:weight', `:slant', `:width'
3796 They are the same as face attributes of the same name. See
3797 `set-face-attribute'.
3801 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3805 VALUE must be a string or a symbol specifying the additional
3806 typographic style information of a font, e.g. ``sans''.
3810 VALUE must be a string or a symbol specifying the charset registry and
3811 encoding of a font, e.g. ``iso8859-1''.
3815 VALUE must be a non-negative integer or a floating point number
3816 specifying the font size. It specifies the font size in pixels (if
3817 VALUE is an integer), or in points (if VALUE is a float).
3821 VALUE must be a string of XLFD-style or fontconfig-style font name.
3825 VALUE must be a symbol representing a script that the font must
3826 support. It may be a symbol representing a subgroup of a script
3827 listed in the variable `script-representative-chars'.
3831 VALUE must be a symbol of two-letter ISO-639 language names,
3836 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3837 required OpenType features.
3839 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3840 LANGSYS-TAG: OpenType language system tag symbol,
3841 or nil for the default language system.
3842 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3843 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3845 GSUB and GPOS may contain `nil' element. In such a case, the font
3846 must not have any of the remaining elements.
3848 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3849 be an OpenType font whose GPOS table of `thai' script's default
3850 language system must contain `mark' feature.
3852 usage: (font-spec ARGS...) */)
3853 (ptrdiff_t nargs
, Lisp_Object
*args
)
3855 Lisp_Object spec
= font_make_spec ();
3858 for (i
= 0; i
< nargs
; i
+= 2)
3860 Lisp_Object key
= args
[i
], val
;
3864 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3867 if (EQ (key
, QCname
))
3870 font_parse_name (SSDATA (val
), SBYTES (val
), spec
);
3871 font_put_extra (spec
, key
, val
);
3875 int idx
= get_font_prop_index (key
);
3879 val
= font_prop_validate (idx
, Qnil
, val
);
3880 if (idx
< FONT_EXTRA_INDEX
)
3881 ASET (spec
, idx
, val
);
3883 font_put_extra (spec
, key
, val
);
3886 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3892 /* Return a copy of FONT as a font-spec. */
3894 copy_font_spec (Lisp_Object font
)
3896 Lisp_Object new_spec
, tail
, prev
, extra
;
3900 new_spec
= font_make_spec ();
3901 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3902 ASET (new_spec
, i
, AREF (font
, i
));
3903 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3904 /* We must remove :font-entity property. */
3905 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3906 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3909 extra
= XCDR (extra
);
3911 XSETCDR (prev
, XCDR (tail
));
3914 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3918 /* Merge font-specs FROM and TO, and return a new font-spec.
3919 Every specified property in FROM overrides the corresponding
3922 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3924 Lisp_Object extra
, tail
;
3929 to
= copy_font_spec (to
);
3930 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3931 ASET (to
, i
, AREF (from
, i
));
3932 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3933 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3934 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3936 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3939 XSETCDR (slot
, XCDR (XCAR (tail
)));
3941 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3943 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3947 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3948 doc
: /* Return the value of FONT's property KEY.
3949 FONT is a font-spec, a font-entity, or a font-object.
3950 KEY is any symbol, but these are reserved for specific meanings:
3951 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3952 :size, :name, :script, :otf
3953 See the documentation of `font-spec' for their meanings.
3954 In addition, if FONT is a font-entity or a font-object, values of
3955 :script and :otf are different from those of a font-spec as below:
3957 The value of :script may be a list of scripts that are supported by the font.
3959 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3960 representing the OpenType features supported by the font by this form:
3961 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3962 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3964 (Lisp_Object font
, Lisp_Object key
)
3972 idx
= get_font_prop_index (key
);
3973 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3974 return font_style_symbolic (font
, idx
, 0);
3975 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3976 return AREF (font
, idx
);
3977 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3978 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3980 struct font
*fontp
= XFONT_OBJECT (font
);
3982 if (fontp
->driver
->otf_capability
)
3983 val
= fontp
->driver
->otf_capability (fontp
);
3985 val
= Fcons (Qnil
, Qnil
);
3992 #ifdef HAVE_WINDOW_SYSTEM
3994 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3995 doc
: /* Return a plist of face attributes generated by FONT.
3996 FONT is a font name, a font-spec, a font-entity, or a font-object.
3997 The return value is a list of the form
3999 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4001 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4002 compatible with `set-face-attribute'. Some of these key-attribute pairs
4003 may be omitted from the list if they are not specified by FONT.
4005 The optional argument FRAME specifies the frame that the face attributes
4006 are to be displayed on. If omitted, the selected frame is used. */)
4007 (Lisp_Object font
, Lisp_Object frame
)
4010 Lisp_Object plist
[10];
4015 frame
= selected_frame
;
4016 CHECK_LIVE_FRAME (frame
);
4021 int fontset
= fs_query_fontset (font
, 0);
4022 Lisp_Object name
= font
;
4024 font
= fontset_ascii (fontset
);
4025 font
= font_spec_from_name (name
);
4027 signal_error ("Invalid font name", name
);
4029 else if (! FONTP (font
))
4030 signal_error ("Invalid font object", font
);
4032 val
= AREF (font
, FONT_FAMILY_INDEX
);
4035 plist
[n
++] = QCfamily
;
4036 plist
[n
++] = SYMBOL_NAME (val
);
4039 val
= AREF (font
, FONT_SIZE_INDEX
);
4042 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4043 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4044 plist
[n
++] = QCheight
;
4045 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4047 else if (FLOATP (val
))
4049 plist
[n
++] = QCheight
;
4050 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4053 val
= FONT_WEIGHT_FOR_FACE (font
);
4056 plist
[n
++] = QCweight
;
4060 val
= FONT_SLANT_FOR_FACE (font
);
4063 plist
[n
++] = QCslant
;
4067 val
= FONT_WIDTH_FOR_FACE (font
);
4070 plist
[n
++] = QCwidth
;
4074 return Flist (n
, plist
);
4079 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4080 doc
: /* Set one property of FONT: give property KEY value VAL.
4081 FONT is a font-spec, a font-entity, or a font-object.
4083 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4084 accepted by the function `font-spec' (which see), VAL must be what
4085 allowed in `font-spec'.
4087 If FONT is a font-entity or a font-object, KEY must not be the one
4088 accepted by `font-spec'. */)
4089 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4093 idx
= get_font_prop_index (prop
);
4094 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4096 CHECK_FONT_SPEC (font
);
4097 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4101 if (EQ (prop
, QCname
)
4102 || EQ (prop
, QCscript
)
4103 || EQ (prop
, QClang
)
4104 || EQ (prop
, QCotf
))
4105 CHECK_FONT_SPEC (font
);
4108 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4113 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4114 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4115 Optional 2nd argument FRAME specifies the target frame.
4116 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4117 Optional 4th argument PREFER, if non-nil, is a font-spec to
4118 control the order of the returned list. Fonts are sorted by
4119 how close they are to PREFER. */)
4120 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4122 Lisp_Object vec
, list
;
4126 frame
= selected_frame
;
4127 CHECK_LIVE_FRAME (frame
);
4128 CHECK_FONT_SPEC (font_spec
);
4136 if (! NILP (prefer
))
4137 CHECK_FONT_SPEC (prefer
);
4139 list
= font_list_entities (frame
, font_spec
);
4142 if (NILP (XCDR (list
))
4143 && ASIZE (XCAR (list
)) == 1)
4144 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4146 if (! NILP (prefer
))
4147 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4149 vec
= font_vconcat_entity_vectors (list
);
4150 if (n
== 0 || n
>= ASIZE (vec
))
4152 Lisp_Object args
[2];
4156 list
= Fappend (2, args
);
4160 for (list
= Qnil
, n
--; n
>= 0; n
--)
4161 list
= Fcons (AREF (vec
, n
), list
);
4166 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4167 doc
: /* List available font families on the current frame.
4168 Optional argument FRAME, if non-nil, specifies the target frame. */)
4172 struct font_driver_list
*driver_list
;
4176 frame
= selected_frame
;
4177 CHECK_LIVE_FRAME (frame
);
4180 for (driver_list
= f
->font_driver_list
; driver_list
;
4181 driver_list
= driver_list
->next
)
4182 if (driver_list
->driver
->list_family
)
4184 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4185 Lisp_Object tail
= list
;
4187 for (; CONSP (val
); val
= XCDR (val
))
4188 if (NILP (Fmemq (XCAR (val
), tail
))
4189 && SYMBOLP (XCAR (val
)))
4190 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4195 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4196 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4197 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4198 (Lisp_Object font_spec
, Lisp_Object frame
)
4200 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4207 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4208 doc
: /* Return XLFD name of FONT.
4209 FONT is a font-spec, font-entity, or font-object.
4210 If the name is too long for XLFD (maximum 255 chars), return nil.
4211 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4212 the consecutive wildcards are folded into one. */)
4213 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4216 int namelen
, pixel_size
= 0;
4220 if (FONT_OBJECT_P (font
))
4222 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4224 if (STRINGP (font_name
)
4225 && SDATA (font_name
)[0] == '-')
4227 if (NILP (fold_wildcards
))
4229 strcpy (name
, SSDATA (font_name
));
4230 namelen
= SBYTES (font_name
);
4233 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4235 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4239 if (! NILP (fold_wildcards
))
4241 char *p0
= name
, *p1
;
4243 while ((p1
= strstr (p0
, "-*-*")))
4245 strcpy (p1
, p1
+ 2);
4251 return make_string (name
, namelen
);
4254 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4255 doc
: /* Clear font cache. */)
4258 Lisp_Object list
, frame
;
4260 FOR_EACH_FRAME (list
, frame
)
4262 FRAME_PTR f
= XFRAME (frame
);
4263 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4265 for (; driver_list
; driver_list
= driver_list
->next
)
4266 if (driver_list
->on
)
4268 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4269 Lisp_Object val
, tmp
;
4273 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4275 font_assert (! NILP (val
));
4276 tmp
= XCDR (XCAR (val
));
4277 if (XINT (XCAR (tmp
)) == 0)
4279 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4280 XSETCDR (cache
, XCDR (val
));
4290 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4292 struct font
*font
= XFONT_OBJECT (font_object
);
4293 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4294 struct font_metrics metrics
;
4296 LGLYPH_SET_CODE (glyph
, code
);
4297 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4298 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4299 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4300 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4301 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4302 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4306 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4307 doc
: /* Shape the glyph-string GSTRING.
4308 Shaping means substituting glyphs and/or adjusting positions of glyphs
4309 to get the correct visual image of character sequences set in the
4310 header of the glyph-string.
4312 If the shaping was successful, the value is GSTRING itself or a newly
4313 created glyph-string. Otherwise, the value is nil. */)
4314 (Lisp_Object gstring
)
4317 Lisp_Object font_object
, n
, glyph
;
4318 ptrdiff_t i
, j
, from
, to
;
4320 if (! composition_gstring_p (gstring
))
4321 signal_error ("Invalid glyph-string: ", gstring
);
4322 if (! NILP (LGSTRING_ID (gstring
)))
4324 font_object
= LGSTRING_FONT (gstring
);
4325 CHECK_FONT_OBJECT (font_object
);
4326 font
= XFONT_OBJECT (font_object
);
4327 if (! font
->driver
->shape
)
4330 /* Try at most three times with larger gstring each time. */
4331 for (i
= 0; i
< 3; i
++)
4333 n
= font
->driver
->shape (gstring
);
4336 gstring
= larger_vector (gstring
,
4337 LGSTRING_GLYPH_LEN (gstring
), -1);
4339 if (i
== 3 || XINT (n
) == 0)
4341 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4342 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4344 glyph
= LGSTRING_GLYPH (gstring
, 0);
4345 from
= LGLYPH_FROM (glyph
);
4346 to
= LGLYPH_TO (glyph
);
4347 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4349 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4353 if (NILP (LGLYPH_ADJUSTMENT (this)))
4358 glyph
= LGSTRING_GLYPH (gstring
, j
);
4359 LGLYPH_SET_FROM (glyph
, from
);
4360 LGLYPH_SET_TO (glyph
, to
);
4362 from
= LGLYPH_FROM (this);
4363 to
= LGLYPH_TO (this);
4368 if (from
> LGLYPH_FROM (this))
4369 from
= LGLYPH_FROM (this);
4370 if (to
< LGLYPH_TO (this))
4371 to
= LGLYPH_TO (this);
4377 glyph
= LGSTRING_GLYPH (gstring
, j
);
4378 LGLYPH_SET_FROM (glyph
, from
);
4379 LGLYPH_SET_TO (glyph
, to
);
4381 return composition_gstring_put_cache (gstring
, XINT (n
));
4384 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4386 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4387 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4389 VARIATION-SELECTOR is a character code of variation selection
4390 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4391 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4392 (Lisp_Object font_object
, Lisp_Object character
)
4394 unsigned variations
[256];
4399 CHECK_FONT_OBJECT (font_object
);
4400 CHECK_CHARACTER (character
);
4401 font
= XFONT_OBJECT (font_object
);
4402 if (! font
->driver
->get_variation_glyphs
)
4404 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4408 for (i
= 0; i
< 255; i
++)
4411 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4412 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4413 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4420 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4421 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4422 OTF-FEATURES specifies which features to apply in this format:
4423 (SCRIPT LANGSYS GSUB GPOS)
4425 SCRIPT is a symbol specifying a script tag of OpenType,
4426 LANGSYS is a symbol specifying a langsys tag of OpenType,
4427 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4429 If LANGYS is nil, the default langsys is selected.
4431 The features are applied in the order they appear in the list. The
4432 symbol `*' means to apply all available features not present in this
4433 list, and the remaining features are ignored. For instance, (vatu
4434 pstf * haln) is to apply vatu and pstf in this order, then to apply
4435 all available features other than vatu, pstf, and haln.
4437 The features are applied to the glyphs in the range FROM and TO of
4438 the glyph-string GSTRING-IN.
4440 If some feature is actually applicable, the resulting glyphs are
4441 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4442 this case, the value is the number of produced glyphs.
4444 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4447 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4448 produced in GSTRING-OUT, and the value is nil.
4450 See the documentation of `composition-get-gstring' for the format of
4452 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4454 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4459 check_otf_features (otf_features
);
4460 CHECK_FONT_OBJECT (font_object
);
4461 font
= XFONT_OBJECT (font_object
);
4462 if (! font
->driver
->otf_drive
)
4463 error ("Font backend %s can't drive OpenType GSUB table",
4464 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4465 CHECK_CONS (otf_features
);
4466 CHECK_SYMBOL (XCAR (otf_features
));
4467 val
= XCDR (otf_features
);
4468 CHECK_SYMBOL (XCAR (val
));
4469 val
= XCDR (otf_features
);
4472 len
= check_gstring (gstring_in
);
4473 CHECK_VECTOR (gstring_out
);
4474 CHECK_NATNUM (from
);
4476 CHECK_NATNUM (index
);
4478 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4479 args_out_of_range_3 (from
, to
, make_number (len
));
4480 if (XINT (index
) >= ASIZE (gstring_out
))
4481 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4482 num
= font
->driver
->otf_drive (font
, otf_features
,
4483 gstring_in
, XINT (from
), XINT (to
),
4484 gstring_out
, XINT (index
), 0);
4487 return make_number (num
);
4490 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4492 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4493 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4495 (SCRIPT LANGSYS FEATURE ...)
4496 See the documentation of `font-drive-otf' for more detail.
4498 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4499 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4500 character code corresponding to the glyph or nil if there's no
4501 corresponding character. */)
4502 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4505 Lisp_Object gstring_in
, gstring_out
, g
;
4506 Lisp_Object alternates
;
4509 CHECK_FONT_GET_OBJECT (font_object
, font
);
4510 if (! font
->driver
->otf_drive
)
4511 error ("Font backend %s can't drive OpenType GSUB table",
4512 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4513 CHECK_CHARACTER (character
);
4514 CHECK_CONS (otf_features
);
4516 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4517 g
= LGSTRING_GLYPH (gstring_in
, 0);
4518 LGLYPH_SET_CHAR (g
, XINT (character
));
4519 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4520 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4521 gstring_out
, 0, 1)) < 0)
4522 gstring_out
= Ffont_make_gstring (font_object
,
4523 make_number (ASIZE (gstring_out
) * 2));
4525 for (i
= 0; i
< num
; i
++)
4527 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4528 int c
= LGLYPH_CHAR (g
);
4529 unsigned code
= LGLYPH_CODE (g
);
4531 alternates
= Fcons (Fcons (make_number (code
),
4532 c
> 0 ? make_number (c
) : Qnil
),
4535 return Fnreverse (alternates
);
4541 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4542 doc
: /* Open FONT-ENTITY. */)
4543 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4547 CHECK_FONT_ENTITY (font_entity
);
4549 frame
= selected_frame
;
4550 CHECK_LIVE_FRAME (frame
);
4553 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4556 CHECK_NUMBER_OR_FLOAT (size
);
4558 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4560 isize
= XINT (size
);
4561 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4562 args_out_of_range (font_entity
, size
);
4566 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4569 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4570 doc
: /* Close FONT-OBJECT. */)
4571 (Lisp_Object font_object
, Lisp_Object frame
)
4573 CHECK_FONT_OBJECT (font_object
);
4575 frame
= selected_frame
;
4576 CHECK_LIVE_FRAME (frame
);
4577 font_close_object (XFRAME (frame
), font_object
);
4581 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4582 doc
: /* Return information about FONT-OBJECT.
4583 The value is a vector:
4584 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4587 NAME is the font name, a string (or nil if the font backend doesn't
4590 FILENAME is the font file name, a string (or nil if the font backend
4591 doesn't provide a file name).
4593 PIXEL-SIZE is a pixel size by which the font is opened.
4595 SIZE is a maximum advance width of the font in pixels.
4597 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4600 CAPABILITY is a list whose first element is a symbol representing the
4601 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4602 remaining elements describe the details of the font capability.
4604 If the font is OpenType font, the form of the list is
4605 \(opentype GSUB GPOS)
4606 where GSUB shows which "GSUB" features the font supports, and GPOS
4607 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4608 lists of the format:
4609 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4611 If the font is not OpenType font, currently the length of the form is
4614 SCRIPT is a symbol representing OpenType script tag.
4616 LANGSYS is a symbol representing OpenType langsys tag, or nil
4617 representing the default langsys.
4619 FEATURE is a symbol representing OpenType feature tag.
4621 If the font is not OpenType font, CAPABILITY is nil. */)
4622 (Lisp_Object font_object
)
4627 CHECK_FONT_GET_OBJECT (font_object
, font
);
4629 val
= Fmake_vector (make_number (9), Qnil
);
4630 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4631 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4632 ASET (val
, 2, make_number (font
->pixel_size
));
4633 ASET (val
, 3, make_number (font
->max_width
));
4634 ASET (val
, 4, make_number (font
->ascent
));
4635 ASET (val
, 5, make_number (font
->descent
));
4636 ASET (val
, 6, make_number (font
->space_width
));
4637 ASET (val
, 7, make_number (font
->average_width
));
4638 if (font
->driver
->otf_capability
)
4639 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4643 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4645 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4646 FROM and TO are positions (integers or markers) specifying a region
4647 of the current buffer.
4648 If the optional fourth arg OBJECT is not nil, it is a string or a
4649 vector containing the target characters.
4651 Each element is a vector containing information of a glyph in this format:
4652 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4654 FROM is an index numbers of a character the glyph corresponds to.
4655 TO is the same as FROM.
4656 C is the character of the glyph.
4657 CODE is the glyph-code of C in FONT-OBJECT.
4658 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4659 ADJUSTMENT is always nil.
4660 If FONT-OBJECT doesn't have a glyph for a character,
4661 the corresponding element is nil. */)
4662 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4667 Lisp_Object
*chars
, vec
;
4670 CHECK_FONT_GET_OBJECT (font_object
, font
);
4673 ptrdiff_t charpos
, bytepos
;
4675 validate_region (&from
, &to
);
4678 len
= XFASTINT (to
) - XFASTINT (from
);
4679 SAFE_ALLOCA_LISP (chars
, len
);
4680 charpos
= XFASTINT (from
);
4681 bytepos
= CHAR_TO_BYTE (charpos
);
4682 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4685 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4686 chars
[i
] = make_number (c
);
4689 else if (STRINGP (object
))
4691 const unsigned char *p
;
4693 CHECK_NUMBER (from
);
4695 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4696 || XINT (to
) > SCHARS (object
))
4697 args_out_of_range_3 (object
, from
, to
);
4700 len
= XFASTINT (to
) - XFASTINT (from
);
4701 SAFE_ALLOCA_LISP (chars
, len
);
4703 if (STRING_MULTIBYTE (object
))
4704 for (i
= 0; i
< len
; i
++)
4706 int c
= STRING_CHAR_ADVANCE (p
);
4707 chars
[i
] = make_number (c
);
4710 for (i
= 0; i
< len
; i
++)
4711 chars
[i
] = make_number (p
[i
]);
4715 CHECK_VECTOR (object
);
4716 CHECK_NUMBER (from
);
4718 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4719 || XINT (to
) > ASIZE (object
))
4720 args_out_of_range_3 (object
, from
, to
);
4723 len
= XFASTINT (to
) - XFASTINT (from
);
4724 for (i
= 0; i
< len
; i
++)
4726 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4727 CHECK_CHARACTER (elt
);
4729 chars
= &(AREF (object
, XFASTINT (from
)));
4732 vec
= Fmake_vector (make_number (len
), Qnil
);
4733 for (i
= 0; i
< len
; i
++)
4736 int c
= XFASTINT (chars
[i
]);
4738 struct font_metrics metrics
;
4740 code
= font
->driver
->encode_char (font
, c
);
4741 if (code
== FONT_INVALID_CODE
)
4743 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4744 LGLYPH_SET_FROM (g
, i
);
4745 LGLYPH_SET_TO (g
, i
);
4746 LGLYPH_SET_CHAR (g
, c
);
4747 LGLYPH_SET_CODE (g
, code
);
4748 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4749 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4750 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4751 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4752 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4753 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4756 if (! VECTORP (object
))
4761 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4762 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4763 FONT is a font-spec, font-entity, or font-object. */)
4764 (Lisp_Object spec
, Lisp_Object font
)
4766 CHECK_FONT_SPEC (spec
);
4769 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4772 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4773 doc
: /* Return a font-object for displaying a character at POSITION.
4774 Optional second arg WINDOW, if non-nil, is a window displaying
4775 the current buffer. It defaults to the currently selected window. */)
4776 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4783 CHECK_NUMBER_COERCE_MARKER (position
);
4784 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4785 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4786 pos
= XINT (position
);
4790 CHECK_NUMBER (position
);
4791 CHECK_STRING (string
);
4792 if (! (0 < XINT (position
) && XINT (position
) < SCHARS (string
)))
4793 args_out_of_range (string
, position
);
4794 pos
= XINT (position
);
4797 window
= selected_window
;
4798 CHECK_LIVE_WINDOW (window
);
4799 w
= XWINDOW (window
);
4801 return font_at (-1, pos
, NULL
, w
, string
);
4805 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4806 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4807 The value is a number of glyphs drawn.
4808 Type C-l to recover what previously shown. */)
4809 (Lisp_Object font_object
, Lisp_Object string
)
4811 Lisp_Object frame
= selected_frame
;
4812 FRAME_PTR f
= XFRAME (frame
);
4818 CHECK_FONT_GET_OBJECT (font_object
, font
);
4819 CHECK_STRING (string
);
4820 len
= SCHARS (string
);
4821 code
= alloca (sizeof (unsigned) * len
);
4822 for (i
= 0; i
< len
; i
++)
4824 Lisp_Object ch
= Faref (string
, make_number (i
));
4828 code
[i
] = font
->driver
->encode_char (font
, c
);
4829 if (code
[i
] == FONT_INVALID_CODE
)
4832 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4834 if (font
->driver
->prepare_face
)
4835 font
->driver
->prepare_face (f
, face
);
4836 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4837 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4838 if (font
->driver
->done_face
)
4839 font
->driver
->done_face (f
, face
);
4841 return make_number (len
);
4845 #endif /* FONT_DEBUG */
4847 #ifdef HAVE_WINDOW_SYSTEM
4849 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4850 doc
: /* Return information about a font named NAME on frame FRAME.
4851 If FRAME is omitted or nil, use the selected frame.
4852 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4853 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4855 OPENED-NAME is the name used for opening the font,
4856 FULL-NAME is the full name of the font,
4857 SIZE is the pixelsize of the font,
4858 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4859 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4860 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4861 how to compose characters.
4862 If the named font is not yet loaded, return nil. */)
4863 (Lisp_Object name
, Lisp_Object frame
)
4868 Lisp_Object font_object
;
4870 (*check_window_system_func
) ();
4873 CHECK_STRING (name
);
4875 frame
= selected_frame
;
4876 CHECK_LIVE_FRAME (frame
);
4881 int fontset
= fs_query_fontset (name
, 0);
4884 name
= fontset_ascii (fontset
);
4885 font_object
= font_open_by_name (f
, SSDATA (name
), SBYTES (name
));
4887 else if (FONT_OBJECT_P (name
))
4889 else if (FONT_ENTITY_P (name
))
4890 font_object
= font_open_entity (f
, name
, 0);
4893 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4894 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4896 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4898 if (NILP (font_object
))
4900 font
= XFONT_OBJECT (font_object
);
4902 info
= Fmake_vector (make_number (7), Qnil
);
4903 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4904 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4905 ASET (info
, 2, make_number (font
->pixel_size
));
4906 ASET (info
, 3, make_number (font
->height
));
4907 ASET (info
, 4, make_number (font
->baseline_offset
));
4908 ASET (info
, 5, make_number (font
->relative_compose
));
4909 ASET (info
, 6, make_number (font
->default_ascent
));
4912 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4913 close it now. Perhaps, we should manage font-objects
4914 by `reference-count'. */
4915 font_close_object (f
, font_object
);
4922 #define BUILD_STYLE_TABLE(TBL) \
4923 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4926 build_style_table (const struct table_entry
*entry
, int nelement
)
4929 Lisp_Object table
, elt
;
4931 table
= Fmake_vector (make_number (nelement
), Qnil
);
4932 for (i
= 0; i
< nelement
; i
++)
4934 for (j
= 0; entry
[i
].names
[j
]; j
++);
4935 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4936 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4937 for (j
= 0; entry
[i
].names
[j
]; j
++)
4938 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4939 ASET (table
, i
, elt
);
4944 /* The deferred font-log data of the form [ACTION ARG RESULT].
4945 If ACTION is not nil, that is added to the log when font_add_log is
4946 called next time. At that time, ACTION is set back to nil. */
4947 static Lisp_Object Vfont_log_deferred
;
4949 /* Prepend the font-related logging data in Vfont_log if it is not
4950 `t'. ACTION describes a kind of font-related action (e.g. listing,
4951 opening), ARG is the argument for the action, and RESULT is the
4952 result of the action. */
4954 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4959 if (EQ (Vfont_log
, Qt
))
4961 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4963 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4965 ASET (Vfont_log_deferred
, 0, Qnil
);
4966 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4967 AREF (Vfont_log_deferred
, 2));
4972 Lisp_Object tail
, elt
;
4973 Lisp_Object equalstr
= build_string ("=");
4975 val
= Ffont_xlfd_name (arg
, Qt
);
4976 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4980 if (EQ (XCAR (elt
), QCscript
)
4981 && SYMBOLP (XCDR (elt
)))
4982 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4983 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4984 else if (EQ (XCAR (elt
), QClang
)
4985 && SYMBOLP (XCDR (elt
)))
4986 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4987 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4988 else if (EQ (XCAR (elt
), QCotf
)
4989 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4990 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4992 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4998 && VECTORP (XCAR (result
))
4999 && ASIZE (XCAR (result
)) > 0
5000 && FONTP (AREF (XCAR (result
), 0)))
5001 result
= font_vconcat_entity_vectors (result
);
5004 val
= Ffont_xlfd_name (result
, Qt
);
5005 if (! FONT_SPEC_P (result
))
5006 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5007 build_string (":"), val
);
5010 else if (CONSP (result
))
5013 result
= Fcopy_sequence (result
);
5014 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5018 val
= Ffont_xlfd_name (val
, Qt
);
5019 XSETCAR (tail
, val
);
5022 else if (VECTORP (result
))
5024 result
= Fcopy_sequence (result
);
5025 for (i
= 0; i
< ASIZE (result
); i
++)
5027 val
= AREF (result
, i
);
5029 val
= Ffont_xlfd_name (val
, Qt
);
5030 ASET (result
, i
, val
);
5033 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5036 /* Record a font-related logging data to be added to Vfont_log when
5037 font_add_log is called next time. ACTION, ARG, RESULT are the same
5041 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5043 if (EQ (Vfont_log
, Qt
))
5045 ASET (Vfont_log_deferred
, 0, build_string (action
));
5046 ASET (Vfont_log_deferred
, 1, arg
);
5047 ASET (Vfont_log_deferred
, 2, result
);
5053 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5054 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5055 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5056 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5057 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5058 /* Note that the other elements in sort_shift_bits are not used. */
5060 staticpro (&font_charset_alist
);
5061 font_charset_alist
= Qnil
;
5063 DEFSYM (Qopentype
, "opentype");
5065 DEFSYM (Qascii_0
, "ascii-0");
5066 DEFSYM (Qiso8859_1
, "iso8859-1");
5067 DEFSYM (Qiso10646_1
, "iso10646-1");
5068 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5069 DEFSYM (Qunicode_sip
, "unicode-sip");
5073 DEFSYM (QCotf
, ":otf");
5074 DEFSYM (QClang
, ":lang");
5075 DEFSYM (QCscript
, ":script");
5076 DEFSYM (QCantialias
, ":antialias");
5078 DEFSYM (QCfoundry
, ":foundry");
5079 DEFSYM (QCadstyle
, ":adstyle");
5080 DEFSYM (QCregistry
, ":registry");
5081 DEFSYM (QCspacing
, ":spacing");
5082 DEFSYM (QCdpi
, ":dpi");
5083 DEFSYM (QCscalable
, ":scalable");
5084 DEFSYM (QCavgwidth
, ":avgwidth");
5085 DEFSYM (QCfont_entity
, ":font-entity");
5086 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5096 DEFSYM (QCuser_spec
, "user-spec");
5098 staticpro (&null_vector
);
5099 null_vector
= Fmake_vector (make_number (0), Qnil
);
5101 staticpro (&scratch_font_spec
);
5102 scratch_font_spec
= Ffont_spec (0, NULL
);
5103 staticpro (&scratch_font_prefer
);
5104 scratch_font_prefer
= Ffont_spec (0, NULL
);
5106 staticpro (&Vfont_log_deferred
);
5107 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5111 staticpro (&otf_list
);
5113 #endif /* HAVE_LIBOTF */
5117 defsubr (&Sfont_spec
);
5118 defsubr (&Sfont_get
);
5119 #ifdef HAVE_WINDOW_SYSTEM
5120 defsubr (&Sfont_face_attributes
);
5122 defsubr (&Sfont_put
);
5123 defsubr (&Slist_fonts
);
5124 defsubr (&Sfont_family_list
);
5125 defsubr (&Sfind_font
);
5126 defsubr (&Sfont_xlfd_name
);
5127 defsubr (&Sclear_font_cache
);
5128 defsubr (&Sfont_shape_gstring
);
5129 defsubr (&Sfont_variation_glyphs
);
5131 defsubr (&Sfont_drive_otf
);
5132 defsubr (&Sfont_otf_alternates
);
5136 defsubr (&Sopen_font
);
5137 defsubr (&Sclose_font
);
5138 defsubr (&Squery_font
);
5139 defsubr (&Sfont_get_glyphs
);
5140 defsubr (&Sfont_match_p
);
5141 defsubr (&Sfont_at
);
5143 defsubr (&Sdraw_string
);
5145 #endif /* FONT_DEBUG */
5146 #ifdef HAVE_WINDOW_SYSTEM
5147 defsubr (&Sfont_info
);
5150 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5152 Alist of fontname patterns vs the corresponding encoding and repertory info.
5153 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5154 where ENCODING is a charset or a char-table,
5155 and REPERTORY is a charset, a char-table, or nil.
5157 If ENCODING and REPERTORY are the same, the element can have the form
5158 \(REGEXP . ENCODING).
5160 ENCODING is for converting a character to a glyph code of the font.
5161 If ENCODING is a charset, encoding a character by the charset gives
5162 the corresponding glyph code. If ENCODING is a char-table, looking up
5163 the table by a character gives the corresponding glyph code.
5165 REPERTORY specifies a repertory of characters supported by the font.
5166 If REPERTORY is a charset, all characters belonging to the charset are
5167 supported. If REPERTORY is a char-table, all characters who have a
5168 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5169 gets the repertory information by an opened font and ENCODING. */);
5170 Vfont_encoding_alist
= Qnil
;
5172 /* FIXME: These 3 vars are not quite what they appear: setq on them
5173 won't have any effect other than disconnect them from the style
5174 table used by the font display code. So we make them read-only,
5175 to avoid this confusing situation. */
5177 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5178 doc
: /* Vector of valid font weight values.
5179 Each element has the form:
5180 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5181 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5182 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5183 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5185 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5186 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5187 See `font-weight-table' for the format of the vector. */);
5188 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5189 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5191 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5192 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5193 See `font-weight-table' for the format of the vector. */);
5194 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5195 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5197 staticpro (&font_style_table
);
5198 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5199 ASET (font_style_table
, 0, Vfont_weight_table
);
5200 ASET (font_style_table
, 1, Vfont_slant_table
);
5201 ASET (font_style_table
, 2, Vfont_width_table
);
5203 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5204 *Logging list of font related actions and results.
5205 The value t means to suppress the logging.
5206 The initial value is set to nil if the environment variable
5207 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5210 #ifdef HAVE_WINDOW_SYSTEM
5211 #ifdef HAVE_FREETYPE
5213 #ifdef HAVE_X_WINDOWS
5218 #endif /* HAVE_XFT */
5219 #endif /* HAVE_X_WINDOWS */
5220 #else /* not HAVE_FREETYPE */
5221 #ifdef HAVE_X_WINDOWS
5223 #endif /* HAVE_X_WINDOWS */
5224 #endif /* not HAVE_FREETYPE */
5227 #endif /* HAVE_BDFFONT */
5230 #endif /* WINDOWSNT */
5233 #endif /* HAVE_NS */
5234 #endif /* HAVE_WINDOW_SYSTEM */
5240 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;