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 /* The following code is copied from the function intern (in
268 lread.c), and modified to suit our purpose. */
270 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
271 obarray
= check_obarray (obarray
);
272 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
273 if (len
== nchars
|| len
!= nbytes
)
274 /* CONTENTS contains no multibyte sequences or contains an invalid
275 multibyte sequence. We'll make a unibyte string. */
276 tem
= oblookup (obarray
, str
, len
, len
);
278 tem
= oblookup (obarray
, str
, nchars
, len
);
281 if (len
== nchars
|| len
!= nbytes
)
282 tem
= make_unibyte_string (str
, len
);
284 tem
= make_multibyte_string (str
, nchars
, len
);
285 return Fintern (tem
, obarray
);
288 /* Return a pixel size of font-spec SPEC on frame F. */
291 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
293 #ifdef HAVE_WINDOW_SYSTEM
294 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
303 font_assert (FLOATP (size
));
304 point_size
= XFLOAT_DATA (size
);
305 val
= AREF (spec
, FONT_DPI_INDEX
);
310 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
318 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
319 font vector. If VAL is not valid (i.e. not registered in
320 font_style_table), return -1 if NOERROR is zero, and return a
321 proper index if NOERROR is nonzero. In that case, register VAL in
322 font_style_table if VAL is a symbol, and return the closest index if
323 VAL is an integer. */
326 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
328 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
331 CHECK_VECTOR (table
);
338 Lisp_Object args
[2], elt
;
340 /* At first try exact match. */
341 for (i
= 0; i
< len
; i
++)
343 CHECK_VECTOR (AREF (table
, i
));
344 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
345 if (EQ (val
, AREF (AREF (table
, i
), j
)))
347 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
348 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
349 | (i
<< 4) | (j
- 1));
352 /* Try also with case-folding match. */
353 s
= SSDATA (SYMBOL_NAME (val
));
354 for (i
= 0; i
< len
; i
++)
355 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
357 elt
= AREF (AREF (table
, i
), j
);
358 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
360 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
361 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
362 | (i
<< 4) | (j
- 1));
369 elt
= Fmake_vector (make_number (2), make_number (100));
372 args
[1] = Fmake_vector (make_number (1), elt
);
373 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
374 return (100 << 8) | (i
<< 4);
379 EMACS_INT numeric
= XINT (val
);
381 for (i
= 0, last_n
= -1; i
< len
; i
++)
385 CHECK_VECTOR (AREF (table
, i
));
386 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
387 n
= XINT (AREF (AREF (table
, i
), 0));
389 return (n
<< 8) | (i
<< 4);
394 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
395 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
401 return ((last_n
<< 8) | ((i
- 1) << 4));
406 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
408 Lisp_Object val
= AREF (font
, prop
);
409 Lisp_Object table
, elt
;
414 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
415 CHECK_VECTOR (table
);
416 i
= XINT (val
) & 0xFF;
417 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
418 elt
= AREF (table
, ((i
>> 4) & 0xF));
420 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
421 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
426 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
427 FONTNAME. ENCODING is a charset symbol that specifies the encoding
428 of the font. REPERTORY is a charset symbol or nil. */
431 find_font_encoding (Lisp_Object fontname
)
433 Lisp_Object tail
, elt
;
435 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
439 && STRINGP (XCAR (elt
))
440 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
441 && (SYMBOLP (XCDR (elt
))
442 ? CHARSETP (XCDR (elt
))
443 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
449 /* Return encoding charset and repertory charset for REGISTRY in
450 ENCODING and REPERTORY correspondingly. If correct information for
451 REGISTRY is available, return 0. Otherwise return -1. */
454 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
457 int encoding_id
, repertory_id
;
459 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
465 encoding_id
= XINT (XCAR (val
));
466 repertory_id
= XINT (XCDR (val
));
470 val
= find_font_encoding (SYMBOL_NAME (registry
));
471 if (SYMBOLP (val
) && CHARSETP (val
))
473 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
475 else if (CONSP (val
))
477 if (! CHARSETP (XCAR (val
)))
479 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
480 if (NILP (XCDR (val
)))
484 if (! CHARSETP (XCDR (val
)))
486 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
491 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
493 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
497 *encoding
= CHARSET_FROM_ID (encoding_id
);
499 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
504 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
509 /* Font property value validators. See the comment of
510 font_property_table for the meaning of the arguments. */
512 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
513 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
514 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
515 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
516 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
517 static int get_font_prop_index (Lisp_Object
);
520 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
523 val
= Fintern (val
, Qnil
);
526 else if (EQ (prop
, QCregistry
))
527 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
533 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
535 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
536 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
540 EMACS_INT n
= XINT (val
);
541 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
543 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
547 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
550 if ((n
& 0xF) + 1 >= ASIZE (elt
))
554 CHECK_NUMBER (AREF (elt
, 0));
555 if (XINT (AREF (elt
, 0)) != (n
>> 8))
560 else if (SYMBOLP (val
))
562 int n
= font_style_to_value (prop
, val
, 0);
564 val
= n
>= 0 ? make_number (n
) : Qerror
;
572 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
574 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
579 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
581 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
583 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
585 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
587 if (spacing
== 'c' || spacing
== 'C')
588 return make_number (FONT_SPACING_CHARCELL
);
589 if (spacing
== 'm' || spacing
== 'M')
590 return make_number (FONT_SPACING_MONO
);
591 if (spacing
== 'p' || spacing
== 'P')
592 return make_number (FONT_SPACING_PROPORTIONAL
);
593 if (spacing
== 'd' || spacing
== 'D')
594 return make_number (FONT_SPACING_DUAL
);
600 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
602 Lisp_Object tail
, tmp
;
605 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
606 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
607 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
610 if (! SYMBOLP (XCAR (val
)))
615 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
617 for (i
= 0; i
< 2; i
++)
624 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
625 if (! SYMBOLP (XCAR (tmp
)))
633 /* Structure of known font property keys and validator of the
637 /* Pointer to the key symbol. */
639 /* Function to validate PROP's value VAL, or NULL if any value is
640 ok. The value is VAL or its regularized value if VAL is valid,
641 and Qerror if not. */
642 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
643 } font_property_table
[] =
644 { { &QCtype
, font_prop_validate_symbol
},
645 { &QCfoundry
, font_prop_validate_symbol
},
646 { &QCfamily
, font_prop_validate_symbol
},
647 { &QCadstyle
, font_prop_validate_symbol
},
648 { &QCregistry
, font_prop_validate_symbol
},
649 { &QCweight
, font_prop_validate_style
},
650 { &QCslant
, font_prop_validate_style
},
651 { &QCwidth
, font_prop_validate_style
},
652 { &QCsize
, font_prop_validate_non_neg
},
653 { &QCdpi
, font_prop_validate_non_neg
},
654 { &QCspacing
, font_prop_validate_spacing
},
655 { &QCavgwidth
, font_prop_validate_non_neg
},
656 /* The order of the above entries must match with enum
657 font_property_index. */
658 { &QClang
, font_prop_validate_symbol
},
659 { &QCscript
, font_prop_validate_symbol
},
660 { &QCotf
, font_prop_validate_otf
}
663 /* Size (number of elements) of the above table. */
664 #define FONT_PROPERTY_TABLE_SIZE \
665 ((sizeof font_property_table) / (sizeof *font_property_table))
667 /* Return an index number of font property KEY or -1 if KEY is not an
668 already known property. */
671 get_font_prop_index (Lisp_Object key
)
675 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
676 if (EQ (key
, *font_property_table
[i
].key
))
681 /* Validate the font property. The property key is specified by the
682 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
683 signal an error. The value is VAL or the regularized one. */
686 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
688 Lisp_Object validated
;
693 prop
= *font_property_table
[idx
].key
;
696 idx
= get_font_prop_index (prop
);
700 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
701 if (EQ (validated
, Qerror
))
702 signal_error ("invalid font property", Fcons (prop
, val
));
707 /* Store VAL as a value of extra font property PROP in FONT while
708 keeping the sorting order. Don't check the validity of VAL. */
711 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
713 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
714 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
718 Lisp_Object prev
= Qnil
;
721 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
722 prev
= extra
, extra
= XCDR (extra
);
725 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
727 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
733 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
738 /* Font name parser and unparser */
740 static int parse_matrix (const char *);
741 static int font_expand_wildcards (Lisp_Object
*, int);
742 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
744 /* An enumerator for each field of an XLFD font name. */
745 enum xlfd_field_index
764 /* An enumerator for mask bit corresponding to each XLFD field. */
767 XLFD_FOUNDRY_MASK
= 0x0001,
768 XLFD_FAMILY_MASK
= 0x0002,
769 XLFD_WEIGHT_MASK
= 0x0004,
770 XLFD_SLANT_MASK
= 0x0008,
771 XLFD_SWIDTH_MASK
= 0x0010,
772 XLFD_ADSTYLE_MASK
= 0x0020,
773 XLFD_PIXEL_MASK
= 0x0040,
774 XLFD_POINT_MASK
= 0x0080,
775 XLFD_RESX_MASK
= 0x0100,
776 XLFD_RESY_MASK
= 0x0200,
777 XLFD_SPACING_MASK
= 0x0400,
778 XLFD_AVGWIDTH_MASK
= 0x0800,
779 XLFD_REGISTRY_MASK
= 0x1000,
780 XLFD_ENCODING_MASK
= 0x2000
784 /* Parse P pointing to the pixel/point size field of the form
785 `[A B C D]' which specifies a transformation matrix:
791 by which all glyphs of the font are transformed. The spec says
792 that scalar value N for the pixel/point size is equivalent to:
793 A = N * resx/resy, B = C = 0, D = N.
795 Return the scalar value N if the form is valid. Otherwise return
799 parse_matrix (const char *p
)
805 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
808 matrix
[i
] = - strtod (p
+ 1, &end
);
810 matrix
[i
] = strtod (p
, &end
);
813 return (i
== 4 ? (int) matrix
[3] : -1);
816 /* Expand a wildcard field in FIELD (the first N fields are filled) to
817 multiple fields to fill in all 14 XLFD fields while restricting a
818 field position by its contents. */
821 font_expand_wildcards (Lisp_Object
*field
, int n
)
824 Lisp_Object tmp
[XLFD_LAST_INDEX
];
825 /* Array of information about where this element can go. Nth
826 element is for Nth element of FIELD. */
828 /* Minimum possible field. */
830 /* Maximum possible field. */
832 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
834 } range
[XLFD_LAST_INDEX
];
836 int range_from
, range_to
;
839 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
840 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
841 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
842 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
843 | XLFD_AVGWIDTH_MASK)
844 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
846 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
847 field. The value is shifted to left one bit by one in the
849 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
850 range_mask
= (range_mask
<< 1) | 1;
852 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
853 position-based restriction for FIELD[I]. */
854 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
855 i
++, range_from
++, range_to
++, range_mask
<<= 1)
857 Lisp_Object val
= field
[i
];
863 range
[i
].from
= range_from
;
864 range
[i
].to
= range_to
;
865 range
[i
].mask
= range_mask
;
869 /* The triplet FROM, TO, and MASK is a value-based
870 restriction for FIELD[I]. */
876 EMACS_INT numeric
= XINT (val
);
879 from
= to
= XLFD_ENCODING_INDEX
,
880 mask
= XLFD_ENCODING_MASK
;
881 else if (numeric
== 0)
882 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
883 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
884 else if (numeric
<= 48)
885 from
= to
= XLFD_PIXEL_INDEX
,
886 mask
= XLFD_PIXEL_MASK
;
888 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
889 mask
= XLFD_LARGENUM_MASK
;
891 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
892 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
893 mask
= XLFD_NULL_MASK
;
895 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
898 Lisp_Object name
= SYMBOL_NAME (val
);
900 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
901 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
902 mask
= XLFD_REGENC_MASK
;
904 from
= to
= XLFD_ENCODING_INDEX
,
905 mask
= XLFD_ENCODING_MASK
;
907 else if (range_from
<= XLFD_WEIGHT_INDEX
908 && range_to
>= XLFD_WEIGHT_INDEX
909 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
910 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
911 else if (range_from
<= XLFD_SLANT_INDEX
912 && range_to
>= XLFD_SLANT_INDEX
913 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
914 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
915 else if (range_from
<= XLFD_SWIDTH_INDEX
916 && range_to
>= XLFD_SWIDTH_INDEX
917 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
918 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
921 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
922 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
924 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
925 mask
= XLFD_SYMBOL_MASK
;
928 /* Merge position-based and value-based restrictions. */
930 while (from
< range_from
)
931 mask
&= ~(1 << from
++);
932 while (from
< 14 && ! (mask
& (1 << from
)))
934 while (to
> range_to
)
935 mask
&= ~(1 << to
--);
936 while (to
>= 0 && ! (mask
& (1 << to
)))
940 range
[i
].from
= from
;
942 range
[i
].mask
= mask
;
944 if (from
> range_from
|| to
< range_to
)
946 /* The range is narrowed by value-based restrictions.
947 Reflect it to the other fields. */
949 /* Following fields should be after FROM. */
951 /* Preceding fields should be before TO. */
952 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
954 /* Check FROM for non-wildcard field. */
955 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
957 while (range
[j
].from
< from
)
958 range
[j
].mask
&= ~(1 << range
[j
].from
++);
959 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
961 range
[j
].from
= from
;
964 from
= range
[j
].from
;
965 if (range
[j
].to
> to
)
967 while (range
[j
].to
> to
)
968 range
[j
].mask
&= ~(1 << range
[j
].to
--);
969 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
982 /* Decide all fields from restrictions in RANGE. */
983 for (i
= j
= 0; i
< n
; i
++)
985 if (j
< range
[i
].from
)
987 if (i
== 0 || ! NILP (tmp
[i
- 1]))
988 /* None of TMP[X] corresponds to Jth field. */
990 for (; j
< range
[i
].from
; j
++)
995 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
997 for (; j
< XLFD_LAST_INDEX
; j
++)
999 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1000 field
[XLFD_ENCODING_INDEX
]
1001 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1006 /* Parse NAME (null terminated) as XLFD and store information in FONT
1007 (font-spec or font-entity). Size property of FONT is set as
1009 specified XLFD fields FONT property
1010 --------------------- -------------
1011 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1012 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1013 POINT_SIZE POINT_SIZE/10 (Lisp float)
1015 If NAME is successfully parsed, return 0. Otherwise return -1.
1017 FONT is usually a font-spec, but when this function is called from
1018 X font backend driver, it is a font-entity. In that case, NAME is
1019 a fully specified XLFD. */
1022 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1025 char *f
[XLFD_LAST_INDEX
+ 1];
1029 if (len
> 255 || !len
)
1030 /* Maximum XLFD name length is 255. */
1032 /* Accept "*-.." as a fully specified XLFD. */
1033 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1034 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1037 for (p
= name
+ i
; *p
; p
++)
1041 if (i
== XLFD_LAST_INDEX
)
1046 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1047 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1049 if (i
== XLFD_LAST_INDEX
)
1051 /* Fully specified XLFD. */
1054 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1055 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1056 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1057 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1059 val
= INTERN_FIELD_SYM (i
);
1062 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1064 ASET (font
, j
, make_number (n
));
1067 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1068 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1069 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1071 ASET (font
, FONT_REGISTRY_INDEX
,
1072 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1073 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1075 p
= f
[XLFD_PIXEL_INDEX
];
1076 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1077 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1080 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1082 ASET (font
, FONT_SIZE_INDEX
, val
);
1083 else if (FONT_ENTITY_P (font
))
1087 double point_size
= -1;
1089 font_assert (FONT_SPEC_P (font
));
1090 p
= f
[XLFD_POINT_INDEX
];
1092 point_size
= parse_matrix (p
);
1093 else if (isdigit (*p
))
1094 point_size
= atoi (p
), point_size
/= 10;
1095 if (point_size
>= 0)
1096 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1100 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1101 if (! NILP (val
) && ! INTEGERP (val
))
1103 ASET (font
, FONT_DPI_INDEX
, val
);
1104 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1107 val
= font_prop_validate_spacing (QCspacing
, val
);
1108 if (! INTEGERP (val
))
1110 ASET (font
, FONT_SPACING_INDEX
, val
);
1112 p
= f
[XLFD_AVGWIDTH_INDEX
];
1115 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1116 if (! NILP (val
) && ! INTEGERP (val
))
1118 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1122 int wild_card_found
= 0;
1123 Lisp_Object prop
[XLFD_LAST_INDEX
];
1125 if (FONT_ENTITY_P (font
))
1127 for (j
= 0; j
< i
; j
++)
1131 if (f
[j
][1] && f
[j
][1] != '-')
1134 wild_card_found
= 1;
1137 prop
[j
] = INTERN_FIELD (j
);
1139 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1141 if (! wild_card_found
)
1143 if (font_expand_wildcards (prop
, i
) < 0)
1146 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1147 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1148 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1149 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1150 if (! NILP (prop
[i
]))
1152 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1154 ASET (font
, j
, make_number (n
));
1156 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1157 val
= prop
[XLFD_REGISTRY_INDEX
];
1160 val
= prop
[XLFD_ENCODING_INDEX
];
1162 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1164 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1165 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1167 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1168 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1170 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1172 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1173 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1174 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1176 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1178 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1181 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1182 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1183 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1185 val
= font_prop_validate_spacing (QCspacing
,
1186 prop
[XLFD_SPACING_INDEX
]);
1187 if (! INTEGERP (val
))
1189 ASET (font
, FONT_SPACING_INDEX
, val
);
1191 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1192 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1198 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1199 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1200 0, use PIXEL_SIZE instead. */
1203 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1206 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1210 font_assert (FONTP (font
));
1212 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1215 if (i
== FONT_ADSTYLE_INDEX
)
1216 j
= XLFD_ADSTYLE_INDEX
;
1217 else if (i
== FONT_REGISTRY_INDEX
)
1218 j
= XLFD_REGISTRY_INDEX
;
1219 val
= AREF (font
, i
);
1222 if (j
== XLFD_REGISTRY_INDEX
)
1230 val
= SYMBOL_NAME (val
);
1231 if (j
== XLFD_REGISTRY_INDEX
1232 && ! strchr (SSDATA (val
), '-'))
1234 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1235 ptrdiff_t alloc
= SBYTES (val
) + 4;
1236 if (nbytes
<= alloc
)
1238 f
[j
] = p
= alloca (alloc
);
1239 sprintf (p
, "%s%s-*", SDATA (val
),
1240 "*" + (SDATA (val
)[SBYTES (val
) - 1] == '*'));
1243 f
[j
] = SSDATA (val
);
1247 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1250 val
= font_style_symbolic (font
, i
, 0);
1255 val
= SYMBOL_NAME (val
);
1256 f
[j
] = SSDATA (val
);
1260 val
= AREF (font
, FONT_SIZE_INDEX
);
1261 font_assert (NUMBERP (val
) || NILP (val
));
1264 EMACS_INT v
= XINT (val
);
1269 f
[XLFD_PIXEL_INDEX
] = p
=
1270 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1271 sprintf (p
, "%"pI
"d-*", v
);
1274 f
[XLFD_PIXEL_INDEX
] = "*-*";
1276 else if (FLOATP (val
))
1278 double v
= XFLOAT_DATA (val
) * 10;
1279 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1280 sprintf (p
, "*-%.0f", v
);
1283 f
[XLFD_PIXEL_INDEX
] = "*-*";
1285 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1287 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1288 f
[XLFD_RESX_INDEX
] = p
=
1289 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1290 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1293 f
[XLFD_RESX_INDEX
] = "*-*";
1294 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1296 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1298 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1299 : spacing
<= FONT_SPACING_DUAL
? "d"
1300 : spacing
<= FONT_SPACING_MONO
? "m"
1304 f
[XLFD_SPACING_INDEX
] = "*";
1305 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1307 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1308 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1311 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1312 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1313 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1314 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1315 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1316 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1317 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1318 f
[XLFD_REGISTRY_INDEX
]);
1319 return len
< nbytes
? len
: -1;
1322 /* Parse NAME (null terminated) and store information in FONT
1323 (font-spec or font-entity). NAME is supplied in either the
1324 Fontconfig or GTK font name format. If NAME is successfully
1325 parsed, return 0. Otherwise return -1.
1327 The fontconfig format is
1329 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1333 FAMILY [PROPS...] [SIZE]
1335 This function tries to guess which format it is. */
1338 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1341 char *size_beg
= NULL
, *size_end
= NULL
;
1342 char *props_beg
= NULL
, *family_end
= NULL
;
1347 for (p
= name
; *p
; p
++)
1349 if (*p
== '\\' && p
[1])
1353 props_beg
= family_end
= p
;
1358 int decimal
= 0, size_found
= 1;
1359 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1362 if (*q
!= '.' || decimal
)
1381 Lisp_Object extra_props
= Qnil
;
1383 /* A fontconfig name with size and/or property data. */
1384 if (family_end
> name
)
1387 family
= font_intern_prop (name
, family_end
- name
, 1);
1388 ASET (font
, FONT_FAMILY_INDEX
, family
);
1392 double point_size
= strtod (size_beg
, &size_end
);
1393 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1394 if (*size_end
== ':' && size_end
[1])
1395 props_beg
= size_end
;
1399 /* Now parse ":KEY=VAL" patterns. */
1402 for (p
= props_beg
; *p
; p
= q
)
1404 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1407 /* Must be an enumerated value. */
1411 val
= font_intern_prop (p
, q
- p
, 1);
1413 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1414 && memcmp (p, STR, strlen (STR)) == 0)
1416 if (PROP_MATCH ("light")
1417 || PROP_MATCH ("medium")
1418 || PROP_MATCH ("demibold")
1419 || PROP_MATCH ("bold")
1420 || PROP_MATCH ("black"))
1421 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1422 else if (PROP_MATCH ("roman")
1423 || PROP_MATCH ("italic")
1424 || PROP_MATCH ("oblique"))
1425 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1426 else if (PROP_MATCH ("charcell"))
1427 ASET (font
, FONT_SPACING_INDEX
,
1428 make_number (FONT_SPACING_CHARCELL
));
1429 else if (PROP_MATCH ("mono"))
1430 ASET (font
, FONT_SPACING_INDEX
,
1431 make_number (FONT_SPACING_MONO
));
1432 else if (PROP_MATCH ("proportional"))
1433 ASET (font
, FONT_SPACING_INDEX
,
1434 make_number (FONT_SPACING_PROPORTIONAL
));
1443 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1444 prop
= FONT_SIZE_INDEX
;
1447 key
= font_intern_prop (p
, q
- p
, 1);
1448 prop
= get_font_prop_index (key
);
1452 for (q
= p
; *q
&& *q
!= ':'; q
++);
1453 val
= font_intern_prop (p
, q
- p
, 0);
1455 if (prop
>= FONT_FOUNDRY_INDEX
1456 && prop
< FONT_EXTRA_INDEX
)
1457 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1460 extra_props
= nconc2 (extra_props
,
1461 Fcons (Fcons (key
, val
), Qnil
));
1468 if (! NILP (extra_props
))
1470 struct font_driver_list
*driver_list
= font_driver_list
;
1471 for ( ; driver_list
; driver_list
= driver_list
->next
)
1472 if (driver_list
->driver
->filter_properties
)
1473 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1479 /* Either a fontconfig-style name with no size and property
1480 data, or a GTK-style name. */
1481 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1482 Lisp_Object width
= Qnil
, size
= Qnil
;
1486 /* Scan backwards from the end, looking for a size. */
1487 for (p
= name
+ len
- 1; p
>= name
; p
--)
1491 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1492 /* Found a font size. */
1493 size
= make_float (strtod (p
+ 1, NULL
));
1497 /* Now P points to the termination of the string, sans size.
1498 Scan backwards, looking for font properties. */
1499 for (; p
> name
; p
= q
)
1501 for (q
= p
- 1; q
>= name
; q
--)
1503 if (q
> name
&& *(q
-1) == '\\')
1504 --q
; /* Skip quoting backslashes. */
1510 word_len
= p
- word_start
;
1512 #define PROP_MATCH(STR) \
1513 (word_len == strlen (STR) \
1514 && memcmp (word_start, STR, strlen (STR)) == 0)
1515 #define PROP_SAVE(VAR, STR) \
1516 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1518 if (PROP_MATCH ("Ultra-Light"))
1519 PROP_SAVE (weight
, "ultra-light");
1520 else if (PROP_MATCH ("Light"))
1521 PROP_SAVE (weight
, "light");
1522 else if (PROP_MATCH ("Book"))
1523 PROP_SAVE (weight
, "book");
1524 else if (PROP_MATCH ("Medium"))
1525 PROP_SAVE (weight
, "medium");
1526 else if (PROP_MATCH ("Semi-Bold"))
1527 PROP_SAVE (weight
, "semi-bold");
1528 else if (PROP_MATCH ("Bold"))
1529 PROP_SAVE (weight
, "bold");
1530 else if (PROP_MATCH ("Italic"))
1531 PROP_SAVE (slant
, "italic");
1532 else if (PROP_MATCH ("Oblique"))
1533 PROP_SAVE (slant
, "oblique");
1534 else if (PROP_MATCH ("Semi-Condensed"))
1535 PROP_SAVE (width
, "semi-condensed");
1536 else if (PROP_MATCH ("Condensed"))
1537 PROP_SAVE (width
, "condensed");
1538 /* An unknown word must be part of the font name. */
1549 ASET (font
, FONT_FAMILY_INDEX
,
1550 font_intern_prop (name
, family_end
- name
, 1));
1552 ASET (font
, FONT_SIZE_INDEX
, size
);
1554 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1556 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1558 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1564 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1565 NAME (NBYTES length), and return the name length. If
1566 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1569 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1571 Lisp_Object family
, foundry
;
1577 Lisp_Object styles
[3];
1578 const char *style_names
[3] = { "weight", "slant", "width" };
1580 family
= AREF (font
, FONT_FAMILY_INDEX
);
1581 if (! NILP (family
))
1583 if (SYMBOLP (family
))
1584 family
= SYMBOL_NAME (family
);
1589 val
= AREF (font
, FONT_SIZE_INDEX
);
1592 if (XINT (val
) != 0)
1593 pixel_size
= XINT (val
);
1601 point_size
= (int) XFLOAT_DATA (val
);
1604 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1605 if (! NILP (foundry
))
1607 if (SYMBOLP (foundry
))
1608 foundry
= SYMBOL_NAME (foundry
);
1613 for (i
= 0; i
< 3; i
++)
1614 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1617 lim
= name
+ nbytes
;
1618 if (! NILP (family
))
1620 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1621 if (! (0 <= len
&& len
< lim
- p
))
1627 int len
= snprintf (p
, lim
- p
, "-%d" + (p
== name
), point_size
);
1628 if (! (0 <= len
&& len
< lim
- p
))
1632 else if (pixel_size
> 0)
1634 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1635 if (! (0 <= len
&& len
< lim
- p
))
1639 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1641 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1642 SSDATA (SYMBOL_NAME (AREF (font
,
1643 FONT_FOUNDRY_INDEX
))));
1644 if (! (0 <= len
&& len
< lim
- p
))
1648 for (i
= 0; i
< 3; i
++)
1649 if (! NILP (styles
[i
]))
1651 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1652 SSDATA (SYMBOL_NAME (styles
[i
])));
1653 if (! (0 <= len
&& len
< lim
- p
))
1658 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1660 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1661 XINT (AREF (font
, FONT_DPI_INDEX
)));
1662 if (! (0 <= len
&& len
< lim
- p
))
1667 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1669 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1670 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1671 if (! (0 <= len
&& len
< lim
- p
))
1676 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1678 int len
= snprintf (p
, lim
- p
,
1679 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1681 : ":scalable=false"));
1682 if (! (0 <= len
&& len
< lim
- p
))
1690 /* Parse NAME (null terminated) and store information in FONT
1691 (font-spec or font-entity). If NAME is successfully parsed, return
1692 0. Otherwise return -1. */
1695 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1697 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1698 return font_parse_xlfd (name
, namelen
, font
);
1699 return font_parse_fcname (name
, namelen
, font
);
1703 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1704 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1708 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1714 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1716 CHECK_STRING (family
);
1717 len
= SBYTES (family
);
1718 p0
= SSDATA (family
);
1719 p1
= strchr (p0
, '-');
1722 if ((*p0
!= '*' && p1
- p0
> 0)
1723 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1724 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1727 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1730 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1732 if (! NILP (registry
))
1734 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1735 CHECK_STRING (registry
);
1736 len
= SBYTES (registry
);
1737 p0
= SSDATA (registry
);
1738 p1
= strchr (p0
, '-');
1741 if (SDATA (registry
)[len
- 1] == '*')
1742 registry
= concat2 (registry
, build_string ("-*"));
1744 registry
= concat2 (registry
, build_string ("*-*"));
1746 registry
= Fdowncase (registry
);
1747 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1752 /* This part (through the next ^L) is still experimental and not
1753 tested much. We may drastically change codes. */
1759 #define LGSTRING_HEADER_SIZE 6
1760 #define LGSTRING_GLYPH_SIZE 8
1763 check_gstring (Lisp_Object gstring
)
1769 CHECK_VECTOR (gstring
);
1770 val
= AREF (gstring
, 0);
1772 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1774 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1775 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1776 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1777 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1778 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1779 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1780 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1781 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1782 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1783 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1784 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1786 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1788 val
= LGSTRING_GLYPH (gstring
, i
);
1790 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1792 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1794 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1795 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1796 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1797 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1798 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1799 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1800 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1801 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1803 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1805 if (ASIZE (val
) < 3)
1807 for (j
= 0; j
< 3; j
++)
1808 CHECK_NUMBER (AREF (val
, j
));
1813 error ("Invalid glyph-string format");
1818 check_otf_features (Lisp_Object otf_features
)
1822 CHECK_CONS (otf_features
);
1823 CHECK_SYMBOL (XCAR (otf_features
));
1824 otf_features
= XCDR (otf_features
);
1825 CHECK_CONS (otf_features
);
1826 CHECK_SYMBOL (XCAR (otf_features
));
1827 otf_features
= XCDR (otf_features
);
1828 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1830 CHECK_SYMBOL (Fcar (val
));
1831 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1832 error ("Invalid OTF GSUB feature: %s",
1833 SDATA (SYMBOL_NAME (XCAR (val
))));
1835 otf_features
= XCDR (otf_features
);
1836 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1838 CHECK_SYMBOL (Fcar (val
));
1839 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1840 error ("Invalid OTF GPOS feature: %s",
1841 SDATA (SYMBOL_NAME (XCAR (val
))));
1848 Lisp_Object otf_list
;
1851 otf_tag_symbol (OTF_Tag tag
)
1855 OTF_tag_name (tag
, name
);
1856 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1860 otf_open (Lisp_Object file
)
1862 Lisp_Object val
= Fassoc (file
, otf_list
);
1866 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1869 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1870 val
= make_save_value (otf
, 0);
1871 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1877 /* Return a list describing which scripts/languages FONT supports by
1878 which GSUB/GPOS features of OpenType tables. See the comment of
1879 (struct font_driver).otf_capability. */
1882 font_otf_capability (struct font
*font
)
1885 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1888 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1891 for (i
= 0; i
< 2; i
++)
1893 OTF_GSUB_GPOS
*gsub_gpos
;
1894 Lisp_Object script_list
= Qnil
;
1897 if (OTF_get_features (otf
, i
== 0) < 0)
1899 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1900 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1902 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1903 Lisp_Object langsys_list
= Qnil
;
1904 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1907 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1909 OTF_LangSys
*langsys
;
1910 Lisp_Object feature_list
= Qnil
;
1911 Lisp_Object langsys_tag
;
1914 if (k
== script
->LangSysCount
)
1916 langsys
= &script
->DefaultLangSys
;
1921 langsys
= script
->LangSys
+ k
;
1923 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1925 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1927 OTF_Feature
*feature
1928 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1929 Lisp_Object feature_tag
1930 = otf_tag_symbol (feature
->FeatureTag
);
1932 feature_list
= Fcons (feature_tag
, feature_list
);
1934 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1937 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1942 XSETCAR (capability
, script_list
);
1944 XSETCDR (capability
, script_list
);
1950 /* Parse OTF features in SPEC and write a proper features spec string
1951 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1952 assured that the sufficient memory has already allocated for
1956 generate_otf_features (Lisp_Object spec
, char *features
)
1964 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1970 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1975 else if (! asterisk
)
1977 val
= SYMBOL_NAME (val
);
1978 p
+= esprintf (p
, "%s", SDATA (val
));
1982 val
= SYMBOL_NAME (val
);
1983 p
+= esprintf (p
, "~%s", SDATA (val
));
1987 error ("OTF spec too long");
1991 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
1993 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1995 return Fcons (make_number (len
),
1996 make_unibyte_string (device_table
->DeltaValue
, len
));
2000 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2002 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2004 if (value_format
& OTF_XPlacement
)
2005 ASET (val
, 0, make_number (value_record
->XPlacement
));
2006 if (value_format
& OTF_YPlacement
)
2007 ASET (val
, 1, make_number (value_record
->YPlacement
));
2008 if (value_format
& OTF_XAdvance
)
2009 ASET (val
, 2, make_number (value_record
->XAdvance
));
2010 if (value_format
& OTF_YAdvance
)
2011 ASET (val
, 3, make_number (value_record
->YAdvance
));
2012 if (value_format
& OTF_XPlaDevice
)
2013 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2014 if (value_format
& OTF_YPlaDevice
)
2015 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2016 if (value_format
& OTF_XAdvDevice
)
2017 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2018 if (value_format
& OTF_YAdvDevice
)
2019 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2024 font_otf_Anchor (OTF_Anchor
*anchor
)
2028 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2029 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2030 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2031 if (anchor
->AnchorFormat
== 2)
2032 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2035 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2036 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2040 #endif /* HAVE_LIBOTF */
2046 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2047 static int font_compare (const void *, const void *);
2048 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2052 font_rescale_ratio (Lisp_Object font_entity
)
2054 Lisp_Object tail
, elt
;
2055 Lisp_Object name
= Qnil
;
2057 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2060 if (FLOATP (XCDR (elt
)))
2062 if (STRINGP (XCAR (elt
)))
2065 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2066 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2067 return XFLOAT_DATA (XCDR (elt
));
2069 else if (FONT_SPEC_P (XCAR (elt
)))
2071 if (font_match_p (XCAR (elt
), font_entity
))
2072 return XFLOAT_DATA (XCDR (elt
));
2079 /* We sort fonts by scoring each of them against a specified
2080 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2081 the value is, the closer the font is to the font-spec.
2083 The lowest 2 bits of the score are used for driver type. The font
2084 available by the most preferred font driver is 0.
2086 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2087 WEIGHT, SLANT, WIDTH, and SIZE. */
2089 /* How many bits to shift to store the difference value of each font
2090 property in a score. Note that floats for FONT_TYPE_INDEX and
2091 FONT_REGISTRY_INDEX are not used. */
2092 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2094 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2095 The return value indicates how different ENTITY is compared with
2099 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2104 /* Score three style numeric fields. Maximum difference is 127. */
2105 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2106 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2108 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2109 - (XINT (spec_prop
[i
]) >> 8));
2112 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2115 /* Score the size. Maximum difference is 127. */
2116 i
= FONT_SIZE_INDEX
;
2117 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2118 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2120 /* We use the higher 6-bit for the actual size difference. The
2121 lowest bit is set if the DPI is different. */
2123 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2125 if (CONSP (Vface_font_rescale_alist
))
2126 pixel_size
*= font_rescale_ratio (entity
);
2127 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2131 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2132 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2134 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2135 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2137 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2144 /* Concatenate all elements of LIST into one vector. LIST is a list
2145 of font-entity vectors. */
2148 font_vconcat_entity_vectors (Lisp_Object list
)
2150 int nargs
= XINT (Flength (list
));
2151 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2154 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2155 args
[i
] = XCAR (list
);
2156 return Fvconcat (nargs
, args
);
2160 /* The structure for elements being sorted by qsort. */
2161 struct font_sort_data
2164 int font_driver_preference
;
2169 /* The comparison function for qsort. */
2172 font_compare (const void *d1
, const void *d2
)
2174 const struct font_sort_data
*data1
= d1
;
2175 const struct font_sort_data
*data2
= d2
;
2177 if (data1
->score
< data2
->score
)
2179 else if (data1
->score
> data2
->score
)
2181 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2185 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2186 If PREFER specifies a point-size, calculate the corresponding
2187 pixel-size from QCdpi property of PREFER or from the Y-resolution
2188 of FRAME before sorting.
2190 If BEST-ONLY is nonzero, return the best matching entity (that
2191 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2192 if BEST-ONLY is negative). Otherwise, return the sorted result as
2193 a single vector of font-entities.
2195 This function does no optimization for the case that the total
2196 number of elements is 1. The caller should avoid calling this in
2200 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2202 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2204 struct font_sort_data
*data
;
2205 unsigned best_score
;
2206 Lisp_Object best_entity
;
2207 struct frame
*f
= XFRAME (frame
);
2208 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2211 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2212 prefer_prop
[i
] = AREF (prefer
, i
);
2213 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2214 prefer_prop
[FONT_SIZE_INDEX
]
2215 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2217 if (NILP (XCDR (list
)))
2219 /* What we have to take care of is this single vector. */
2221 maxlen
= ASIZE (vec
);
2225 /* We don't have to perform sort, so there's no need of creating
2226 a single vector. But, we must find the length of the longest
2229 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2230 if (maxlen
< ASIZE (XCAR (tail
)))
2231 maxlen
= ASIZE (XCAR (tail
));
2235 /* We have to create a single vector to sort it. */
2236 vec
= font_vconcat_entity_vectors (list
);
2237 maxlen
= ASIZE (vec
);
2240 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2241 best_score
= 0xFFFFFFFF;
2244 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2246 int font_driver_preference
= 0;
2247 Lisp_Object current_font_driver
;
2253 /* We are sure that the length of VEC > 0. */
2254 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2255 /* Score the elements. */
2256 for (i
= 0; i
< len
; i
++)
2258 data
[i
].entity
= AREF (vec
, i
);
2260 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2262 ? font_score (data
[i
].entity
, prefer_prop
)
2264 if (best_only
&& best_score
> data
[i
].score
)
2266 best_score
= data
[i
].score
;
2267 best_entity
= data
[i
].entity
;
2268 if (best_score
== 0)
2271 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2273 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2274 font_driver_preference
++;
2276 data
[i
].font_driver_preference
= font_driver_preference
;
2279 /* Sort if necessary. */
2282 qsort (data
, len
, sizeof *data
, font_compare
);
2283 for (i
= 0; i
< len
; i
++)
2284 ASET (vec
, i
, data
[i
].entity
);
2293 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2298 /* API of Font Service Layer. */
2300 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2301 sort_shift_bits. Finternal_set_font_selection_order calls this
2302 function with font_sort_order after setting up it. */
2305 font_update_sort_order (int *order
)
2309 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2311 int xlfd_idx
= order
[i
];
2313 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2314 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2315 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2316 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2317 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2318 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2320 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2325 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2330 table
= assq_no_quit (script
, table
);
2333 table
= XCDR (table
);
2334 if (! NILP (langsys
))
2336 table
= assq_no_quit (langsys
, table
);
2342 val
= assq_no_quit (Qnil
, table
);
2344 table
= XCAR (table
);
2348 table
= XCDR (table
);
2349 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2351 if (NILP (XCAR (features
)))
2356 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2362 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2365 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2367 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2369 script
= XCAR (spec
);
2373 langsys
= XCAR (spec
);
2384 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2385 XCAR (otf_capability
)))
2387 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2388 XCDR (otf_capability
)))
2395 /* Check if FONT (font-entity or font-object) matches with the font
2396 specification SPEC. */
2399 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2401 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2402 Lisp_Object extra
, font_extra
;
2405 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2406 if (! NILP (AREF (spec
, i
))
2407 && ! NILP (AREF (font
, i
))
2408 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2410 props
= XFONT_SPEC (spec
)->props
;
2411 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2413 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2414 prop
[i
] = AREF (spec
, i
);
2415 prop
[FONT_SIZE_INDEX
]
2416 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2420 if (font_score (font
, props
) > 0)
2422 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2423 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2424 for (; CONSP (extra
); extra
= XCDR (extra
))
2426 Lisp_Object key
= XCAR (XCAR (extra
));
2427 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2429 if (EQ (key
, QClang
))
2431 val2
= assq_no_quit (key
, font_extra
);
2440 if (NILP (Fmemq (val
, val2
)))
2445 ? NILP (Fmemq (val
, XCDR (val2
)))
2449 else if (EQ (key
, QCscript
))
2451 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2457 /* All characters in the list must be supported. */
2458 for (; CONSP (val2
); val2
= XCDR (val2
))
2460 if (! CHARACTERP (XCAR (val2
)))
2462 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2463 == FONT_INVALID_CODE
)
2467 else if (VECTORP (val2
))
2469 /* At most one character in the vector must be supported. */
2470 for (i
= 0; i
< ASIZE (val2
); i
++)
2472 if (! CHARACTERP (AREF (val2
, i
)))
2474 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2475 != FONT_INVALID_CODE
)
2478 if (i
== ASIZE (val2
))
2483 else if (EQ (key
, QCotf
))
2487 if (! FONT_OBJECT_P (font
))
2489 fontp
= XFONT_OBJECT (font
);
2490 if (! fontp
->driver
->otf_capability
)
2492 val2
= fontp
->driver
->otf_capability (fontp
);
2493 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2504 Each font backend has the callback function get_cache, and it
2505 returns a cons cell of which cdr part can be freely used for
2506 caching fonts. The cons cell may be shared by multiple frames
2507 and/or multiple font drivers. So, we arrange the cdr part as this:
2509 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2511 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2512 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2513 cons (FONT-SPEC FONT-ENTITY ...). */
2515 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2516 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2517 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2518 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2519 struct font_driver
*);
2522 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2524 Lisp_Object cache
, val
;
2526 cache
= driver
->get_cache (f
);
2528 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2532 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2533 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2537 val
= XCDR (XCAR (val
));
2538 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2544 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2546 Lisp_Object cache
, val
, tmp
;
2549 cache
= driver
->get_cache (f
);
2551 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2552 cache
= val
, val
= XCDR (val
);
2553 font_assert (! NILP (val
));
2554 tmp
= XCDR (XCAR (val
));
2555 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2556 if (XINT (XCAR (tmp
)) == 0)
2558 font_clear_cache (f
, XCAR (val
), driver
);
2559 XSETCDR (cache
, XCDR (val
));
2565 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2567 Lisp_Object val
= driver
->get_cache (f
);
2568 Lisp_Object type
= driver
->type
;
2570 font_assert (CONSP (val
));
2571 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2572 font_assert (CONSP (val
));
2573 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2574 val
= XCDR (XCAR (val
));
2578 static int num_fonts
;
2581 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2583 Lisp_Object tail
, elt
;
2584 Lisp_Object tail2
, entity
;
2586 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2587 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2590 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2591 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2593 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2595 entity
= XCAR (tail2
);
2597 if (FONT_ENTITY_P (entity
)
2598 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2600 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2602 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2604 Lisp_Object val
= XCAR (objlist
);
2605 struct font
*font
= XFONT_OBJECT (val
);
2607 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2609 font_assert (font
&& driver
== font
->driver
);
2610 driver
->close (f
, font
);
2614 if (driver
->free_entity
)
2615 driver
->free_entity (entity
);
2620 XSETCDR (cache
, Qnil
);
2624 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2626 /* Check each font-entity in VEC, and return a list of font-entities
2627 that satisfy these conditions:
2628 (1) matches with SPEC and SIZE if SPEC is not nil, and
2629 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2633 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2635 Lisp_Object entity
, val
;
2636 enum font_property_index prop
;
2639 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2641 entity
= AREF (vec
, i
);
2642 if (! NILP (Vface_ignored_fonts
))
2646 Lisp_Object tail
, regexp
;
2648 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2651 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2653 regexp
= XCAR (tail
);
2654 if (STRINGP (regexp
)
2655 && fast_c_string_match_ignore_case (regexp
, name
,
2665 val
= Fcons (entity
, val
);
2668 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2669 if (INTEGERP (AREF (spec
, prop
))
2670 && ((XINT (AREF (spec
, prop
)) >> 8)
2671 != (XINT (AREF (entity
, prop
)) >> 8)))
2672 prop
= FONT_SPEC_MAX
;
2673 if (prop
< FONT_SPEC_MAX
2675 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2677 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2680 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2681 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2682 prop
= FONT_SPEC_MAX
;
2684 if (prop
< FONT_SPEC_MAX
2685 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2686 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2687 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2688 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2689 prop
= FONT_SPEC_MAX
;
2690 if (prop
< FONT_SPEC_MAX
2691 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2692 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2693 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2694 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2695 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2696 prop
= FONT_SPEC_MAX
;
2697 if (prop
< FONT_SPEC_MAX
)
2698 val
= Fcons (entity
, val
);
2700 return (Fvconcat (1, &val
));
2704 /* Return a list of vectors of font-entities matching with SPEC on
2705 FRAME. Each elements in the list is a vector of entities from the
2706 same font-driver. */
2709 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2711 FRAME_PTR f
= XFRAME (frame
);
2712 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2713 Lisp_Object ftype
, val
;
2714 Lisp_Object list
= Qnil
;
2716 int need_filtering
= 0;
2719 font_assert (FONT_SPEC_P (spec
));
2721 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2722 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2723 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2724 size
= font_pixel_size (f
, spec
);
2728 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2729 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2730 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2731 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2732 if (i
!= FONT_SPACING_INDEX
)
2734 ASET (scratch_font_spec
, i
, Qnil
);
2735 if (! NILP (AREF (spec
, i
)))
2738 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2739 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2741 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2743 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2745 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2747 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2748 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2755 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2759 val
= Fvconcat (1, &val
);
2760 copy
= copy_font_spec (scratch_font_spec
);
2761 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2762 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2766 || ! NILP (Vface_ignored_fonts
)))
2767 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2768 if (ASIZE (val
) > 0)
2769 list
= Fcons (val
, list
);
2772 list
= Fnreverse (list
);
2773 FONT_ADD_LOG ("list", spec
, list
);
2778 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2779 nil, is an array of face's attributes, which specifies preferred
2780 font-related attributes. */
2783 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2785 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2786 Lisp_Object ftype
, size
, entity
;
2788 Lisp_Object work
= copy_font_spec (spec
);
2790 XSETFRAME (frame
, f
);
2791 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2792 size
= AREF (spec
, FONT_SIZE_INDEX
);
2795 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2796 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2797 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2798 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2801 for (; driver_list
; driver_list
= driver_list
->next
)
2803 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2805 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2808 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2809 entity
= assoc_no_quit (work
, XCDR (cache
));
2811 entity
= XCDR (entity
);
2814 entity
= driver_list
->driver
->match (frame
, work
);
2815 copy
= copy_font_spec (work
);
2816 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2817 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2819 if (! NILP (entity
))
2822 FONT_ADD_LOG ("match", work
, entity
);
2827 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2828 opened font object. */
2831 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2833 struct font_driver_list
*driver_list
;
2834 Lisp_Object objlist
, size
, val
, font_object
;
2836 int min_width
, height
;
2837 int scaled_pixel_size
= pixel_size
;
2839 font_assert (FONT_ENTITY_P (entity
));
2840 size
= AREF (entity
, FONT_SIZE_INDEX
);
2841 if (XINT (size
) != 0)
2842 scaled_pixel_size
= pixel_size
= XINT (size
);
2843 else if (CONSP (Vface_font_rescale_alist
))
2844 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2846 val
= AREF (entity
, FONT_TYPE_INDEX
);
2847 for (driver_list
= f
->font_driver_list
;
2848 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2849 driver_list
= driver_list
->next
);
2853 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2854 objlist
= XCDR (objlist
))
2856 Lisp_Object fn
= XCAR (objlist
);
2857 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2858 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2860 if (driver_list
->driver
->cached_font_ok
== NULL
2861 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2866 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2867 if (!NILP (font_object
))
2868 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2869 FONT_ADD_LOG ("open", entity
, font_object
);
2870 if (NILP (font_object
))
2872 ASET (entity
, FONT_OBJLIST_INDEX
,
2873 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2876 font
= XFONT_OBJECT (font_object
);
2877 min_width
= (font
->min_width
? font
->min_width
2878 : font
->average_width
? font
->average_width
2879 : font
->space_width
? font
->space_width
2881 height
= (font
->height
? font
->height
: 1);
2882 #ifdef HAVE_WINDOW_SYSTEM
2883 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2884 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2886 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2887 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2888 fonts_changed_p
= 1;
2892 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2893 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2894 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2895 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2903 /* Close FONT_OBJECT that is opened on frame F. */
2906 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2908 struct font
*font
= XFONT_OBJECT (font_object
);
2910 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2911 /* Already closed. */
2913 FONT_ADD_LOG ("close", font_object
, Qnil
);
2914 font
->driver
->close (f
, font
);
2915 #ifdef HAVE_WINDOW_SYSTEM
2916 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2917 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2923 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2924 FONT is a font-entity and it must be opened to check. */
2927 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2931 if (FONT_ENTITY_P (font
))
2933 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2934 struct font_driver_list
*driver_list
;
2936 for (driver_list
= f
->font_driver_list
;
2937 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2938 driver_list
= driver_list
->next
);
2941 if (! driver_list
->driver
->has_char
)
2943 return driver_list
->driver
->has_char (font
, c
);
2946 font_assert (FONT_OBJECT_P (font
));
2947 fontp
= XFONT_OBJECT (font
);
2948 if (fontp
->driver
->has_char
)
2950 int result
= fontp
->driver
->has_char (font
, c
);
2955 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2959 /* Return the glyph ID of FONT_OBJECT for character C. */
2962 font_encode_char (Lisp_Object font_object
, int c
)
2966 font_assert (FONT_OBJECT_P (font_object
));
2967 font
= XFONT_OBJECT (font_object
);
2968 return font
->driver
->encode_char (font
, c
);
2972 /* Return the name of FONT_OBJECT. */
2975 font_get_name (Lisp_Object font_object
)
2977 font_assert (FONT_OBJECT_P (font_object
));
2978 return AREF (font_object
, FONT_NAME_INDEX
);
2982 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2983 could not be parsed by font_parse_name, return Qnil. */
2986 font_spec_from_name (Lisp_Object font_name
)
2988 Lisp_Object spec
= Ffont_spec (0, NULL
);
2990 CHECK_STRING (font_name
);
2991 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2993 font_put_extra (spec
, QCname
, font_name
);
2994 font_put_extra (spec
, QCuser_spec
, font_name
);
3000 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3002 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3007 if (! NILP (Ffont_get (font
, QCname
)))
3009 font
= copy_font_spec (font
);
3010 font_put_extra (font
, QCname
, Qnil
);
3013 if (NILP (AREF (font
, prop
))
3014 && prop
!= FONT_FAMILY_INDEX
3015 && prop
!= FONT_FOUNDRY_INDEX
3016 && prop
!= FONT_WIDTH_INDEX
3017 && prop
!= FONT_SIZE_INDEX
)
3019 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3020 font
= copy_font_spec (font
);
3021 ASET (font
, prop
, Qnil
);
3022 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3024 if (prop
== FONT_FAMILY_INDEX
)
3026 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3027 /* If we are setting the font family, we must also clear
3028 FONT_WIDTH_INDEX to avoid rejecting families that lack
3029 support for some widths. */
3030 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3032 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3033 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3034 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
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_SIZE_INDEX
)
3041 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3042 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3043 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3045 else if (prop
== FONT_WIDTH_INDEX
)
3046 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3047 attrs
[LFACE_FONT_INDEX
] = font
;
3050 /* Select a font from ENTITIES (list of font-entity vectors) that
3051 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3054 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3056 Lisp_Object font_entity
;
3059 FRAME_PTR f
= XFRAME (frame
);
3061 if (NILP (XCDR (entities
))
3062 && ASIZE (XCAR (entities
)) == 1)
3064 font_entity
= AREF (XCAR (entities
), 0);
3066 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3071 /* Sort fonts by properties specified in ATTRS. */
3072 prefer
= scratch_font_prefer
;
3074 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3075 ASET (prefer
, i
, Qnil
);
3076 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3078 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3080 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3081 ASET (prefer
, i
, AREF (face_font
, i
));
3083 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3084 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3085 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3086 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3087 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3088 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3089 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3091 return font_sort_entities (entities
, prefer
, frame
, c
);
3094 /* Return a font-entity that satisfies SPEC and is the best match for
3095 face's font related attributes in ATTRS. C, if not negative, is a
3096 character that the entity must support. */
3099 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3102 Lisp_Object frame
, entities
, val
;
3103 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3108 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3109 if (NILP (registry
[0]))
3111 registry
[0] = DEFAULT_ENCODING
;
3112 registry
[1] = Qascii_0
;
3113 registry
[2] = null_vector
;
3116 registry
[1] = null_vector
;
3118 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3120 struct charset
*encoding
, *repertory
;
3122 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3123 &encoding
, &repertory
) < 0)
3126 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3128 else if (c
> encoding
->max_char
)
3132 work
= copy_font_spec (spec
);
3133 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3134 XSETFRAME (frame
, f
);
3135 pixel_size
= font_pixel_size (f
, spec
);
3136 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3138 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3140 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3142 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3143 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3144 if (! NILP (foundry
[0]))
3145 foundry
[1] = null_vector
;
3146 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3148 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3149 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3151 foundry
[2] = null_vector
;
3154 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3156 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3157 if (! NILP (adstyle
[0]))
3158 adstyle
[1] = null_vector
;
3159 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3161 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3163 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3165 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3167 adstyle
[2] = null_vector
;
3170 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3173 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3176 val
= AREF (work
, FONT_FAMILY_INDEX
);
3177 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3179 val
= attrs
[LFACE_FAMILY_INDEX
];
3180 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3184 family
= alloca ((sizeof family
[0]) * 2);
3186 family
[1] = null_vector
; /* terminator. */
3191 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3193 if (! NILP (alters
))
3195 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3196 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3197 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3198 family
[i
] = XCAR (alters
);
3199 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3201 family
[i
] = null_vector
;
3205 family
= alloca ((sizeof family
[0]) * 3);
3208 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3210 family
[i
] = null_vector
;
3214 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3216 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3217 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3219 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3220 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3222 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3223 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3225 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3226 entities
= font_list_entities (frame
, work
);
3227 if (! NILP (entities
))
3229 val
= font_select_entity (frame
, entities
,
3230 attrs
, pixel_size
, c
);
3245 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3249 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3250 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3251 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3252 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3253 size
= font_pixel_size (f
, spec
);
3257 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3258 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3261 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3262 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3263 if (INTEGERP (height
))
3266 abort (); /* We should never end up here. */
3270 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3274 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3275 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3279 return font_open_entity (f
, entity
, size
);
3283 /* Find a font that satisfies SPEC and is the best match for
3284 face's attributes in ATTRS on FRAME, and return the opened
3288 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3290 Lisp_Object entity
, name
;
3292 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3295 /* No font is listed for SPEC, but each font-backend may have
3296 different criteria about "font matching". So, try it. */
3297 entity
= font_matching_entity (f
, attrs
, spec
);
3301 /* Don't lose the original name that was put in initially. We need
3302 it to re-apply the font when font parameters (like hinting or dpi) have
3304 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3307 name
= Ffont_get (spec
, QCuser_spec
);
3308 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3314 /* Make FACE on frame F ready to use the font opened for FACE. */
3317 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3319 if (face
->font
->driver
->prepare_face
)
3320 face
->font
->driver
->prepare_face (f
, face
);
3324 /* Make FACE on frame F stop using the font opened for FACE. */
3327 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3329 if (face
->font
->driver
->done_face
)
3330 face
->font
->driver
->done_face (f
, face
);
3335 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3336 font is found, return Qnil. */
3339 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3341 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3343 /* We set up the default font-related attributes of a face to prefer
3345 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3346 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3347 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3349 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3351 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3353 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3355 return font_load_for_lface (f
, attrs
, spec
);
3359 /* Open a font that matches NAME on frame F. If no proper font is
3360 found, return Qnil. */
3363 font_open_by_name (FRAME_PTR f
, const char *name
, ptrdiff_t len
)
3365 Lisp_Object args
[2];
3366 Lisp_Object spec
, ret
;
3369 args
[1] = make_unibyte_string (name
, len
);
3370 spec
= Ffont_spec (2, args
);
3371 ret
= font_open_by_spec (f
, spec
);
3372 /* Do not lose name originally put in. */
3374 font_put_extra (ret
, QCuser_spec
, args
[1]);
3380 /* Register font-driver DRIVER. This function is used in two ways.
3382 The first is with frame F non-NULL. In this case, make DRIVER
3383 available (but not yet activated) on F. All frame creators
3384 (e.g. Fx_create_frame) must call this function at least once with
3385 an available font-driver.
3387 The second is with frame F NULL. In this case, DRIVER is globally
3388 registered in the variable `font_driver_list'. All font-driver
3389 implementations must call this function in its syms_of_XXXX
3390 (e.g. syms_of_xfont). */
3393 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3395 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3396 struct font_driver_list
*prev
, *list
;
3398 if (f
&& ! driver
->draw
)
3399 error ("Unusable font driver for a frame: %s",
3400 SDATA (SYMBOL_NAME (driver
->type
)));
3402 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3403 if (EQ (list
->driver
->type
, driver
->type
))
3404 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3406 list
= xmalloc (sizeof *list
);
3408 list
->driver
= driver
;
3413 f
->font_driver_list
= list
;
3415 font_driver_list
= list
;
3421 free_font_driver_list (FRAME_PTR f
)
3423 struct font_driver_list
*list
, *next
;
3425 for (list
= f
->font_driver_list
; list
; list
= next
)
3430 f
->font_driver_list
= NULL
;
3434 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3435 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3436 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3438 A caller must free all realized faces if any in advance. The
3439 return value is a list of font backends actually made used on
3443 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3445 Lisp_Object active_drivers
= Qnil
;
3446 struct font_driver_list
*list
;
3448 /* At first, turn off non-requested drivers, and turn on requested
3450 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3452 struct font_driver
*driver
= list
->driver
;
3453 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3458 if (driver
->end_for_frame
)
3459 driver
->end_for_frame (f
);
3460 font_finish_cache (f
, driver
);
3465 if (! driver
->start_for_frame
3466 || driver
->start_for_frame (f
) == 0)
3468 font_prepare_cache (f
, driver
);
3475 if (NILP (new_drivers
))
3478 if (! EQ (new_drivers
, Qt
))
3480 /* Re-order the driver list according to new_drivers. */
3481 struct font_driver_list
**list_table
, **next
;
3485 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3486 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3488 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3489 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3492 list_table
[i
++] = list
;
3494 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3496 list_table
[i
++] = list
;
3497 list_table
[i
] = NULL
;
3499 next
= &f
->font_driver_list
;
3500 for (i
= 0; list_table
[i
]; i
++)
3502 *next
= list_table
[i
];
3503 next
= &(*next
)->next
;
3507 if (! f
->font_driver_list
->on
)
3508 { /* None of the drivers is enabled: enable them all.
3509 Happens if you set the list of drivers to (xft x) in your .emacs
3510 and then use it under w32 or ns. */
3511 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3513 struct font_driver
*driver
= list
->driver
;
3514 eassert (! list
->on
);
3515 if (! driver
->start_for_frame
3516 || driver
->start_for_frame (f
) == 0)
3518 font_prepare_cache (f
, driver
);
3525 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3527 active_drivers
= nconc2 (active_drivers
,
3528 Fcons (list
->driver
->type
, Qnil
));
3529 return active_drivers
;
3533 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3535 struct font_data_list
*list
, *prev
;
3537 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3538 prev
= list
, list
= list
->next
)
3539 if (list
->driver
== driver
)
3546 prev
->next
= list
->next
;
3548 f
->font_data_list
= list
->next
;
3556 list
= xmalloc (sizeof *list
);
3557 list
->driver
= driver
;
3558 list
->next
= f
->font_data_list
;
3559 f
->font_data_list
= list
;
3567 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3569 struct font_data_list
*list
;
3571 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3572 if (list
->driver
== driver
)
3580 /* Sets attributes on a font. Any properties that appear in ALIST and
3581 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3582 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3583 arrays of strings. This function is intended for use by the font
3584 drivers to implement their specific font_filter_properties. */
3586 font_filter_properties (Lisp_Object font
,
3588 const char *const boolean_properties
[],
3589 const char *const non_boolean_properties
[])
3594 /* Set boolean values to Qt or Qnil */
3595 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3596 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3598 Lisp_Object key
= XCAR (XCAR (it
));
3599 Lisp_Object val
= XCDR (XCAR (it
));
3600 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3602 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3604 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3605 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3608 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3609 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3610 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3611 || strcmp ("Off", str
) == 0)
3616 Ffont_put (font
, key
, val
);
3620 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3621 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3623 Lisp_Object key
= XCAR (XCAR (it
));
3624 Lisp_Object val
= XCDR (XCAR (it
));
3625 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3626 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3627 Ffont_put (font
, key
, val
);
3632 /* Return the font used to draw character C by FACE at buffer position
3633 POS in window W. If STRING is non-nil, it is a string containing C
3634 at index POS. If C is negative, get C from the current buffer or
3638 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3643 Lisp_Object font_object
;
3645 multibyte
= (NILP (string
)
3646 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3647 : STRING_MULTIBYTE (string
));
3654 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3656 c
= FETCH_CHAR (pos_byte
);
3659 c
= FETCH_BYTE (pos
);
3665 multibyte
= STRING_MULTIBYTE (string
);
3668 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3670 str
= SDATA (string
) + pos_byte
;
3671 c
= STRING_CHAR (str
);
3674 c
= SDATA (string
)[pos
];
3678 f
= XFRAME (w
->frame
);
3679 if (! FRAME_WINDOW_P (f
))
3686 if (STRINGP (string
))
3687 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3688 DEFAULT_FACE_ID
, 0);
3690 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3692 face
= FACE_FROM_ID (f
, face_id
);
3696 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3697 face
= FACE_FROM_ID (f
, face_id
);
3702 XSETFONT (font_object
, face
->font
);
3707 #ifdef HAVE_WINDOW_SYSTEM
3709 /* Check how many characters after POS (at most to *LIMIT) can be
3710 displayed by the same font in the window W. FACE, if non-NULL, is
3711 the face selected for the character at POS. If STRING is not nil,
3712 it is the string to check instead of the current buffer. In that
3713 case, FACE must be not NULL.
3715 The return value is the font-object for the character at POS.
3716 *LIMIT is set to the position where that font can't be used.
3718 It is assured that the current buffer (or STRING) is multibyte. */
3721 font_range (ptrdiff_t pos
, ptrdiff_t *limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3723 ptrdiff_t pos_byte
, ignore
;
3725 Lisp_Object font_object
= Qnil
;
3729 pos_byte
= CHAR_TO_BYTE (pos
);
3734 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3736 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3742 pos_byte
= string_char_to_byte (string
, pos
);
3745 while (pos
< *limit
)
3747 Lisp_Object category
;
3750 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3752 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3753 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3754 if (INTEGERP (category
)
3755 && (XINT (category
) == UNICODE_CATEGORY_Cf
3756 || CHAR_VARIATION_SELECTOR_P (c
)))
3758 if (NILP (font_object
))
3760 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3761 if (NILP (font_object
))
3765 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3775 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3776 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3777 Return nil otherwise.
3778 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3779 which kind of font it is. It must be one of `font-spec', `font-entity',
3781 (Lisp_Object object
, Lisp_Object extra_type
)
3783 if (NILP (extra_type
))
3784 return (FONTP (object
) ? Qt
: Qnil
);
3785 if (EQ (extra_type
, Qfont_spec
))
3786 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3787 if (EQ (extra_type
, Qfont_entity
))
3788 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3789 if (EQ (extra_type
, Qfont_object
))
3790 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3791 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3794 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3795 doc
: /* Return a newly created font-spec with arguments as properties.
3797 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3798 valid font property name listed below:
3800 `:family', `:weight', `:slant', `:width'
3802 They are the same as face attributes of the same name. See
3803 `set-face-attribute'.
3807 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3811 VALUE must be a string or a symbol specifying the additional
3812 typographic style information of a font, e.g. ``sans''.
3816 VALUE must be a string or a symbol specifying the charset registry and
3817 encoding of a font, e.g. ``iso8859-1''.
3821 VALUE must be a non-negative integer or a floating point number
3822 specifying the font size. It specifies the font size in pixels (if
3823 VALUE is an integer), or in points (if VALUE is a float).
3827 VALUE must be a string of XLFD-style or fontconfig-style font name.
3831 VALUE must be a symbol representing a script that the font must
3832 support. It may be a symbol representing a subgroup of a script
3833 listed in the variable `script-representative-chars'.
3837 VALUE must be a symbol of two-letter ISO-639 language names,
3842 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3843 required OpenType features.
3845 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3846 LANGSYS-TAG: OpenType language system tag symbol,
3847 or nil for the default language system.
3848 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3849 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3851 GSUB and GPOS may contain `nil' element. In such a case, the font
3852 must not have any of the remaining elements.
3854 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3855 be an OpenType font whose GPOS table of `thai' script's default
3856 language system must contain `mark' feature.
3858 usage: (font-spec ARGS...) */)
3859 (ptrdiff_t nargs
, Lisp_Object
*args
)
3861 Lisp_Object spec
= font_make_spec ();
3864 for (i
= 0; i
< nargs
; i
+= 2)
3866 Lisp_Object key
= args
[i
], val
;
3870 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3873 if (EQ (key
, QCname
))
3876 font_parse_name (SSDATA (val
), SBYTES (val
), spec
);
3877 font_put_extra (spec
, key
, val
);
3881 int idx
= get_font_prop_index (key
);
3885 val
= font_prop_validate (idx
, Qnil
, val
);
3886 if (idx
< FONT_EXTRA_INDEX
)
3887 ASET (spec
, idx
, val
);
3889 font_put_extra (spec
, key
, val
);
3892 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3898 /* Return a copy of FONT as a font-spec. */
3900 copy_font_spec (Lisp_Object font
)
3902 Lisp_Object new_spec
, tail
, prev
, extra
;
3906 new_spec
= font_make_spec ();
3907 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3908 ASET (new_spec
, i
, AREF (font
, i
));
3909 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3910 /* We must remove :font-entity property. */
3911 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3912 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3915 extra
= XCDR (extra
);
3917 XSETCDR (prev
, XCDR (tail
));
3920 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3924 /* Merge font-specs FROM and TO, and return a new font-spec.
3925 Every specified property in FROM overrides the corresponding
3928 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3930 Lisp_Object extra
, tail
;
3935 to
= copy_font_spec (to
);
3936 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3937 ASET (to
, i
, AREF (from
, i
));
3938 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3939 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3940 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3942 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3945 XSETCDR (slot
, XCDR (XCAR (tail
)));
3947 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3949 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3953 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3954 doc
: /* Return the value of FONT's property KEY.
3955 FONT is a font-spec, a font-entity, or a font-object.
3956 KEY is any symbol, but these are reserved for specific meanings:
3957 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3958 :size, :name, :script, :otf
3959 See the documentation of `font-spec' for their meanings.
3960 In addition, if FONT is a font-entity or a font-object, values of
3961 :script and :otf are different from those of a font-spec as below:
3963 The value of :script may be a list of scripts that are supported by the font.
3965 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3966 representing the OpenType features supported by the font by this form:
3967 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3968 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3970 (Lisp_Object font
, Lisp_Object key
)
3978 idx
= get_font_prop_index (key
);
3979 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3980 return font_style_symbolic (font
, idx
, 0);
3981 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3982 return AREF (font
, idx
);
3983 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3984 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3986 struct font
*fontp
= XFONT_OBJECT (font
);
3988 if (fontp
->driver
->otf_capability
)
3989 val
= fontp
->driver
->otf_capability (fontp
);
3991 val
= Fcons (Qnil
, Qnil
);
3998 #ifdef HAVE_WINDOW_SYSTEM
4000 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4001 doc
: /* Return a plist of face attributes generated by FONT.
4002 FONT is a font name, a font-spec, a font-entity, or a font-object.
4003 The return value is a list of the form
4005 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4007 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4008 compatible with `set-face-attribute'. Some of these key-attribute pairs
4009 may be omitted from the list if they are not specified by FONT.
4011 The optional argument FRAME specifies the frame that the face attributes
4012 are to be displayed on. If omitted, the selected frame is used. */)
4013 (Lisp_Object font
, Lisp_Object frame
)
4016 Lisp_Object plist
[10];
4021 frame
= selected_frame
;
4022 CHECK_LIVE_FRAME (frame
);
4027 int fontset
= fs_query_fontset (font
, 0);
4028 Lisp_Object name
= font
;
4030 font
= fontset_ascii (fontset
);
4031 font
= font_spec_from_name (name
);
4033 signal_error ("Invalid font name", name
);
4035 else if (! FONTP (font
))
4036 signal_error ("Invalid font object", font
);
4038 val
= AREF (font
, FONT_FAMILY_INDEX
);
4041 plist
[n
++] = QCfamily
;
4042 plist
[n
++] = SYMBOL_NAME (val
);
4045 val
= AREF (font
, FONT_SIZE_INDEX
);
4048 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4049 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4050 plist
[n
++] = QCheight
;
4051 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4053 else if (FLOATP (val
))
4055 plist
[n
++] = QCheight
;
4056 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4059 val
= FONT_WEIGHT_FOR_FACE (font
);
4062 plist
[n
++] = QCweight
;
4066 val
= FONT_SLANT_FOR_FACE (font
);
4069 plist
[n
++] = QCslant
;
4073 val
= FONT_WIDTH_FOR_FACE (font
);
4076 plist
[n
++] = QCwidth
;
4080 return Flist (n
, plist
);
4085 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4086 doc
: /* Set one property of FONT: give property KEY value VAL.
4087 FONT is a font-spec, a font-entity, or a font-object.
4089 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4090 accepted by the function `font-spec' (which see), VAL must be what
4091 allowed in `font-spec'.
4093 If FONT is a font-entity or a font-object, KEY must not be the one
4094 accepted by `font-spec'. */)
4095 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4099 idx
= get_font_prop_index (prop
);
4100 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4102 CHECK_FONT_SPEC (font
);
4103 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4107 if (EQ (prop
, QCname
)
4108 || EQ (prop
, QCscript
)
4109 || EQ (prop
, QClang
)
4110 || EQ (prop
, QCotf
))
4111 CHECK_FONT_SPEC (font
);
4114 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4119 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4120 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4121 Optional 2nd argument FRAME specifies the target frame.
4122 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4123 Optional 4th argument PREFER, if non-nil, is a font-spec to
4124 control the order of the returned list. Fonts are sorted by
4125 how close they are to PREFER. */)
4126 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4128 Lisp_Object vec
, list
;
4132 frame
= selected_frame
;
4133 CHECK_LIVE_FRAME (frame
);
4134 CHECK_FONT_SPEC (font_spec
);
4142 if (! NILP (prefer
))
4143 CHECK_FONT_SPEC (prefer
);
4145 list
= font_list_entities (frame
, font_spec
);
4148 if (NILP (XCDR (list
))
4149 && ASIZE (XCAR (list
)) == 1)
4150 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4152 if (! NILP (prefer
))
4153 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4155 vec
= font_vconcat_entity_vectors (list
);
4156 if (n
== 0 || n
>= ASIZE (vec
))
4158 Lisp_Object args
[2];
4162 list
= Fappend (2, args
);
4166 for (list
= Qnil
, n
--; n
>= 0; n
--)
4167 list
= Fcons (AREF (vec
, n
), list
);
4172 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4173 doc
: /* List available font families on the current frame.
4174 Optional argument FRAME, if non-nil, specifies the target frame. */)
4178 struct font_driver_list
*driver_list
;
4182 frame
= selected_frame
;
4183 CHECK_LIVE_FRAME (frame
);
4186 for (driver_list
= f
->font_driver_list
; driver_list
;
4187 driver_list
= driver_list
->next
)
4188 if (driver_list
->driver
->list_family
)
4190 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4191 Lisp_Object tail
= list
;
4193 for (; CONSP (val
); val
= XCDR (val
))
4194 if (NILP (Fmemq (XCAR (val
), tail
))
4195 && SYMBOLP (XCAR (val
)))
4196 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4201 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4202 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4203 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4204 (Lisp_Object font_spec
, Lisp_Object frame
)
4206 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4213 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4214 doc
: /* Return XLFD name of FONT.
4215 FONT is a font-spec, font-entity, or font-object.
4216 If the name is too long for XLFD (maximum 255 chars), return nil.
4217 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4218 the consecutive wildcards are folded into one. */)
4219 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4222 int namelen
, pixel_size
= 0;
4226 if (FONT_OBJECT_P (font
))
4228 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4230 if (STRINGP (font_name
)
4231 && SDATA (font_name
)[0] == '-')
4233 if (NILP (fold_wildcards
))
4235 strcpy (name
, SSDATA (font_name
));
4236 namelen
= SBYTES (font_name
);
4239 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4241 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4245 if (! NILP (fold_wildcards
))
4247 char *p0
= name
, *p1
;
4249 while ((p1
= strstr (p0
, "-*-*")))
4251 strcpy (p1
, p1
+ 2);
4257 return make_string (name
, namelen
);
4260 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4261 doc
: /* Clear font cache. */)
4264 Lisp_Object list
, frame
;
4266 FOR_EACH_FRAME (list
, frame
)
4268 FRAME_PTR f
= XFRAME (frame
);
4269 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4271 for (; driver_list
; driver_list
= driver_list
->next
)
4272 if (driver_list
->on
)
4274 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4275 Lisp_Object val
, tmp
;
4279 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4281 font_assert (! NILP (val
));
4282 tmp
= XCDR (XCAR (val
));
4283 if (XINT (XCAR (tmp
)) == 0)
4285 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4286 XSETCDR (cache
, XCDR (val
));
4296 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4298 struct font
*font
= XFONT_OBJECT (font_object
);
4299 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4300 struct font_metrics metrics
;
4302 LGLYPH_SET_CODE (glyph
, code
);
4303 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4304 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4305 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4306 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4307 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4308 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4312 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4313 doc
: /* Shape the glyph-string GSTRING.
4314 Shaping means substituting glyphs and/or adjusting positions of glyphs
4315 to get the correct visual image of character sequences set in the
4316 header of the glyph-string.
4318 If the shaping was successful, the value is GSTRING itself or a newly
4319 created glyph-string. Otherwise, the value is nil. */)
4320 (Lisp_Object gstring
)
4323 Lisp_Object font_object
, n
, glyph
;
4324 ptrdiff_t i
, j
, from
, to
;
4326 if (! composition_gstring_p (gstring
))
4327 signal_error ("Invalid glyph-string: ", gstring
);
4328 if (! NILP (LGSTRING_ID (gstring
)))
4330 font_object
= LGSTRING_FONT (gstring
);
4331 CHECK_FONT_OBJECT (font_object
);
4332 font
= XFONT_OBJECT (font_object
);
4333 if (! font
->driver
->shape
)
4336 /* Try at most three times with larger gstring each time. */
4337 for (i
= 0; i
< 3; i
++)
4339 n
= font
->driver
->shape (gstring
);
4342 gstring
= larger_vector (gstring
,
4343 LGSTRING_GLYPH_LEN (gstring
), -1);
4345 if (i
== 3 || XINT (n
) == 0)
4347 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4348 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4350 glyph
= LGSTRING_GLYPH (gstring
, 0);
4351 from
= LGLYPH_FROM (glyph
);
4352 to
= LGLYPH_TO (glyph
);
4353 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4355 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4359 if (NILP (LGLYPH_ADJUSTMENT (this)))
4364 glyph
= LGSTRING_GLYPH (gstring
, j
);
4365 LGLYPH_SET_FROM (glyph
, from
);
4366 LGLYPH_SET_TO (glyph
, to
);
4368 from
= LGLYPH_FROM (this);
4369 to
= LGLYPH_TO (this);
4374 if (from
> LGLYPH_FROM (this))
4375 from
= LGLYPH_FROM (this);
4376 if (to
< LGLYPH_TO (this))
4377 to
= LGLYPH_TO (this);
4383 glyph
= LGSTRING_GLYPH (gstring
, j
);
4384 LGLYPH_SET_FROM (glyph
, from
);
4385 LGLYPH_SET_TO (glyph
, to
);
4387 return composition_gstring_put_cache (gstring
, XINT (n
));
4390 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4392 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4393 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4395 VARIATION-SELECTOR is a character code of variation selection
4396 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4397 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4398 (Lisp_Object font_object
, Lisp_Object character
)
4400 unsigned variations
[256];
4405 CHECK_FONT_OBJECT (font_object
);
4406 CHECK_CHARACTER (character
);
4407 font
= XFONT_OBJECT (font_object
);
4408 if (! font
->driver
->get_variation_glyphs
)
4410 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4414 for (i
= 0; i
< 255; i
++)
4417 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4418 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4419 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4426 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4427 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4428 OTF-FEATURES specifies which features to apply in this format:
4429 (SCRIPT LANGSYS GSUB GPOS)
4431 SCRIPT is a symbol specifying a script tag of OpenType,
4432 LANGSYS is a symbol specifying a langsys tag of OpenType,
4433 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4435 If LANGYS is nil, the default langsys is selected.
4437 The features are applied in the order they appear in the list. The
4438 symbol `*' means to apply all available features not present in this
4439 list, and the remaining features are ignored. For instance, (vatu
4440 pstf * haln) is to apply vatu and pstf in this order, then to apply
4441 all available features other than vatu, pstf, and haln.
4443 The features are applied to the glyphs in the range FROM and TO of
4444 the glyph-string GSTRING-IN.
4446 If some feature is actually applicable, the resulting glyphs are
4447 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4448 this case, the value is the number of produced glyphs.
4450 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4453 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4454 produced in GSTRING-OUT, and the value is nil.
4456 See the documentation of `composition-get-gstring' for the format of
4458 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4460 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4465 check_otf_features (otf_features
);
4466 CHECK_FONT_OBJECT (font_object
);
4467 font
= XFONT_OBJECT (font_object
);
4468 if (! font
->driver
->otf_drive
)
4469 error ("Font backend %s can't drive OpenType GSUB table",
4470 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4471 CHECK_CONS (otf_features
);
4472 CHECK_SYMBOL (XCAR (otf_features
));
4473 val
= XCDR (otf_features
);
4474 CHECK_SYMBOL (XCAR (val
));
4475 val
= XCDR (otf_features
);
4478 len
= check_gstring (gstring_in
);
4479 CHECK_VECTOR (gstring_out
);
4480 CHECK_NATNUM (from
);
4482 CHECK_NATNUM (index
);
4484 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4485 args_out_of_range_3 (from
, to
, make_number (len
));
4486 if (XINT (index
) >= ASIZE (gstring_out
))
4487 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4488 num
= font
->driver
->otf_drive (font
, otf_features
,
4489 gstring_in
, XINT (from
), XINT (to
),
4490 gstring_out
, XINT (index
), 0);
4493 return make_number (num
);
4496 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4498 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4499 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4501 (SCRIPT LANGSYS FEATURE ...)
4502 See the documentation of `font-drive-otf' for more detail.
4504 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4505 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4506 character code corresponding to the glyph or nil if there's no
4507 corresponding character. */)
4508 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4511 Lisp_Object gstring_in
, gstring_out
, g
;
4512 Lisp_Object alternates
;
4515 CHECK_FONT_GET_OBJECT (font_object
, font
);
4516 if (! font
->driver
->otf_drive
)
4517 error ("Font backend %s can't drive OpenType GSUB table",
4518 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4519 CHECK_CHARACTER (character
);
4520 CHECK_CONS (otf_features
);
4522 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4523 g
= LGSTRING_GLYPH (gstring_in
, 0);
4524 LGLYPH_SET_CHAR (g
, XINT (character
));
4525 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4526 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4527 gstring_out
, 0, 1)) < 0)
4528 gstring_out
= Ffont_make_gstring (font_object
,
4529 make_number (ASIZE (gstring_out
) * 2));
4531 for (i
= 0; i
< num
; i
++)
4533 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4534 int c
= LGLYPH_CHAR (g
);
4535 unsigned code
= LGLYPH_CODE (g
);
4537 alternates
= Fcons (Fcons (make_number (code
),
4538 c
> 0 ? make_number (c
) : Qnil
),
4541 return Fnreverse (alternates
);
4547 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4548 doc
: /* Open FONT-ENTITY. */)
4549 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4553 CHECK_FONT_ENTITY (font_entity
);
4555 frame
= selected_frame
;
4556 CHECK_LIVE_FRAME (frame
);
4559 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4562 CHECK_NUMBER_OR_FLOAT (size
);
4564 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4566 isize
= XINT (size
);
4567 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4568 args_out_of_range (font_entity
, size
);
4572 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4575 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4576 doc
: /* Close FONT-OBJECT. */)
4577 (Lisp_Object font_object
, Lisp_Object frame
)
4579 CHECK_FONT_OBJECT (font_object
);
4581 frame
= selected_frame
;
4582 CHECK_LIVE_FRAME (frame
);
4583 font_close_object (XFRAME (frame
), font_object
);
4587 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4588 doc
: /* Return information about FONT-OBJECT.
4589 The value is a vector:
4590 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4593 NAME is the font name, a string (or nil if the font backend doesn't
4596 FILENAME is the font file name, a string (or nil if the font backend
4597 doesn't provide a file name).
4599 PIXEL-SIZE is a pixel size by which the font is opened.
4601 SIZE is a maximum advance width of the font in pixels.
4603 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4606 CAPABILITY is a list whose first element is a symbol representing the
4607 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4608 remaining elements describe the details of the font capability.
4610 If the font is OpenType font, the form of the list is
4611 \(opentype GSUB GPOS)
4612 where GSUB shows which "GSUB" features the font supports, and GPOS
4613 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4614 lists of the format:
4615 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4617 If the font is not OpenType font, currently the length of the form is
4620 SCRIPT is a symbol representing OpenType script tag.
4622 LANGSYS is a symbol representing OpenType langsys tag, or nil
4623 representing the default langsys.
4625 FEATURE is a symbol representing OpenType feature tag.
4627 If the font is not OpenType font, CAPABILITY is nil. */)
4628 (Lisp_Object font_object
)
4633 CHECK_FONT_GET_OBJECT (font_object
, font
);
4635 val
= Fmake_vector (make_number (9), Qnil
);
4636 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4637 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4638 ASET (val
, 2, make_number (font
->pixel_size
));
4639 ASET (val
, 3, make_number (font
->max_width
));
4640 ASET (val
, 4, make_number (font
->ascent
));
4641 ASET (val
, 5, make_number (font
->descent
));
4642 ASET (val
, 6, make_number (font
->space_width
));
4643 ASET (val
, 7, make_number (font
->average_width
));
4644 if (font
->driver
->otf_capability
)
4645 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4649 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4651 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4652 FROM and TO are positions (integers or markers) specifying a region
4653 of the current buffer.
4654 If the optional fourth arg OBJECT is not nil, it is a string or a
4655 vector containing the target characters.
4657 Each element is a vector containing information of a glyph in this format:
4658 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4660 FROM is an index numbers of a character the glyph corresponds to.
4661 TO is the same as FROM.
4662 C is the character of the glyph.
4663 CODE is the glyph-code of C in FONT-OBJECT.
4664 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4665 ADJUSTMENT is always nil.
4666 If FONT-OBJECT doesn't have a glyph for a character,
4667 the corresponding element is nil. */)
4668 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4673 Lisp_Object
*chars
, vec
;
4676 CHECK_FONT_GET_OBJECT (font_object
, font
);
4679 ptrdiff_t charpos
, bytepos
;
4681 validate_region (&from
, &to
);
4684 len
= XFASTINT (to
) - XFASTINT (from
);
4685 SAFE_ALLOCA_LISP (chars
, len
);
4686 charpos
= XFASTINT (from
);
4687 bytepos
= CHAR_TO_BYTE (charpos
);
4688 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4691 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4692 chars
[i
] = make_number (c
);
4695 else if (STRINGP (object
))
4697 const unsigned char *p
;
4699 CHECK_NUMBER (from
);
4701 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4702 || XINT (to
) > SCHARS (object
))
4703 args_out_of_range_3 (object
, from
, to
);
4706 len
= XFASTINT (to
) - XFASTINT (from
);
4707 SAFE_ALLOCA_LISP (chars
, len
);
4709 if (STRING_MULTIBYTE (object
))
4710 for (i
= 0; i
< len
; i
++)
4712 int c
= STRING_CHAR_ADVANCE (p
);
4713 chars
[i
] = make_number (c
);
4716 for (i
= 0; i
< len
; i
++)
4717 chars
[i
] = make_number (p
[i
]);
4721 CHECK_VECTOR (object
);
4722 CHECK_NUMBER (from
);
4724 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4725 || XINT (to
) > ASIZE (object
))
4726 args_out_of_range_3 (object
, from
, to
);
4729 len
= XFASTINT (to
) - XFASTINT (from
);
4730 for (i
= 0; i
< len
; i
++)
4732 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4733 CHECK_CHARACTER (elt
);
4735 chars
= &(AREF (object
, XFASTINT (from
)));
4738 vec
= Fmake_vector (make_number (len
), Qnil
);
4739 for (i
= 0; i
< len
; i
++)
4742 int c
= XFASTINT (chars
[i
]);
4744 struct font_metrics metrics
;
4746 code
= font
->driver
->encode_char (font
, c
);
4747 if (code
== FONT_INVALID_CODE
)
4749 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4750 LGLYPH_SET_FROM (g
, i
);
4751 LGLYPH_SET_TO (g
, i
);
4752 LGLYPH_SET_CHAR (g
, c
);
4753 LGLYPH_SET_CODE (g
, code
);
4754 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4755 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4756 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4757 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4758 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4759 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4762 if (! VECTORP (object
))
4767 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4768 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4769 FONT is a font-spec, font-entity, or font-object. */)
4770 (Lisp_Object spec
, Lisp_Object font
)
4772 CHECK_FONT_SPEC (spec
);
4775 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4778 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4779 doc
: /* Return a font-object for displaying a character at POSITION.
4780 Optional second arg WINDOW, if non-nil, is a window displaying
4781 the current buffer. It defaults to the currently selected window. */)
4782 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4789 CHECK_NUMBER_COERCE_MARKER (position
);
4790 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4791 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4792 pos
= XINT (position
);
4796 CHECK_NUMBER (position
);
4797 CHECK_STRING (string
);
4798 if (! (0 < XINT (position
) && XINT (position
) < SCHARS (string
)))
4799 args_out_of_range (string
, position
);
4800 pos
= XINT (position
);
4803 window
= selected_window
;
4804 CHECK_LIVE_WINDOW (window
);
4805 w
= XWINDOW (window
);
4807 return font_at (-1, pos
, NULL
, w
, string
);
4811 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4812 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4813 The value is a number of glyphs drawn.
4814 Type C-l to recover what previously shown. */)
4815 (Lisp_Object font_object
, Lisp_Object string
)
4817 Lisp_Object frame
= selected_frame
;
4818 FRAME_PTR f
= XFRAME (frame
);
4824 CHECK_FONT_GET_OBJECT (font_object
, font
);
4825 CHECK_STRING (string
);
4826 len
= SCHARS (string
);
4827 code
= alloca (sizeof (unsigned) * len
);
4828 for (i
= 0; i
< len
; i
++)
4830 Lisp_Object ch
= Faref (string
, make_number (i
));
4834 code
[i
] = font
->driver
->encode_char (font
, c
);
4835 if (code
[i
] == FONT_INVALID_CODE
)
4838 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4840 if (font
->driver
->prepare_face
)
4841 font
->driver
->prepare_face (f
, face
);
4842 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4843 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4844 if (font
->driver
->done_face
)
4845 font
->driver
->done_face (f
, face
);
4847 return make_number (len
);
4851 #endif /* FONT_DEBUG */
4853 #ifdef HAVE_WINDOW_SYSTEM
4855 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4856 doc
: /* Return information about a font named NAME on frame FRAME.
4857 If FRAME is omitted or nil, use the selected frame.
4858 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4859 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4861 OPENED-NAME is the name used for opening the font,
4862 FULL-NAME is the full name of the font,
4863 SIZE is the pixelsize of the font,
4864 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4865 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4866 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4867 how to compose characters.
4868 If the named font is not yet loaded, return nil. */)
4869 (Lisp_Object name
, Lisp_Object frame
)
4874 Lisp_Object font_object
;
4876 (*check_window_system_func
) ();
4879 CHECK_STRING (name
);
4881 frame
= selected_frame
;
4882 CHECK_LIVE_FRAME (frame
);
4887 int fontset
= fs_query_fontset (name
, 0);
4890 name
= fontset_ascii (fontset
);
4891 font_object
= font_open_by_name (f
, SSDATA (name
), SBYTES (name
));
4893 else if (FONT_OBJECT_P (name
))
4895 else if (FONT_ENTITY_P (name
))
4896 font_object
= font_open_entity (f
, name
, 0);
4899 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4900 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4902 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4904 if (NILP (font_object
))
4906 font
= XFONT_OBJECT (font_object
);
4908 info
= Fmake_vector (make_number (7), Qnil
);
4909 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4910 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4911 ASET (info
, 2, make_number (font
->pixel_size
));
4912 ASET (info
, 3, make_number (font
->height
));
4913 ASET (info
, 4, make_number (font
->baseline_offset
));
4914 ASET (info
, 5, make_number (font
->relative_compose
));
4915 ASET (info
, 6, make_number (font
->default_ascent
));
4918 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4919 close it now. Perhaps, we should manage font-objects
4920 by `reference-count'. */
4921 font_close_object (f
, font_object
);
4928 #define BUILD_STYLE_TABLE(TBL) \
4929 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4932 build_style_table (const struct table_entry
*entry
, int nelement
)
4935 Lisp_Object table
, elt
;
4937 table
= Fmake_vector (make_number (nelement
), Qnil
);
4938 for (i
= 0; i
< nelement
; i
++)
4940 for (j
= 0; entry
[i
].names
[j
]; j
++);
4941 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4942 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4943 for (j
= 0; entry
[i
].names
[j
]; j
++)
4944 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4945 ASET (table
, i
, elt
);
4950 /* The deferred font-log data of the form [ACTION ARG RESULT].
4951 If ACTION is not nil, that is added to the log when font_add_log is
4952 called next time. At that time, ACTION is set back to nil. */
4953 static Lisp_Object Vfont_log_deferred
;
4955 /* Prepend the font-related logging data in Vfont_log if it is not
4956 `t'. ACTION describes a kind of font-related action (e.g. listing,
4957 opening), ARG is the argument for the action, and RESULT is the
4958 result of the action. */
4960 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4965 if (EQ (Vfont_log
, Qt
))
4967 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4969 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4971 ASET (Vfont_log_deferred
, 0, Qnil
);
4972 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4973 AREF (Vfont_log_deferred
, 2));
4978 Lisp_Object tail
, elt
;
4979 Lisp_Object equalstr
= build_string ("=");
4981 val
= Ffont_xlfd_name (arg
, Qt
);
4982 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4986 if (EQ (XCAR (elt
), QCscript
)
4987 && SYMBOLP (XCDR (elt
)))
4988 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4989 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4990 else if (EQ (XCAR (elt
), QClang
)
4991 && SYMBOLP (XCDR (elt
)))
4992 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4993 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4994 else if (EQ (XCAR (elt
), QCotf
)
4995 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4996 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4998 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5004 && VECTORP (XCAR (result
))
5005 && ASIZE (XCAR (result
)) > 0
5006 && FONTP (AREF (XCAR (result
), 0)))
5007 result
= font_vconcat_entity_vectors (result
);
5010 val
= Ffont_xlfd_name (result
, Qt
);
5011 if (! FONT_SPEC_P (result
))
5012 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5013 build_string (":"), val
);
5016 else if (CONSP (result
))
5019 result
= Fcopy_sequence (result
);
5020 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5024 val
= Ffont_xlfd_name (val
, Qt
);
5025 XSETCAR (tail
, val
);
5028 else if (VECTORP (result
))
5030 result
= Fcopy_sequence (result
);
5031 for (i
= 0; i
< ASIZE (result
); i
++)
5033 val
= AREF (result
, i
);
5035 val
= Ffont_xlfd_name (val
, Qt
);
5036 ASET (result
, i
, val
);
5039 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5042 /* Record a font-related logging data to be added to Vfont_log when
5043 font_add_log is called next time. ACTION, ARG, RESULT are the same
5047 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5049 if (EQ (Vfont_log
, Qt
))
5051 ASET (Vfont_log_deferred
, 0, build_string (action
));
5052 ASET (Vfont_log_deferred
, 1, arg
);
5053 ASET (Vfont_log_deferred
, 2, result
);
5059 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5060 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5061 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5062 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5063 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5064 /* Note that the other elements in sort_shift_bits are not used. */
5066 staticpro (&font_charset_alist
);
5067 font_charset_alist
= Qnil
;
5069 DEFSYM (Qopentype
, "opentype");
5071 DEFSYM (Qascii_0
, "ascii-0");
5072 DEFSYM (Qiso8859_1
, "iso8859-1");
5073 DEFSYM (Qiso10646_1
, "iso10646-1");
5074 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5075 DEFSYM (Qunicode_sip
, "unicode-sip");
5079 DEFSYM (QCotf
, ":otf");
5080 DEFSYM (QClang
, ":lang");
5081 DEFSYM (QCscript
, ":script");
5082 DEFSYM (QCantialias
, ":antialias");
5084 DEFSYM (QCfoundry
, ":foundry");
5085 DEFSYM (QCadstyle
, ":adstyle");
5086 DEFSYM (QCregistry
, ":registry");
5087 DEFSYM (QCspacing
, ":spacing");
5088 DEFSYM (QCdpi
, ":dpi");
5089 DEFSYM (QCscalable
, ":scalable");
5090 DEFSYM (QCavgwidth
, ":avgwidth");
5091 DEFSYM (QCfont_entity
, ":font-entity");
5092 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5102 DEFSYM (QCuser_spec
, "user-spec");
5104 staticpro (&null_vector
);
5105 null_vector
= Fmake_vector (make_number (0), Qnil
);
5107 staticpro (&scratch_font_spec
);
5108 scratch_font_spec
= Ffont_spec (0, NULL
);
5109 staticpro (&scratch_font_prefer
);
5110 scratch_font_prefer
= Ffont_spec (0, NULL
);
5112 staticpro (&Vfont_log_deferred
);
5113 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5117 staticpro (&otf_list
);
5119 #endif /* HAVE_LIBOTF */
5123 defsubr (&Sfont_spec
);
5124 defsubr (&Sfont_get
);
5125 #ifdef HAVE_WINDOW_SYSTEM
5126 defsubr (&Sfont_face_attributes
);
5128 defsubr (&Sfont_put
);
5129 defsubr (&Slist_fonts
);
5130 defsubr (&Sfont_family_list
);
5131 defsubr (&Sfind_font
);
5132 defsubr (&Sfont_xlfd_name
);
5133 defsubr (&Sclear_font_cache
);
5134 defsubr (&Sfont_shape_gstring
);
5135 defsubr (&Sfont_variation_glyphs
);
5137 defsubr (&Sfont_drive_otf
);
5138 defsubr (&Sfont_otf_alternates
);
5142 defsubr (&Sopen_font
);
5143 defsubr (&Sclose_font
);
5144 defsubr (&Squery_font
);
5145 defsubr (&Sfont_get_glyphs
);
5146 defsubr (&Sfont_match_p
);
5147 defsubr (&Sfont_at
);
5149 defsubr (&Sdraw_string
);
5151 #endif /* FONT_DEBUG */
5152 #ifdef HAVE_WINDOW_SYSTEM
5153 defsubr (&Sfont_info
);
5156 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5158 Alist of fontname patterns vs the corresponding encoding and repertory info.
5159 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5160 where ENCODING is a charset or a char-table,
5161 and REPERTORY is a charset, a char-table, or nil.
5163 If ENCODING and REPERTORY are the same, the element can have the form
5164 \(REGEXP . ENCODING).
5166 ENCODING is for converting a character to a glyph code of the font.
5167 If ENCODING is a charset, encoding a character by the charset gives
5168 the corresponding glyph code. If ENCODING is a char-table, looking up
5169 the table by a character gives the corresponding glyph code.
5171 REPERTORY specifies a repertory of characters supported by the font.
5172 If REPERTORY is a charset, all characters belonging to the charset are
5173 supported. If REPERTORY is a char-table, all characters who have a
5174 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5175 gets the repertory information by an opened font and ENCODING. */);
5176 Vfont_encoding_alist
= Qnil
;
5178 /* FIXME: These 3 vars are not quite what they appear: setq on them
5179 won't have any effect other than disconnect them from the style
5180 table used by the font display code. So we make them read-only,
5181 to avoid this confusing situation. */
5183 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5184 doc
: /* Vector of valid font weight values.
5185 Each element has the form:
5186 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5187 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5188 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5189 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5191 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5192 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5193 See `font-weight-table' for the format of the vector. */);
5194 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5195 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5197 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5198 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5199 See `font-weight-table' for the format of the vector. */);
5200 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5201 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5203 staticpro (&font_style_table
);
5204 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5205 ASET (font_style_table
, 0, Vfont_weight_table
);
5206 ASET (font_style_table
, 1, Vfont_slant_table
);
5207 ASET (font_style_table
, 2, Vfont_width_table
);
5209 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5210 *Logging list of font related actions and results.
5211 The value t means to suppress the logging.
5212 The initial value is set to nil if the environment variable
5213 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5216 #ifdef HAVE_WINDOW_SYSTEM
5217 #ifdef HAVE_FREETYPE
5219 #ifdef HAVE_X_WINDOWS
5224 #endif /* HAVE_XFT */
5225 #endif /* HAVE_X_WINDOWS */
5226 #else /* not HAVE_FREETYPE */
5227 #ifdef HAVE_X_WINDOWS
5229 #endif /* HAVE_X_WINDOWS */
5230 #endif /* not HAVE_FREETYPE */
5233 #endif /* HAVE_BDFFONT */
5236 #endif /* WINDOWSNT */
5239 #endif /* HAVE_NS */
5240 #endif /* HAVE_WINDOW_SYSTEM */
5246 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;